wikimeasure

# Copyright (c) 2010, Panos Louridas, GRNET S.A.

#

# All rights reserved.

#

# Redistribution and use in source and binary forms, with or without

# modification, are permitted provided that the following conditions are met:

#

# * Redistributions of source code must retain the above copyright notice, this

# list of conditions and the following disclaimer.

#

# * Redistributions in binary form must reproduce the above copyright notice,

# this list of conditions and the following disclaimer in the documentation

# and/or other materials provided with the distribution.

#

# * Neither the name of GRNET S.A, nor the names of its contributors may be

# used to endorse or promote products derived from this software without

# specific prior written permission.

#

# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"

# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE

# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE

# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR

# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER

# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,

# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

use strict;

use Prefixes qw(%other_namespaces %namespaces %languages);

my %redirect;

open(REDIRECT_FILE, "< $ARGV[0]");

while (my $line = <REDIRECT_FILE>) {

  chomp $line;

  my ($from , $to, $anchor) = $line =~ /(.+) #REDIRECT ([^#]+)(#.*)?/;

  $redirect{$from} = $to if $from ne $to; # makes sure we do not redirect to self

}

close(REDIRECT_FILE);

open(LINKS_FILE, "< $ARGV[1]");

while (my $line = <LINKS_FILE>) {

    chomp $line;

    my ($from, $to, $anchor) = $line =~ /(.+) => ([^#]+)(#.*)?/;

    next unless $from && $to;

    next if $to =~ /^:/;

    my $prefix = substr($to, 0, 1 + index($to, ":"));

    if ($prefix ne "" && ($other_namespaces{$prefix} || $namespaces{$prefix}

                          || $languages{$prefix})) {

      next;

    }

    my $new_target = $to;

    my %seen = ();

    while ($new_target && !exists($seen{$new_target})) {

      $seen{$new_target} = 1;

      $to = $new_target;

      $new_target = $redirect{$to};

    }

    $from = $from;

    if (index("$from => $to\n", "#") >= 0) {

      die "line: $line from: $from to: $to\n";

    }

    print "$from => $to\n";

}

close(LINKS_FILE);