view release on metacpan or  search on metacpan

bin/linkRedir  view on Meta::CPAN

#!/usr/bin/perl -w

# No documentation yet except for what is in the $USAGE message
# and comments below.
#
# Uses:
#       take standard linkbag format and eliminate redirects;
#       ignores fragments too

use strict;
use POSIX;
use HTML::Entities;
use Alvis::URLs;
use Getopt::Long;
use Pod::Usage;

# encoding pragmas follow any includes like "use"
use encoding 'utf8';
use open ':utf8';
binmode STDOUT, ":utf8";
binmode STDIN, ":utf8";

my $usezip = "";
my $init = 0;

#  both hash tables only store URLs cleaned with StandardURL()
#  single redirect for a URL
my %redirect = ();
#  space delimited set of entries with same target
my %direct = ();

sub updateMaps() {
  my $inu = shift();
  my $outu = shift();
  my $direct_add = "";
  #  no duplicates
  if ( defined($redirect{$inu}) &&
       $redirect{$inu} ne $outu ) {
    print STDERR "Previous definition '$inu'->'" . $redirect{$inu}
      . "' for line:\n   $_\n";
    # exit(1);
  }
  #  anything redirecting to this source must also be
  #  redirected
  if ( defined($direct{$inu}) ) {
    $direct_add = $direct{$inu};
    undef($direct{$inu});
  }
  #  check for a redirect of the redirect
  if ( defined($redirect{$outu}) ) {
    #print STDERR "Redirect target '$outu' already redirected '$redirect{$outu}'\n";
    my $reoutu = $redirect{$outu};
    $redirect{$inu} = $reoutu;
    if ( $direct_add ) {
      #print STDERR "Redirect source '$inu' already redirected too '$direct_add'\n";
      foreach my $l ( split(/ /, $direct_add) ) {
	$redirect{$l} = $reoutu;
      }
      $direct_add = $inu . " " . $direct_add;
    } else {
      $direct_add = $inu;
    } 
    $direct{$reoutu} = $direct{$reoutu} . " " . $direct_add;
  } else {
    #  $outu terminates things
    $redirect{$inu} = $outu;
    if ( $direct_add ) {
      # print STDERR "Redirect source '$inu' already redirected too '$direct_add'\n";
      $direct{$outu} = $inu . " " . $direct_add;
      foreach my $l ( split(/ /, $direct_add) ) {
	$redirect{$l} = $outu;
      }
    } else {
      $direct{$outu} = $inu;
    }
  }
}


#  check options


#  check options

GetOptions(
     'man'       => sub {pod2usage(-exitstatus => 0, -verbose => 2)},
      'init'    => \$init,
      'gzip'    => sub { $usezip = "zcat"; },
      'bzip2'    => sub { $usezip = "bzcat"; },
      'noclean' => \$Alvis::URLs::noclean,
      'nocase' => \$Alvis::URLs::nocase,
      'h|help'       => sub {pod2usage(1)}