package configdirsvshtml;

=head1 NAME

paths - perl module to deal with absolute and relative paths in accordance with
       RFC2396.

=head1 SYNOPSIS

    use configdirsvshtml qw (&userhtmlhome &userandpathfromhtmldir
                             &userhtmldir
                             &directoryfromurl &urlfromdirectory
                             $thissite $runcgiwrap
                            );

   $usershtmlpage = &userhtmlhome($username, $path);
   ($username, $path, $url) = &userandpathfromhtmldir('/home/foo/public_html/some/path');
   $usershomepage = &userhtmldir();
   $directory = &directoryfromurl ('http://www.foobar.com/~user/foo/bar');
   $url       = &urlfromdirectory ('/home/foo/public_html/bar');    

=head1 DESCRIPTION

In order to deal with mapping directories to public html directories,
one needs to know the forms.

=head1 AUTHOR

John Halleck <John.Halleck@utah.edu>

=head1 COPYRIGHT

(C) Copyright 2000 by John Halleck.

=cut

require 5.0; # not a prayer with perl 4
use strict;

# Walk around examining files for links.

use urlparse qw(&parseuri);
use vars qw($VERSION @ISA @EXPORT_OK
             $thissite $altsite $runcgiwrap $homeinitial
             $homehtmldir $username $urlbase
            );
@ISA = qw (Exporter);
@EXPORT_OK = qw(&userhtmlhome &userandpathfromhtmldir
                &userhtmldir $thissite &homehtmldir
                &urlfromdirectory &directoryfromurl
                $runcgiwrap 
               );

$VERSION = "1.1";

# Configuration: -------------------------------------------------------------

$thissite = "www.cc.utah.edu"; $thissite = lc($thissite); # MUST BE LOWER CASE;
# (this could also be www.cc.utah.edu:80 if you need the port number.)
$altsite = "utah.edu"; $altsite = lc($altsite);
# Alternate site for virtual machines.

$runcgiwrap = 1; # are cgi programs only run via cgiwrap?
$homeinitial = 0; # Are user directories in /home/initial/user?

# How do we find a users home directory?
sub userhtmlhome {
  my $user = shift;
  my $path = shift;$path = '' if !defined $path;
  if ($path =~ m:^/(.*)$:) { $path = $1 }
  if ($homeinitial) {
     my ($initial) = $user =~ m/^(\w)/;
     return "/home/users/$initial/$user/public_html/$path";
  }
  return "/home/$user/public_html/$path";
}

# Could also be: (For example)
# sub userhtmlhome {
#   my $user = shift;
#   my $path = shift; $path = '' if !defined $path;
#   if ($path =~ m:^/(.*)$:) { $path = $1 }
#   my ($initial) = $user =~ m/^(\w)/;
#   return "/home/users/$initial/$user/public_html/$path";
# }

sub userandpathfromhtmldir {
  my $dir = shift;
  # print "DEBUG: User and path from directory called with $dir\n";
  if (!$homeinitial && $dir =~ m:^/home/(\w+)/public_html/(.*)$:) {
     return ($1, $2, "http://$thissite/~$1/");
  } elsif ($homeinitial && $dir =~ m:^/home/users/\w/(\w+)/public_html/(.*)$:) {
     return ($1, $2, "http://$thissite/~$1/");
  } elsif ($dir =~ m:^/services/web/(\w+)/(.*)$:) {
     return ($1, $2, "http://www.$1.$altsite/");
  } else {
     return ('', $dir, '');
  }
}

# Could also be: (For example)
# sub userandpathfromhtmldir {
#   my $dir = shift;
#   if ($dir =~ m:^/home/users/\w/(\w+)/public_html(/.*)$:) {
#      return ($1, $2, '');
#   } else {
#      return ('', $dir, '');
#   }
# }

# -----------------------  Fill in derived config -----------------------------

sub homehtmldir { return $homehtmldir };


$username = (getpwuid($<))[0];
if (defined $< && !defined $username) { $username = $< }
$username = '???' if !defined $username;

$urlbase  = "http://$thissite/~$username/" ; #base to compute URL's from

$homehtmldir = &userhtmlhome ($username); # Users HTML dir;


###############################################################################
###############################################################################
# --- END CONFIG ------
###############################################################################
###############################################################################

# come up with directory from URL.

sub directoryfromurl {
  my $url = shift;
  if (!defined $url || $url eq '') { return undef }
  my ($scheme, $authority, $path, $query, $fragment) = &parseuri($url);
  # Get down to just the URL.
  # print "DEBUG: URL $url breaks out as:\n";
  # print "DEBUG: Scheme: $scheme\n" if defined $scheme;
  # print "DEBUG: Authority: $authority\n" if defined $authority;
  # print "DEBUG: Path: $path\n" if defined $path;
  # print "DEBUG: Query: $query\n" if defined $query;
  # print "DEBUG: Fragment $fragment\n" if defined $fragment;
  if (!defined $path) { return undef }
  # print "DEBUG: Path was defined\n";
  if (!defined $scheme    || lc ($scheme) !~ m/^https?$/) { return undef }
  # print "DEBUG: Scheme was defined\n";
  if (!defined $authority || lc ($authority) ne $thissite) { return undef }
  # print "DEBUG: Authority was defined\n";
  if ($path =~ m:^/~(\w+)/?$:) {
     # print "DEBUG: returning $1's directory",  &userhtmlhome($1), "\n";
     return &userhtmlhome($1);
  } elsif ($path =~ m:^/~(\w+)/(.*)$:) {
     # print "DEBUG: Scanned path was $path\n";
     # print "DEBUG: returning $1's directory + $2 starting at ",  &userhtmlhome($1), "\n";
     return &userhtmlhome($1) . $2;
  } elsif ($path =~ m:^/cgi-bin/cgiwrap/(\w+)/(.+)$:) {
     return &userhtmlhome($1) . 'cgi-bin/' . $2;
  # } else {
     # print "DEBUG: $path was none of the above?\n";
  }
  return undef;
}

# come up with URL from directory.

sub urlfromdirectory {
  my $dir = shift;
  # print "DEBUG: urlfromdirectory called with $dir\n";
  if ($dir !~ m:/$: && -d $dir) { $dir .= '/' }
  my ($user, $path, $prefix) = &userandpathfromhtmldir($dir);
  # print "DEBUG: userandpathfromdirectory returned $user, $path\n";
  if ($runcgiwrap && $path =~ m:^/cgi-bin/.+\.cgi$:) {
     return "http://$thissite/cgi-bin/cgiwrap/$user$path";
  } else {
     return "$prefix$path";
  } 
}

1;