#!/bin/sh
#-*-Perl-*-

exec perl -x $0 "$@"

#!perl

$| = 1;

use IO::Socket;
use IO::Select;
use POSIX;
use Cwd;
use File::Path;
use strict;

open(CFG,"install.cfg");
<CFG>;

my %modes;
while(<CFG>) {
  next if /^\#/;
  s/\n//;
  s/^\s*//;
  last if /options:/;
  my ($mode,$desc) = split(/\s+/,$_,2);
  $modes{$mode} = $desc;
}

my %options;
while(<CFG>) {
  next if /^\#/;
  s/\n//;
  s/^\s*//;
  last if /url:/;
  my ($mode,$desc) = split(/\s+/,$_,2);
  $options{$mode} = $desc;
}

my $baseURL;
my $baseHost;
my $basePort;
while(<CFG>) {
  next if /^\#/;
  s/\n//;
  s/^\s*//;
  last if /modules:/;
  $baseURL = $_;
  ($baseHost,$basePort) = ($baseURL =~ /^http:\/\/([^\:]+)\:(\d+)\//);
}

my %modules;
my $count = 0;
while(<CFG>) {
  next if /^\#/;
  s/\n//;
  s/^\s*//;
  last if /install:/;
  my ($type,$category,$module,$version,$package) = split(/\t+/,$_,5);
  $modules{$count}->{package} = $package;
  $modules{$count}->{module} = $module;
  $modules{$count}->{version} = $version;
  $modules{$count}->{type} = $type;
  $modules{$count}->{category} = $category;
  $modules{$count}->{found} = 1;
  $count++;
}

my %executables;
while(<CFG>) {
  next if /^\#/;
  s/\n//;
  s/^\s*//;
  my ($source,$target) = split(/\t+/,$_);
  $executables{$source} = $target;
}
close(CFG);

print "Looking for proxy information...";

my $pac = new HTTP::ProxyAutoConfig();

my $http_proxy = $pac->FindProxy($baseURL);
my ($http_proxy_host,$http_proxy_port) = ($http_proxy =~ /^PROXY ([^:]+)\:(\d+)/);

if ($http_proxy ne "DIRECT") {
  print "$http_proxy_host:$http_proxy_port\n";
} else {
  print "none\n";
  $http_proxy_host = $baseHost;
  $http_proxy_port = $basePort;
}

print "Prompting for modes:\n";
foreach my $mode (sort {$a cmp $b} keys(%modes)) {
  printf("  \%-7s    %s\n",$mode,$modes{$mode});
}
my $pass = 0;
my @modes;
while (!$pass) {
  print "Enter space sperated list: ";
  $_ = <STDIN>;
  s/\n//g;
  next if ($_ eq "");
  @modes = split(/\s+/,$_);
  $pass = 1;
  foreach my $mode (@modes) {
    $pass = 0 unless exists($modes{$mode});
  }
}
print "Using modes: @modes\n";
undef(%modes);
foreach my $mode (@modes) {
  $modes{$mode} = 1;
}

my $default;
if ($#modes == 0) {
  $default = $modes[0];
} else {
  $default = "";
  while ($default eq "") {
    print "Enter the deafult mode: ";
    $default = <STDIN>;
    $default =~ s/\n//g;
    $default = "" unless exists($modes{$default});
  }
}
print "Using deafult mode: $default\n";

$modes{all} = 1;

print "Prompting for optional modules:\n";
foreach my $option (sort {$a cmp $b} keys(%options)) {
  printf("  \%-7s    %s\n",$option,$options{$option});
}
my @options;
$pass = 0;
while (!$pass) {
  print "Enter space sperated list, blank for none: ";
  $_ = <STDIN>;
  s/\n//g;
  last if ($_ eq "");
  @options = split(/\s+/,$_);
  $pass = 1;
  foreach my $option (@options) {
    $pass = 0 unless exists($options{$option});
  }
}
print "Using options: @options\n";
undef(%options);
foreach my $option (@options) {
  $options{$option} = 1;
}

my $install = 0;
print "Testing for modules:\n";
foreach my $index (sort {$a cmp $b} keys(%modules)) {
  next unless (exists($modes{$modules{$index}->{type}}) ||
	       exists($options{$modules{$index}->{type}}));
  if ($modules{$index}->{category} eq "m") {
    print "  $modules{$index}->{module} $modules{$index}->{version}","."x(50-length($modules{$index}->{module}) - length($modules{$index}->{version}));
    eval "use $modules{$index}->{module} $modules{$index}->{version}";
    if ($@) {
      $install = 1;
      $modules{$index}->{found} = 0;
      print "not found\n";
    } else {
      print "ok\n";
    }	
  }
  if ($modules{$index}->{category} eq "v") {
    if (&inPath($modules{$index}->{module})) {
      my $version = qx/$modules{$index}->{module} $modules{$index}->{version}/;
      ($version) = ($version =~ /(\S+\.\S+\.?\S*\.?\S*)/);
      if (&versioncmp($version,$modules{$index}->{package}) < 0) {
	print "Can't verify $modules{$index}->{module} version($modules{$index}->{package}) you have version($version)\n";
	exit(0);
      }
    } else {
      print "Cannot find $modules{$index}->{module} in your path.\n";
      exit(0);
    }
  }
}
print "Done.\n";

my @bars;
$bars[0] = "[*     ]";
$bars[1] = "[ *    ]";
$bars[2] = "[  *   ]";
$bars[3] = "[   *  ]";
$bars[4] = "[    * ]";
$bars[5] = "[     *]";
$bars[6] = "[    * ]";
$bars[7] = "[   *  ]";
$bars[8] = "[  *   ]";
$bars[9] = "[ *    ]";
$bars[10] = "[      ]";
$bars[11] = "    done";

my %prefix;
my @prefixes;
&installModules() if ($install == 1);
&installExecutables() unless (scalar(keys(%executables)) == 0);

sub installModules {
  my $cwd = cwd();
  my $installDir = "/tmp/install.$$.".time;

  my $first;
  my $second;

  &getInstallLocation();

  if ($prefix{type} eq "custom") {
    my $loc = "$prefix{loc}/lib/site_perl/";
    $first = $INC[$#INC-1];
    $first =~ s/^.*\/([^\/]+)$/$loc$1/;
    $second = $INC[$#INC-2];
    $second =~ s/^.*\/([^\/]+\/[^\/]+)$/$loc$1/;

    my %tmplibdirs;

    my $libcount = 0;
    foreach my $libdir (split(':',$ENV{PERLLIB})) {
      $tmplibdirs{$libdir} = $libcount;
      $libcount++;
    }

    $tmplibdirs{$first} = -2 unless exists($tmplibdirs{$first});
    $tmplibdirs{$second} = -1 unless exists($tmplibdirs{$second});

    $ENV{PERLLIB} = join(":",(sort { $tmplibdirs{$a} <=> $tmplibdirs{$b} } keys(%tmplibdirs)));
  }

  open(LOG,">install.log");

  foreach my $index (sort {$a cmp $b} keys(%modules)) {
    if ($modules{$index}->{found} == 0) {

      &mkpath("$cwd/modules");
      chdir("$cwd/modules");

      if (!(-e "./$modules{$index}->{package}")) {
	print "Fetching $modules{$index}->{module} ";
	
	$count = 0;
	print $bars[10];

	my $sock = new IO::Socket::INET(PeerAddr=>$http_proxy_host,
					PeerPort=>$http_proxy_port,
					Proto=>"tcp");
	my $select = new IO::Select($sock);
	my $fetchCommand = "GET $baseURL/$modules{$index}->{package} HTTP/1.1\r\nHost: $baseHost\r\nProxy-Connection: Keep-Alive\r\n\r\n";
	$sock->syswrite($fetchCommand,length($fetchCommand),0);
	open(FILE,">$modules{$index}->{package}");
	$sock->autoflush(1);

        my $status = 1;
        my $buff;
        my $file = "";
	my $reading = 0;
	my $contentLength = 1;
	while (1) {
	  if ($select->can_read(0) && ($status > 0)) {
	    $reading = 1;
            $status = $sock->sysread($buff,POSIX::BUFSIZ);
	    print "\b"x(length($bars[$count]));
	    print $bars[$count];
	    $count++;
	    $count = 0 if ($count == 10);
	    if ($file == 1) {
	      print FILE $buff;
	      $contentLength -= length($buff);
	    } else {
	      $file .= $buff;
	      if ($file =~ /^.+\r\n\r\n/sm) {
		($contentLength) = ($file =~ /Content-Length: (\d+)/);
	        $file =~ s/^(.+\r\n\r\n)//sm;
	        print FILE $file;
		$contentLength -= length($file);
	        $file = 1;
              }
	    }
  	  } else {
	    last if (($reading == 1) && ($contentLength == 0));
          }
        }
        print "\b"x(length($bars[$count]));
	print $bars[11];
        print "\n";
	close(FILE);
      }
    }
  }
  foreach my $index (sort {$a cmp $b} keys(%modules)) {
    if ($modules{$index}->{found} == 0) {

      print "Installing $modules{$index}->{module} ";

      &mkpath($installDir);
      chdir($installDir);

      system("gzip -dc < $cwd/modules/$modules{$index}->{package} | tar xf -");

      my @list = <*>;
      chdir("$installDir/$list[0]");

      open(MAKEFILEPL,"perl Makefile.PL 2>&1 |")
	if ($prefix{type} eq "perl");
      print LOG "perl Makefile.PL\n"
	if ($prefix{type} eq "perl");

      open(MAKEFILEPL,"perl Makefile.PL LIB=$first 2>&1 |")
	if ($prefix{type} eq "custom");
      print LOG "perl Makefile.PL LIB=$first\n"
	if ($prefix{type} eq "custom");

      $count = 0;
      print $bars[10];
      while(<MAKEFILEPL>) {
	print LOG;
	print "\b"x(length($bars[$count]));
	print $bars[$count];
	$count++;
	$count = 0 if ($count == 10);
      }
      close(MAKEFILEPL);

      open(MAKE,"make 2>&1 |");
      while(<MAKE>) {
	print LOG;
	print "\b"x(length($bars[$count]));
	print $bars[$count];
	$count++;
	$count = 0 if ($count == 10);
      }
      close(MAKE);

      open(MAKEINST,"make install 2>&1 |");
      while(<MAKEINST>) {
	print LOG;
	print "\b"x(length($bars[$count]));
	print $bars[$count];
	$count++;
	$count = 0 if ($count == 10);
      }
      close(MAKEINST);

      chdir($cwd);
      &rmtree($installDir);
      print "\b"x(length($bars[$count]));
      print $bars[11];
      print "\n";
    }
  }

  if ($prefix{type} eq "custom") {
    print "\n";
    print "\n";
    print "\n";
    print "To use this program you must the set the PERLLIB environment variable.\n";
    print "Add it to your .cshrc or .bashrc file:\n";
    print "\n";
    print "For csh/tcsh:\n";
    print "  setenv PERLLIB $ENV{PERLLIB}\n";
    print "\n";
    print "For bash:\n";
    print "  export PERLLIB=$ENV{PERLLIB}\n";
    print "\n";
    print "\n";
    print "\n";
  }
}


sub getInstallLocation {
  return $prefix{loc} if ($prefix{tested} == 1);
  $prefix{tested} = 1;

  if (-w $INC[$#INC-1]) {
    $prefixes[$#prefixes+1]->{type} = "perl";
    $prefixes[$#prefixes]->{loc} = "Global Perl Location";
  }

  if (exists($ENV{PERLLIB}) || exists($ENV{PERL5LIB})) {
    my %libs;
    foreach my $lib (split("\:",$ENV{PERLLIB})) {
      $lib =~ s/^(.*)\/lib\/site_perl.*$/$1/;
      $libs{$lib} = 1;
    }

    foreach my $lib (keys(%libs)) {
      $prefixes[$#prefixes+1]->{type} = "custom";
      $prefixes[$#prefixes]->{loc} = $lib;
    }
  }

  $prefixes[$#prefixes+1]->{type} = "custom";
  $prefixes[$#prefixes]->{loc} = "Choose new lib location";

  my $loc = "";
  my $home = $ENV{HOME};
  while (!(-d $loc)) {
    print "Where do you want to install the modules?\n";
    foreach my $i (0..$#prefixes) {
      print "  $i. $prefixes[$i]->{loc}\n";
    }
    print "Choice:\n";
    my $choice = <STDIN>;
    chomp($choice);
    next if ($choice > $#prefixes);
    if ($choice == $#prefixes) {
      print "Enter the path of the new lib location: ";
      $loc = <STDIN>;
      chomp($loc);
      $loc =~ s/\~/$home/;
      if (!(-d $loc)) {
	print "$loc does not exist.  Create it? (y/n) [y] ";
	my $create = <STDIN>;
	chomp($create);
	if (($create eq "Y") || ($create eq "y") || ($create eq "")) {
	  &mkpath($loc);
	}
      }
      $prefix{type} = "custom";
      $prefix{loc} = $loc;
    } else {
      $prefix{type} = $prefixes[$choice]->{type};
      $prefix{loc} = $prefixes[$choice]->{loc};
      $loc = "/";
    }
  }
}


sub installExecutables {
  print "Installing executables...\n";

  my $home = $ENV{HOME};
  my $loc = "";

  @prefixes = ();

  if (-w "/usr") {
    $prefixes[$#prefixes+1]->{loc} = "/usr";
  }

  if (-w "/usr/local") {
    $prefixes[$#prefixes+1]->{loc} = "/usr/local";
  }

  $prefixes[$#prefixes+1]->{loc} = "Choose new install location.";

  print "Where do you want to install the executables?\n";
  foreach my $i (0..$#prefixes) {
    print "  $i. $prefixes[$i]->{loc}\n";
  }
  print "Choice:\n";
  my $choice = <STDIN>;
  chomp($choice);
  next if ($choice > $#prefixes);
  if ($choice == $#prefixes) {
    print "Enter the path of the new location: ";
    $loc = <STDIN>;
    chomp($loc);
    $loc =~ s/\~/$home/;
    if (!(-d $loc)) {
      print "$loc does not exist.  Create it? (y/n) [y] ";
      my $create = <STDIN>;
	chomp($create);
      if (($create eq "Y") || ($create eq "y") || ($create eq "")) {
	&mkpath($loc);
      }
    }
    $prefix{loc} = $loc;
  } else {
    $prefix{loc} = $prefixes[$choice]->{loc};
  }

  foreach my $source (keys(%executables)) {
    next if ($source eq "installPackage");
    &mkpath("$prefix{loc}/$executables{$source}");
    if ($source =~ /\*/) {
      my $dir = $source;
      $dir =~ s/\/\*//;
      opendir(DIR,$dir);
      my @files = readdir(DIR);
      closedir(DIR);
      foreach my $file (@files) {
	next if ($file =~ /^\.\.?$/);
	system("cp -R ./$dir/$file $prefix{loc}/$executables{$source}");
      }
    } else {
      system("cp ./$source $prefix{loc}/$executables{$source}");
    }
  }

  open(MODE,">$prefix{loc}/share/jarl/mode");
  print MODE "$default\n";
  foreach my $mode (sort({$a cmp $b} @modes)) {
    next if ($mode eq $default);
    print MODE "$mode\n";
  }
  close(MODE);
}


sub inPath {
  my $exe = shift;

  foreach my $dir (split(/\:/,$ENV{PATH})) {
    return 1 if (-f "$dir/$exe");
  }
  return 0;
}


##############################################################################
#+----------------------------------------------------------------------------
#|
#| Functions borrowed from other modules just to make sure I have them.
#|
#+----------------------------------------------------------------------------
##############################################################################

##############################################################################
#
# versions - Sort::Versions
#
#   Copyright (c) 1996, Kenneth J. Albanowski. All rights reserved.  This
# program is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.
#
##############################################################################
sub versions {
  my(@A) = ($::a =~ /(\.|\d+|[^\.\d]+)/g);
  my(@B) = ($::b =~ /(\.|\d+|[^\.\d]+)/g);
  my($A,$B);
  while(@A and @B) {
    $A=shift @A;
    $B=shift @B;
    if($A eq "." and $B eq ".") {
      next;
    } elsif( $A eq "." ) {
      return -1;
    } elsif( $B eq "." ) {
      return 1;
    } elsif($A =~ /^\d+$/ and $B =~ /^\d+$/) {
      return $A <=> $B if $A <=> $B;
    } else {
      $A = uc $A;
      $B = uc $B;
      return $A cmp $B if $A cmp $B;
    }	
  }
  @A <=> @B;
}


##############################################################################
#
# versioncmp - Sort::Versions
#
#   Copyright (c) 1996, Kenneth J. Albanowski. All rights reserved.  This
# program is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.
#
##############################################################################
sub versioncmp {
  local($::a,$::b)=@_;
  &versions();
}


package HTTP::ProxyAutoConfig;

use Carp;
use Sys::Hostname;
use IO::Socket;
use POSIX;
use vars qw($VERSION );

$VERSION = "0.1";

sub new {
  my $proto = shift;
  my $self = { };

  bless($self,$proto);

  $self->{URL} = shift if ($#_ > -1);
  $self->Reload();
  return $self;
}


##############################################################################
#
# FindProxy - wrapper for FindProxyForURL function so that you don't have to
#             figure out the host.
#
##############################################################################
sub FindProxy {
  my $self = shift;
  my ($url) = @_;

  my ($host) = ($url =~ /^(\S*\:?\/?\/?[^\/:]+)/);
  $host =~ s/^[^\:]+\:\/\///;

  foreach my $proxy (split(/\s*\;\s*/,$self->FindProxyForURL($url,$host))) {
    return $proxy if ($proxy eq "DIRECT");
    my ($host,$port) = ($proxy =~ /^PROXY\s*(\S+):(\d+)$/);

    return $proxy if (new IO::Socket::INET(PeerAddr=>$host,
					   PeerPort=>$port,
					   Proto=>"tcp"));
  }

  return undef;
}


##############################################################################
#
# Reload - grok the environment variables and define the FindProxyForURL
#          function.
#
##############################################################################
sub Reload  {
  my $self = shift;

  my $url = (exists($self->{URL}) ? $self->{URL} : $ENV{"http_auto_proxy"});

  if (defined($url) && ($url ne "")) {

    my ($host,$port,$path) = ($url =~ /^http:\/\/([^\/:]+):?(\d*)\/?(.*)$/);

    $port = 80 if ($port eq "");

    my $sock = new IO::Socket::INET(PeerAddr=>$host,
				    PeerPort=>$port,
				    Proto=>"tcp");
    die("Cannot create normal socket: $!") unless defined($sock);

    my $send = "GET /$path HTTP/1.1\r\nCache-Control: no-cache\r\nHost: $host:$port\r\n\r\n";

    $sock->syswrite($send,length($send),0);

    my $buff;
    my $status = 1;
    my $function = "";
    while($status > 0) {
      $status = $sock->sysread($buff,POSIX::BUFSIZ);
      $function .= $buff;
    }

    my $chunked = ($function =~ /chunked/);

    $function =~ s/^.+?\r?\n\r?\n//s;
    if ($chunked == 1) {
      $function =~ s/\n\r\n\S+\s*\r\n/\n/g;
      $function =~ s/^\S+\s*\r\n//;
    }

    $function = $self->JavaScript2Perl($function);

    eval($function);
  } else {
    my $http_host;
    my $http_port;
    my $function = "sub FindProxyForURL { my (\$self,\$url,\$host) = \@_; ";
    $function .= "if (isResolvable(\$host)) { return \"DIRECT\"; }  ";
    if (exists($ENV{http_proxy})) {
      ($http_host,$http_port) = ($ENV{"http_proxy"} =~ /^(\S+)\:(\d+)$/);
      $http_host =~ s/^http\:\/\///;
      $function .= "if (shExpMatch(\$url,\"http://*\")) { return \"PROXY $http_host\:$http_port\"; }  ";
    }
    if (exists($ENV{https_proxy})) {
      my($host,$port) = ($ENV{"https_proxy"} =~ /^(\S+)\:(\d+)$/);
      $host =~ s/^https?\:\/\///;
      $function .= "if (shExpMatch(\$url,\"https://*\")) { return \"PROXY $host\:$port\"; }  ";
    }
    if (exists($ENV{ftp_proxy})) {
      my($host,$port) = ($ENV{"ftp_proxy"} =~ /^(\S+)\:(\d+)$/);
      $host =~ s/^ftp\:\/\///;
      $function .= "if (shExpMatch(\$url,\"ftp://*\")) { return \"PROXY $host\:$port\"; }  ";
    }
    if (defined($http_host) && defined($http_port)) {
      $function .= "  return \"PROXY $http_host\:$http_port\"; }";
    } else {
      $function .= "  return \"DIRECT\"; }";
    }
    eval($function);
  }
}


##############################################################################
#
# JavaScript2Perl - function to convert JavaScript code into Perl code.
#
##############################################################################
sub JavaScript2Perl {
  my $self = shift;
  my ($function) = @_;

  my $quoted = 0;
  my $blockComment = 0;
  my $lineComment = 0;
  my $newFunction = "";

  my %vars;
  my $variable;

  foreach my $piece (split(/(\s)/,$function)) {
    foreach my $subpiece (split(/([\"\'\=])/,$piece)) {
      next if ($subpiece eq "");
      if ($subpiece eq "=") {
	$vars{$variable} = 1;
      }
      $variable = $subpiece unless ($subpiece eq " ");

      $subpiece = "." if (($quoted == 0) && ($subpiece eq "+"));

      $lineComment = 0 if ($subpiece eq "\n");
      $quoted ^= 1 if (($blockComment == 0) &&
		       ($lineComment == 0) &&
		       ($subpiece =~ /(\"|\')/));
      if (($quoted == 0) && ($subpiece =~ /\/\*/)) {
	$blockComment = 1;
      } elsif (($quoted == 0) && ($subpiece =~ /\/\//)) {
	$lineComment = 1;
      } elsif (($blockComment == 1) && ($subpiece =~ /\*\//)) {
	$blockComment = 0;
      } else {
	$newFunction .= $subpiece
	  unless (($blockComment == 1) || ($lineComment == 1));
      }
    }
  }

  $newFunction =~ s/^\s*function\s*(\S+)\s*\(\s*([^\,]+)\s*\,\s*([^\)]+)\s*\)\s*\{/sub $1 \{\n  my \(\$self,$2,$3\) = \@_\;\n  my(\$stub);\n/;
  $vars{$2} = 2;
  $vars{$3} = 2;

  $quoted = 0;
  my $finalFunction = "";

  foreach my $piece (split(/(\s)/,$newFunction)) {
    if ($piece eq "my(\$stub);") {
      $piece = "my(\$stub";
      foreach my $var (keys(%vars)) {
	next if ($vars{$var} == 2);
	$piece .= ",\$".$var;
      }
      $piece .= ");";
    }
    foreach my $subpiece (split(/([\"\'\=\,\+\)\(])/,$piece)) {
      next if ($subpiece eq "");
      $quoted ^= 1 if (($blockComment == 0) &&
		       ($lineComment == 0) &&
		       ($subpiece =~ /(\"|\')/));
      $subpiece = "\$".$subpiece
	if (($quoted == 0) && exists($vars{$subpiece}));
      $finalFunction .= $subpiece;
    }
  }

  return $finalFunction;
}


##############################################################################
#
# isPlainHostName - PAC command that tells if this is a plain host name
#                   (no dots)
#
##############################################################################
sub isPlainHostName {
  my ($host) = @_;

  return (($host =~ /\./) ? 0 : 1);
}


##############################################################################
#
# dnsDomainIs - PAC command to tell if the host is in the domain.
#
##############################################################################
sub dnsDomainIs {
  my ($host,$domain) = @_;

  $domain =~ s/\./\\\./;
  return (($host =~ /$domain$/) ? 1 : 0);
}


##############################################################################
#
# localHostOrDomainIs - PAC command to tell if the host matches, or if it is
#                       unqaulifed and in the domain.
#
##############################################################################
sub localHostOrDomainIs {
  my ($host,$hostdom) = @_;

  return 1 if ($host eq $hostdom);
  return 0 if ($host =~ /\./);
  return 1 if ($hostdom =~ /^$host/);
}


##############################################################################
#
# isResolvable - PAC command to see if the host can be resolved via DNS.
#
##############################################################################
sub isResolvable {
  my ($host) = @_;
  return (defined(gethostbyname($host)) ? 1 : 0);
}


##############################################################################
#
# isInNet - PAC command to see if the IP address is in this network based on
#           the mask and pattern.
#
##############################################################################
sub isInNet {
  my ($host,$pattern,$mask) = @_;

  my $addr = dnsResolve($host);
  return unless defined($addr);

  my @addr = split(/\./,$addr);
  my @mask = split(/\./,$mask);
  my @pattern;

  foreach my $count (0..3) {
    my $bitAddr = dec2bin($addr[$count]);
    my $bitMask = dec2bin($mask[$count]);

    $pattern[$count] = bin2dec($bitAddr & $bitMask),"\n";
  }

  my $hostPattern = join(".",@pattern);
  return (($pattern eq $hostPattern) ? 1 : 0);
}


##############################################################################
#
# dec2bin - decimal to binary conversion
#
##############################################################################
sub dec2bin {
  my $str = unpack("B32", pack("N", shift));
  return $str;
}


##############################################################################
#
# bin2dec - binary to decimal conversion
#
##############################################################################
sub bin2dec {
  return unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}


##############################################################################
#
# dnsResolve - PAC command to get the IP from the host name.
#
##############################################################################
sub dnsResolve {
  my ($host) = @_;
  return unless isResolvable($host);
  return inet_ntoa(inet_aton($host));
}


##############################################################################
#
# myIpAddress - PAC command to get your IP.
#
##############################################################################
sub myIpAddress {
  return inet_ntoa(inet_aton(hostname()));
}


##############################################################################
#
# dnsDomainLevels - PAC command to tell how many domain levels there are in
#                   the host name (number of dots).
#
##############################################################################
sub dnsDomainLevels {
  my ($host) = @_;

  my $count = 0;
  foreach my $piece (split(/(\.)/,$host)) {
    $count++ if ($piece eq ".");
  }
  return $count;
}


##############################################################################
#
# shExpMatch - PAC command to see if a URL/path matches the shell expression.
#              Shell expressions are like  */foo/*  or http://*.
#
##############################################################################
sub shExpMatch {
  my ($str,$shellExp) = @_;

  $shellExp =~ s/\//\\\//g;
  $shellExp =~ s/\*/\.\*/g;

  return (($str =~ /$shellExp/) ? 1 : 0);
}


##############################################################################
#
# weekDayRange - PAC command to see if the current weekday falls within a
#                range.
#
##############################################################################
sub weekDayRange {
  my $wd1 = shift;
  my $wd2 = "";
  $wd2 = shift if ($_[0] ne "GMT");
  my $gmt = "";
  $gmt = shift if ($_[0] eq "GMT");

  my %wd = ( SUN=>0,MON=>1,TUE=>2,WED=>3,THU=>4,FRI=>5,SAT=>6);
  my $dow = (($gmt eq "GMT") ? (gmtime)[6] : (localtime)[6]);

  if ($wd2 eq "") {
    return (($dow eq $wd{$wd1}) ? 1 : 0);
  } else {
    my @range;
    if ($wd{$wd1} < $wd{$wd2}) {
      @range = ($wd{$wd1}..$wd{$wd2});
    } else {
      @range = ($wd{$wd1}..6,0..$wd{$wd2});
    }
    foreach my $tdow (@range) {
      return 1 if ($dow eq $tdow);
    }
    return 0;
  }
  return 0;
}


##############################################################################
#
# dateRange - PAC command to see if the current date falls within a range.
#
##############################################################################
sub dateRange {
  my %mon = ( JAN=>0,FEB=>1,MAR=>2,APR=>3,MAY=>4,JUN=>5,JUL=>6,AUG=>7,SEP=>8,OCT=>9,NOV=>10,DEC=>11);

  my %args;
  my $dayCount = 1;
  my $monCount = 1;
  my $yearCount = 1;

  while ($#_ > -1) {
    if ($_[0] eq "GMT") {
      $args{gmt} = shift;
    } elsif (exists($mon{$_[0]})) {
      my $month = shift;
      $args{"mon$monCount"} = $mon{$month};
      $monCount++;
    } elsif ($_[0] > 31) {
      $args{"year$yearCount"} = shift;
      $yearCount++;
    } else {
      $args{"day$dayCount"} = shift;
      $dayCount++;
    }
  }

  my $mday = (exists($args{gmt}) ? (gmtime)[3] : (localtime)[3]);
  my $mon = (exists($args{gmt}) ? (gmtime)[4] : (localtime)[4]);
  my $year = 1900+(exists($args{gmt}) ? (gmtime)[5] : (localtime)[5]);

  if (exists($args{day1}) && exists($args{mon1}) && exists($args{year1}) &&
      exists($args{day2}) && exists($args{mon2}) && exists($args{year2})) {

    if (($args{year1} < $year) && ($args{year2} > $year)) {
      return 1;
    } elsif (($args{year1} == $year) && ($args{mon1} <= $mon)) {
      return 1;
    } elsif (($args{year2} == $year) && ($args{mon2} >= $mon)) {
      return 1;
    } else {
      return 0;
    }
    return 0;


  } elsif (exists($args{mon1}) && exists($args{year1}) &&
	   exists($args{mon2}) && exists($args{year2})) {
    if (($args{year1} < $year) && ($args{year2} > $year)) {
      return 1;
    } elsif (($args{year1} == $year) && ($args{mon1} < $mon)) {
      return 1;
    } elsif (($args{year2} == $year) && ($args{mon2} > $mon)) {
      return 1;
    } elsif (($args{year1} == $year) && ($args{mon1} == $mon) &&
	     ($args{day1} <= $mday)) {
      return 1;
    } elsif (($args{year2} == $year) && ($args{mon2} == $mon) &&
	     ($args{day2} >= $mday)) {
      return 1;
    } else {
      return 0;
    }
    return 0;
  } elsif (exists($args{day1}) && exists($args{mon1}) &&
	   exists($args{day2}) && exists($args{mon2})) {
    if (($args{mon1} < $mon) && ($args{mon2} > $mon)) {
      return 1;
    } elsif (($args{mon1} == $mon) && ($args{day1} <= $mday)) {
      return 1;
    } elsif (($args{mon2} == $mon) && ($args{day2} >= $mday)) {
      return 1;
    } else {
      return 0;
    }
    return 0;
  } elsif (exists($args{year1}) && exists($args{year2})) {
    foreach my $tyear ($args{year1}..$args{year2}) {
      return 1 if ($tyear == $year);
    }
    return 0;
  } elsif (exists($args{mon1}) && exists($args{mon2})) {
    foreach my $tmon ($args{mon1}..$args{mon2}) {
      return 1 if ($tmon == $mon);
    }
    return 0;
  } elsif (exists($args{day1}) && exists($args{day2})) {
    foreach my $tmday ($args{day1}..$args{day2}) {
      return 1 if ($tmday == $mday);
    }
    return 0;
  } elsif (exists($args{year1})) {
    return (($args{year1} == $year) ? 1 : 0);
  } elsif (exists($args{mon1})) {
    return (($args{mon1} == $mon) ? 1 : 0);
  } elsif (exists($args{day1})) {
    return (($args{day1} == $mday) ? 1 : 0);
  } else {
    return 0;
  }

  return 0;

}


##############################################################################
#
# timeRange - PAC command to see if the current time falls within a range.
#
##############################################################################
sub timeRange {
  my %args;
  my $dayCount = 1;
  my $monCount = 1;
  my $yearCount = 1;

  $args{gmt} = pop(@_) if ($_[$#_] eq "GMT");

  if ($#_ == 0) {
    $args{hour1} = shift;
  } elsif ($#_ == 1) {
    $args{hour1} = shift;
    $args{hour2} = shift;
  } elsif ($#_ == 3) {
    $args{hour1} = shift;
    $args{min1} = shift;
    $args{hour2} = shift;
    $args{min2} = shift;
  } elsif ($#_ == 5) {
    $args{hour1} = shift;
    $args{min1} = shift;
    $args{sec1} = shift;
    $args{hour2} = shift;
    $args{min2} = shift;
    $args{sec2} = shift;
  }

  my $sec = (exists($args{gmt}) ? (gmtime)[0] : (localtime)[0]);
  my $min = (exists($args{gmt}) ? (gmtime)[1] : (localtime)[1]);
  my $hour = (exists($args{gmt}) ? (gmtime)[2] : (localtime)[2]);

  if (exists($args{sec1}) && exists($args{min1}) && exists($args{hour1}) &&
      exists($args{sec2}) && exists($args{min2}) && exists($args{hour2})) {

    if (($args{hour1} < $hour) && ($args{hour2} > $hour)) {
      return 1;
    } elsif (($args{hour1} == $hour) && ($args{min1} <= $min)) {
      return 1;
    } elsif (($args{hour2} == $hour) && ($args{min2} >= $min)) {
      return 1;
    } else {
      return 0;
    }
    return 0;


  } elsif (exists($args{min1}) && exists($args{hour1}) &&
	   exists($args{min2}) && exists($args{hour2})) {
    if (($args{hour1} < $hour) && ($args{hour2} > $hour)) {
      return 1;
    } elsif (($args{hour1} == $hour) && ($args{min1} < $min)) {
      return 1;
    } elsif (($args{hour2} == $hour) && ($args{min2} > $min)) {
      return 1;
    } elsif (($args{hour1} == $hour) && ($args{min1} == $min) &&
	     ($args{sec1} <= $sec)) {
      return 1;
    } elsif (($args{hour2} == $hour) && ($args{min2} == $min) &&
	     ($args{sec2} >= $sec)) {
      return 1;
    } else {
      return 0;
    }
    return 0;
  } elsif (exists($args{sec1}) && exists($args{min1}) &&
	   exists($args{sec2}) && exists($args{min2})) {
    if (($args{min1} < $min) && ($args{min2} > $min)) {
      return 1;
    } elsif (($args{min1} == $min) && ($args{sec1} <= $sec)) {
      return 1;
    } elsif (($args{min2} == $min) && ($args{sec2} >= $sec)) {
      return 1;
    } else {
      return 0;
    }
    return 0;
  } elsif (exists($args{hour1}) && exists($args{hour2})) {
    foreach my $thour ($args{hour1}..$args{hour2}) {
      return 1 if ($thour == $hour);
    }
    return 0;
  } elsif (exists($args{min1}) && exists($args{min2})) {
    foreach my $tmin ($args{min1}..$args{min2}) {
      return 1 if ($tmin == $min);
    }
    return 0;
  } elsif (exists($args{sec1}) && exists($args{sec2})) {
    foreach my $tsec ($args{sec1}..$args{sec2}) {
      return 1 if ($tsec == $sec);
    }
    return 0;
  } elsif (exists($args{hour1})) {
    return (($args{hour1} == $hour) ? 1 : 0);
  } elsif (exists($args{min1})) {
    return (($args{min1} == $min) ? 1 : 0);
  } elsif (exists($args{sec1})) {
    return (($args{sec1} == $sec) ? 1 : 0);
  } else {
    return 0;
  }

  return 0;

}


1;