view release on metacpan or  search on metacpan

AliasList.pm  view on Meta::CPAN

internal redirect. The address shown in the browser does not change, but
the content returned is from the longer URI.

Requesting the page http://perl.jonallen.info/bin/view/Main/PerlModules
causes the external redirect to be issued, taking the client to 
http://perl.jonallen.info/modules. This URI will then be processed as 
described above.

=head1 TODO

Extend the reverse map feature to act as a content filter, substituting
URI links with their aliases in the returned HTML document.

=head1 AUTHOR

Written by Jon Allen (JJ) <jj@jonallen.info>

=head1 COPYRIGHT

Copyright (C) 2004 Jon Allen

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

http://perl.jonallen.info

=cut

package Apache::AliasList;

use strict;
use warnings;
use Apache::Constants qw(:common REDIRECT);
use File::stat;

our $VERSION     = '0.08';
our $list_mtime  = 0;
our @aliaslist   = ();
our %forward_map = ();
our %reverse_map = ();

sub handler {
  my $r       = shift;
  my $handler = $r->current_callback;
  DISPATCH: {
    if ($handler eq 'PerlTransHandler') {return &PerlTransHandler($r,@_)}
    return DECLINED;
  }
}

sub PerlTransHandler {
  my $r     = shift;
  return DECLINED unless ($r->is_initial_req);
  
  (my $uri  = $r->uri) =~ s!([^/]+)/+$!$1!;
  
  # Reload the alias.list file if it has been modified since the last reload
  my $aliasfile = $r->dir_config('AliasList') or return DECLINED;
  my $st        = stat($aliasfile);
  if ($st->mtime > $list_mtime) {
    $list_mtime  = $st->mtime;
    @aliaslist   = &load_alias_list($r);
    %forward_map = &generate_forward_map(@aliaslist);
    %reverse_map = &generate_reverse_map(@aliaslist);
  }
  
  if ($forward_map{$uri}) {
    $uri = $forward_map{$uri};
    # Send a Redirect message if the new URI is a full (http://...)
    # address, otherwise just change the URI to redirect internally
    if ($uri =~ m!^[a-zA-Z]+://!) {
      $r->content_type('text/html');
      $r->header_out(Location => $uri);
      return REDIRECT;
    } else {
      $r->uri($uri);
      return DECLINED;
    }
  }

  if ($reverse_map{$uri}) {
    $uri = $reverse_map{$uri};
    $r->content_type('text/html');
    $r->header_out(Location => $uri);
    return REDIRECT;
  }

  return DECLINED;
}

sub load_alias_list {
  my $r         = shift;
  my $aliaslist = $r->dir_config('AliasList');
  open ALIASLIST,"< $aliaslist";
  my @list = (<ALIASLIST>);
  close ALIASLIST;
  return @list;
}

sub generate_forward_map {
  my %map = ();
  foreach (@_) {
    s/#.*//;  # Remove comments
    if (/^\s*(\S+)\s+(\S+)/) {
      $map{$1} = $2;
    }
  }
  return %map;
}

sub generate_reverse_map {
  my %map = ();
  foreach (@_) {
    s/#.*//;  # Remove comments
    if (/^\s*(\S+)\s+(\S+)/) {
      $map{$2} = $1;
    }
  }
  return %map;