[BACK]Return to cvsweb.cgi CVS log [TXT][DIR] Up to [cvsweb.bsd.lv] / cvsweb

Diff for /cvsweb/cvsweb.cgi between version 3.9 and 3.14

version 3.9, 2000/07/29 12:41:25 version 3.14, 2000/08/24 15:53:11
Line 1 
Line 1 
 #!/usr/bin/perl -ws  #!/usr/bin/perl5 -ws
 #  #
 # cvsweb - a CGI interface to CVS trees.  # cvsweb - a CGI interface to CVS trees.
 #  #
 # Written in their spare time by  # Written in their spare time by
 #             Bill Fenner      <fenner@FreeBSD.org>   (original work)  #             Bill Fenner      <fenner@FreeBSD.org>   (original work)
 # extended by Henner Zeller    <zeller@think.de>,  # extended by Henner Zeller    <zeller@think.de>,
 #             Henrik Nordstrom <hno@hem.passagen.se>  #             Henrik Nordstrom <hno@hem.passagen.se>
 #             Ken Coar         <coar@Apache.Org>  #             Ken Coar         <coar@Apache.Org>
 #             Dick Balaska     <dick@buckosoft.com>  #             Dick Balaska     <dick@buckosoft.com>
 #             Akinori MUSHA    <knu@FreeBSD.org>  #             Akinori MUSHA    <knu@FreeBSD.org>
Line 41 
Line 41 
 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF  # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 # SUCH DAMAGE.  # SUCH DAMAGE.
 #  #
 # $zId: cvsweb.cgi,v 1.93 2000/07/27 17:42:28 hzeller Exp $  # $zId: cvsweb.cgi,v 1.94 2000/08/24 06:41:22 hnordstrom Exp $
 # $Id$  # $Id$
 #  #
 ###  ###
Line 79  use vars qw (
Line 79  use vars qw (
     $use_moddate      $use_moddate
 );  );
   
   sub printDiffSelect($);
   sub findLastModifiedSubdirs(@);
   sub htmlify($;$);
   sub spacedHtmlText($);
   sub link($$);
   sub revcmp($$);
   sub fatal($$);
   sub redirect($);
   sub safeglob($);
   sub getMimeTypeFromSuffix($);
   sub doAnnotate($$);
   sub doCheckout($$);
   sub cvswebMarkup($$$);
   sub viewable($);
   sub doDiff($$$$$$);
   sub getDirLogs($$@);
   sub readLog($;$);
   sub printLog($;$);
   sub doLog($);
   sub flush_diff_rows($$$$);
   sub human_readable_diff($);
   sub navigateHeader($$$$$);
   sub plural_write($$);
   sub readableTime($$);
   sub clickablePath($$);
   sub chooseCVSRoot();
   sub chooseMirror();
   sub fileSortCmp();
   sub download_url($$;$);
   sub download_link($$$;$);
   sub toggleQuery($$);
   sub urlencode($);
   sub http_header(;$);
   sub html_header($);
   sub html_footer();
   sub link_tags($);
   sub forbidden_module($);
   
 ##### Start of Configuration Area ########  ##### Start of Configuration Area ########
 # == EDIT this ==  use Cwd;
   
   # == EDIT this ==
 # User configuration is stored in  # User configuration is stored in
 $config = defined($ENV{CVSWEB_CONFIG}) ? $ENV{CVSWEB_CONFIG} : '/usr/local/etc/cvsweb.conf';  $config = undef;
   
   for ($ENV{CVSWEB_CONFIG},
   #     '/home/knu/etc/cvsweb.conf',
        '/usr/local/etc/cvsweb.conf',
        getcwd . '/cvsweb.conf') {
     $config = $_ if defined($_) && -r $_;
   }
   
 # == Configuration defaults ==  # == Configuration defaults ==
 # Defaults for configuration variables that shouldn't need  # Defaults for configuration variables that shouldn't need
 # to be configured..  # to be configured..
Line 105  $difffontsize = $inputTextSize = $mime_types = $allow_
Line 152  $difffontsize = $inputTextSize = $mime_types = $allow_
 $allow_markup = $use_java_script = $open_extern_window =  $allow_markup = $use_java_script = $open_extern_window =
 $extern_window_width = $extern_window_height = $edit_option_form =  $extern_window_width = $extern_window_height = $edit_option_form =
 $checkout_magic = $show_subdir_lastmod = $show_log_in_markup = $v =  $checkout_magic = $show_subdir_lastmod = $show_log_in_markup = $v =
 $navigationHeaderColor = $tableBorderColor = $markupLogColor =  $navigationHeaderColor = $tableBorderColor = $markupLogColor =
 $tabstop = $use_moddate = $moddate = undef;  $tabstop = $use_moddate = $moddate = undef;
   
 ##### End of configuration variables #####  ##### End of configuration variables #####
Line 133  $is_mod_perl = defined($ENV{MOD_PERL});
Line 180  $is_mod_perl = defined($ENV{MOD_PERL});
 # in lynx, it it very annoying to have two links  # in lynx, it it very annoying to have two links
 # per file, so disable the link at the icon  # per file, so disable the link at the icon
 # in this case:  # in this case:
 $Browser = $ENV{HTTP_USER_AGENT} || '';  $Browser = $ENV{HTTP_USER_AGENT};
 $is_lynx = ($Browser =~ m`^Lynx/`i);  $is_lynx = ($Browser =~ m`^Lynx/`i);
 $is_w3m = ($Browser =~ m`^w3m/`i);  $is_w3m = ($Browser =~ m`^w3m/`i);
 $is_msie = ($Browser =~ m`MSIE`);  $is_msie = ($Browser =~ m`MSIE`);
Line 153  $nofilelinks = $is_textbased;
Line 200  $nofilelinks = $is_textbased;
 # Turn off gzip if running under mod_perl. piping does  # Turn off gzip if running under mod_perl. piping does
 # not work as expected inside the server. One can probably  # not work as expected inside the server. One can probably
 # achieve the same result using Apache::GZIPFilter.  # achieve the same result using Apache::GZIPFilter.
 $maycompress =(($ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`  $maycompress = (($ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`
                 || $is_mozilla3)                   || $is_mozilla3)
                && !$is_msie                  && !$is_msie
                && !$is_mod_perl);                  && !$is_mod_perl);
   
 # put here the variables we need in order  # put here the variables we need in order
 # to hold our state - they will be added (with  # to hold our state - they will be added (with
 # their current value) to any link/query string  # their current value) to any link/query string
 # you construct  # you construct
 @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);  @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);
   
Line 178  else {
Line 225  else {
 undef %input;  undef %input;
 $query = $ENV{QUERY_STRING};  $query = $ENV{QUERY_STRING};
   
 if ($query ne '') {  if (defined($query) && $query ne '') {
     foreach (split(/&/, $query)) {      foreach (split(/&/, $query)) {
         s/%(..)/sprintf("%c", hex($1))/ge;      # unquote %-quoted          s/%(..)/sprintf("%c", hex($1))/ge;      # unquote %-quoted
         if (/(\S+)=(.*)/) {          if (/(\S+)=(.*)/) {
Line 190  if ($query ne '') {
Line 237  if ($query ne '') {
     }      }
 }  }
   
 # For backwards compability, set only_with_tag to only_on_branch if set.  # For backwards compability, set only_with_tag to only_on_branch if set.
 $input{only_with_tag} = $input{only_on_branch}  $input{only_with_tag} = $input{only_on_branch}
     if (defined($input{only_on_branch}));      if (defined($input{only_on_branch}));
   
Line 217  foreach (keys %DEFAULTVALUE)
Line 264  foreach (keys %DEFAULTVALUE)
         }          }
     }      }
 }  }
   
 $barequery = "";  $barequery = "";
 foreach (@stickyvars) {  foreach (@stickyvars) {
     # construct a query string with the sticky non default parameters set      # construct a query string with the sticky non default parameters set
     if (defined($input{$_}) && $input{$_} ne '' &&      if (defined($input{$_}) && $input{$_} ne '' &&
         !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) {          !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) {
         if ($barequery) {          if ($barequery) {
             $barequery = $barequery . "&amp;";              $barequery = $barequery . "&amp;";
Line 309  $defaultViewable = $allow_markup && viewable($mimetype
Line 356  $defaultViewable = $allow_markup && viewable($mimetype
 # search for GZIP if compression allowed  # search for GZIP if compression allowed
 # We've to find out if the GZIP-binary exists .. otherwise  # We've to find out if the GZIP-binary exists .. otherwise
 # ge get an Internal Server Error if we try to pipe the  # ge get an Internal Server Error if we try to pipe the
 # output through the nonexistent gzip ..  # output through the nonexistent gzip ..
 # any more elegant ways to prevent this are welcome!  # any more elegant ways to prevent this are welcome!
 if ($allow_compress && $maycompress) {  if ($allow_compress && $maycompress) {
     foreach (split(/:/, $ENV{PATH})) {      foreach (split(/:/, $ENV{PATH})) {
Line 390  elsif (-d $fullname) {
Line 437  elsif (-d $fullname) {
                 $input{only_with_tag};                  $input{only_with_tag};
   
         }          }
   
   
   
         print "<HR NOSHADE>\n";          print "<HR NOSHADE>\n";
         # Using <MENU> in this manner violates the HTML2.0 spec but          # Using <MENU> in this manner violates the HTML2.0 spec but
         # provides the results that I want in most browsers.  Another          # provides the results that I want in most browsers.  Another
         # case of layout spooging up HTML.          # case of layout spooging up HTML.
   
         my $infocols = 0;          my $infocols = 0;
         if ($dirtable) {          if ($dirtable) {
             if (defined($tableBorderColor)) {              if (defined($tableBorderColor)) {
Line 405  elsif (-d $fullname) {
Line 452  elsif (-d $fullname) {
             }              }
             print "<table  width=\"100%\" border=0 cellspacing=1 cellpadding=$tablepadding>\n";              print "<table  width=\"100%\" border=0 cellspacing=1 cellpadding=$tablepadding>\n";
             $infocols++;              $infocols++;
             print "<tr><th align=left bgcolor=\"" . (($byfile) ?              print "<tr><th align=left bgcolor=\"" . (($byfile) ?
                                                    $columnHeaderColorSorted :                                                     $columnHeaderColorSorted :
                                                    $columnHeaderColorDefault) . "\">";                                                     $columnHeaderColorDefault) . "\">";
             print "<a href=\"./" . &toggleQuery("sortby","file") .              print "<a href=\"./" . &toggleQuery("sortby","file") .
                 "#dirlist\">" if (!$byfile);                  "#dirlist\">" if (!$byfile);
Line 417  elsif (-d $fullname) {
Line 464  elsif (-d $fullname) {
             # with revision information:              # with revision information:
             if (scalar(%fileinfo)) {              if (scalar(%fileinfo)) {
                 $infocols++;                  $infocols++;
                 print "<th align=left bgcolor=\"" . (($byrev) ?                  print "<th align=left bgcolor=\"" . (($byrev) ?
                                                    $columnHeaderColorSorted :                                                     $columnHeaderColorSorted :
                                                    $columnHeaderColorDefault) . "\">";                                                     $columnHeaderColorDefault) . "\">";
                 print "<a href=\"./" . &toggleQuery ("sortby","rev") .                  print "<a href=\"./" . &toggleQuery ("sortby","rev") .
                     "#dirlist\">" if (!$byrev);                      "#dirlist\">" if (!$byrev);
Line 426  elsif (-d $fullname) {
Line 473  elsif (-d $fullname) {
                 print "</a>" if (!$byrev);                  print "</a>" if (!$byrev);
                 print "</th>";                  print "</th>";
                 $infocols++;                  $infocols++;
                 print "<th align=left bgcolor=\"" . (($bydate) ?                  print "<th align=left bgcolor=\"" . (($bydate) ?
                                                    $columnHeaderColorSorted :                                                     $columnHeaderColorSorted :
                                                    $columnHeaderColorDefault) . "\">";                                                     $columnHeaderColorDefault) . "\">";
                 print "<a href=\"./" . &toggleQuery ("sortby","date") .                  print "<a href=\"./" . &toggleQuery ("sortby","date") .
                     "#dirlist\">" if (!$bydate);                      "#dirlist\">" if (!$bydate);
Line 436  elsif (-d $fullname) {
Line 483  elsif (-d $fullname) {
                 print "</th>";                  print "</th>";
                 if ($show_author) {                  if ($show_author) {
                     $infocols++;                      $infocols++;
                     print "<th align=left bgcolor=\"" . (($byauthor) ?                      print "<th align=left bgcolor=\"" . (($byauthor) ?
                                                    $columnHeaderColorSorted :                                                     $columnHeaderColorSorted :
                                                    $columnHeaderColorDefault) . "\">";                                                     $columnHeaderColorDefault) . "\">";
                     print "<a href=\"./" . &toggleQuery ("sortby","author") .                      print "<a href=\"./" . &toggleQuery ("sortby","author") .
                             "#dirlist\">" if (!$byauthor);                              "#dirlist\">" if (!$byauthor);
Line 446  elsif (-d $fullname) {
Line 493  elsif (-d $fullname) {
                     print "</th>";                      print "</th>";
                 }                  }
                 $infocols++;                  $infocols++;
                 print "<th align=left bgcolor=\"" . (($bylog) ?                  print "<th align=left bgcolor=\"" . (($bylog) ?
                                                $columnHeaderColorSorted :                                                 $columnHeaderColorSorted :
                                                $columnHeaderColorDefault) . "\">";                                                 $columnHeaderColorDefault) . "\">";
                 print "<a href=\"./", toggleQuery("sortby","log"), "#dirlist\">" if (!$bylog);                  print "<a href=\"./", toggleQuery("sortby","log"), "#dirlist\">" if (!$bylog);
                 print "Last log entry";                  print "Last log entry";
Line 465  elsif (-d $fullname) {
Line 512  elsif (-d $fullname) {
             print "<menu>\n";              print "<menu>\n";
         }          }
         my $dirrow = 0;          my $dirrow = 0;
   
         my $i;          my $i;
         lookingforattic:          lookingforattic:
         for ($i = 0; $i <= $#dir; $i++) {          for ($i = 0; $i <= $#dir; $i++) {
Line 480  elsif (-d $fullname) {
Line 527  elsif (-d $fullname) {
             closedir($dh);              closedir($dh);
         }          }
   
         my $hideAtticToggleLink = "<a href=\"./" .          my $hideAtticToggleLink = "<a href=\"./" .
                 &toggleQuery ("hideattic") .                  &toggleQuery ("hideattic") .
                 "#dirlist\">[Hide]</a>" if (!$input{'hideattic'});                  "#dirlist\">[Hide]</a>" if (!$input{'hideattic'});
   
Line 542  elsif (-d $fullname) {
Line 589  elsif (-d $fullname) {
                     }                      }
                     print " ", &link($_ . "/", $url), $attic;                      print " ", &link($_ . "/", $url), $attic;
                     if ($_ eq "Attic") {                      if ($_ eq "Attic") {
                         print "&nbsp; <a href=\"./" .                          print "&nbsp; <a href=\"./" .
                             &toggleQuery ("hideattic") .                              &toggleQuery ("hideattic") .
                                 "#dirlist\">[Don't hide]</a>";                                  "#dirlist\">[Don't hide]</a>";
                     }                      }
                 }                  }
                 # Show last change in dir                  # Show last change in dir
                 if ($filename) {                  if ($filename) {
                     print "</td><td>&nbsp;</td><td>&nbsp;" if ($dirtable);                      print "</td><td>&nbsp;</td><td>&nbsp;" if ($dirtable);
Line 615  elsif (-d $fullname) {
Line 662  elsif (-d $fullname) {
                 print " ", &link($_, $url), $attic;                  print " ", &link($_, $url), $attic;
                 print "</td><td>&nbsp;" if ($dirtable);                  print "</td><td>&nbsp;" if ($dirtable);
                 download_link($fileurl,                  download_link($fileurl,
                         $rev, $rev,                          $rev, $rev,
                         $defaultViewable ? "text/x-cvsweb-markup" : undef);                          $defaultViewable ? "text/x-cvsweb-markup" : undef);
                 print "</td><td>&nbsp;" if ($dirtable);                  print "</td><td>&nbsp;" if ($dirtable);
                 if ($date) {                  if ($date) {
Line 643  elsif (-d $fullname) {
Line 690  elsif (-d $fullname) {
             print "</td></tr></table>";              print "</td></tr></table>";
         }          }
         print "". ($dirtable == 1) ? "</table>" : "</menu>" . "\n";          print "". ($dirtable == 1) ? "</table>" : "</menu>" . "\n";
   
         if ($filesexists && !$filesfound) {          if ($filesexists && !$filesfound) {
             print "<P><B>NOTE:</B> There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n";              print "<P><B>NOTE:</B> There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n";
         }          }
         if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) {          if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) {
             %tags = %alltags              %tags = %alltags
         }          }
         if (scalar %tags          if (scalar %tags
             || $input{only_with_tag}              || $input{only_with_tag}
             || $edit_option_form              || $edit_option_form
             || defined($input{"options"})) {              || defined($input{"options"})) {
             print "<hr size=1 NOSHADE>";              print "<hr size=1 NOSHADE>";
Line 672  elsif (-d $fullname) {
Line 719  elsif (-d $fullname) {
             print ">";              print ">";
             print "<OPTION VALUE=\"\">All tags / default branch\n";              print "<OPTION VALUE=\"\">All tags / default branch\n";
             foreach my $tag (reverse sort { lc $a cmp lc $b } keys %tags) {              foreach my $tag (reverse sort { lc $a cmp lc $b } keys %tags) {
                 print "<OPTION",defined($input{only_with_tag}) &&                  print "<OPTION",defined($input{only_with_tag}) &&
                        $input{only_with_tag} eq $tag ? " SELECTED":"",                         $input{only_with_tag} eq $tag ? " SELECTED" : "",
                        ">$tag\n";                         ">$tag\n";
             }              }
             print "</SELECT>\n";              print "</SELECT>\n";
Line 706  elsif (-d $fullname) {
Line 753  elsif (-d $fullname) {
             print "<OPTION VALUE=rev",$logsort eq "rev" ? " SELECTED" : "", ">Revision";              print "<OPTION VALUE=rev",$logsort eq "rev" ? " SELECTED" : "", ">Revision";
             print "</SELECT></td></tr>";              print "</SELECT></td></tr>";
             print "<tr><td>Diff format: ";              print "<tr><td>Diff format: ";
             printDiffSelect();              printDiffSelect(0);
             print "</td>";              print "</td>";
             print "<td>Show Attic files: ";              print "<td>Show Attic files: ";
             print "<INPUT NAME=hideattic TYPE=CHECKBOX", $input{'hideattic'}?" CHECKED":"",              print "<INPUT NAME=hideattic TYPE=CHECKBOX", $input{'hideattic'} ? " CHECKED" : "",
             "></td></tr>\n";              "></td></tr>\n";
             print "<tr><td align=center colspan=2><input type=submit value=\"Change Options\">";              print "<tr><td align=center colspan=2><input type=submit value=\"Change Options\">";
             print "</td></tr></table></center></FORM>\n";              print "</td></tr></table></center></FORM>\n";
         }          }
         print &html_footer;          print &html_footer;
         print "</BODY></HTML>\n";          print "</BODY></HTML>\n";
     }      }
   
 ###############################  ###############################
 # View Files  # View Files
Line 790  elsif (-d $fullname) {
Line 837  elsif (-d $fullname) {
     }      }
 ## End MAIN  ## End MAIN
   
 sub printDiffSelect {  sub printDiffSelect($) {
     my ($use_java_script) = @_;      my ($use_java_script) = @_;
     $use_java_script = 0 if (!defined($use_java_script));  
     my ($f) = $input{'f'};      my ($f) = $input{'f'};
     print "<SELECT NAME=\"f\"";      print "<SELECT NAME=\"f\"";
     print " onchange=\"submit()\"" if ($use_java_script);      print " onchange=\"submit()\"" if ($use_java_script);
Line 805  sub printDiffSelect {
Line 851  sub printDiffSelect {
     print "</SELECT>";      print "</SELECT>";
 }  }
   
 sub findLastModifiedSubdirs {  sub findLastModifiedSubdirs(@) {
     my (@dirs) = @_;      my (@dirs) = @_;
     my ($dirname, @files);      my ($dirname, @files);
   
Line 839  sub findLastModifiedSubdirs {
Line 885  sub findLastModifiedSubdirs {
     return @files;      return @files;
 }  }
   
 sub htmlify {  sub htmlify($;$) {
         my($string, $pr) = @_;          my($string, $pr) = @_;
   
         # Special Characters; RFC 1866          # Special Characters; RFC 1866
         $string =~ s/&/&amp;/g;          $string =~ s/&/&amp;/g;
         $string =~ s/\"/&quot;/g;          $string =~ s/\"/&quot;/g;
         $string =~ s/</&lt;/g;          $string =~ s/</&lt;/g;
         $string =~ s/>/&gt;/g;          $string =~ s/>/&gt;/g;
   
Line 862  sub htmlify {
Line 908  sub htmlify {
         return $string;          return $string;
 }  }
   
 sub spacedHtmlText {  sub spacedHtmlText($) {
         my($string, $pr) = @_;          local $_ = $_[0];
   
         # Cut trailing spaces          # Cut trailing spaces
         s/\s+$//;          s/\s+\n$//;
   
         # Expand tabs          # Expand tabs
         $string =~ s/\t+/' ' x (length($&) * $tabstop - length($`) % $tabstop)/e          s/\t+/' ' x (length($&) * $tabstop - length($`) % $tabstop)/e
             if (defined($tabstop));              if (defined($tabstop));
   
         # replace <tab> and <space> (\001 is to protect us from htmlify)          # replace <tab> and <space> (\001 is to protect us from htmlify)
         # gzip can make excellent use of this repeating pattern :-)          # gzip can make excellent use of this repeating pattern :-)
         $string =~ s/\001/\001%/g; #protect our & substitute          s/\001/\001%/g; #protect our & substitute
         if ($hr_breakable) {          if ($hr_breakable) {
             # make every other space 'breakable'              # make every other space 'breakable'
             $string =~ s/       / \001nbsp; \001nbsp; \001nbsp; \001nbsp;/g;    # <tab>              s/  / \001nbsp; \001nbsp; \001nbsp; \001nbsp;/g;    # <tab>
             $string =~ s/  / \001nbsp;/g;                              # 2 * <space>              s/  / \001nbsp;/g;                              # 2 * <space>
             # leave single space as it is              # leave single space as it is
         }          }
         else {          else {
             $string =~ s/       /\001nbsp;\001nbsp;\001nbsp;\001nbsp;\001nbsp;\001nbsp;\001nbsp;\001nbsp;/g;              s/  /\001nbsp;\001nbsp;\001nbsp;\001nbsp;\001nbsp;\001nbsp;\001nbsp;\001nbsp;/g;
             $string =~ s/ /\001nbsp;/g;              s/ /\001nbsp;/g;
         }          }
   
         $string = htmlify($string);          $_ = htmlify($_);
   
         # unescape          # unescape
         $string =~ s/\001([^%])/&$1/g;          s/\001([^%])/&$1/g;
         $string =~ s/\001%/\001/g;          s/\001%/\001/g;
   
         return $string;          return $_;
 }  }
   
 sub link {  sub link($$) {
         my($name, $where) = @_;          my($name, $where) = @_;
   
         return "<A HREF=\"$where\">$name</A>\n";          return "<A HREF=\"$where\">$name</A>\n";
 }  }
   
 sub revcmp {  sub revcmp($$) {
         my($rev1, $rev2) = @_;          my($rev1, $rev2) = @_;
         my(@r1) = split(/\./, $rev1);          my(@r1) = split(/\./, $rev1);
         my(@r2) = split(/\./, $rev2);          my(@r2) = split(/\./, $rev2);
Line 917  sub revcmp {
Line 963  sub revcmp {
         return 0;          return 0;
 }  }
   
 sub fatal {  sub fatal($$) {
         my($errcode, $errmsg) = @_;          my($errcode, $errmsg) = @_;
         if ($is_mod_perl) {          if ($is_mod_perl) {
                 Apache->request->status((split(/ /, $errcode))[0]);                  Apache->request->status((split(/ /, $errcode))[0]);
Line 931  sub fatal {
Line 977  sub fatal {
         exit(1);          exit(1);
 }  }
   
 sub redirect {  sub redirect($) {
         my($url) = @_;          my($url) = @_;
         if ($is_mod_perl) {          if ($is_mod_perl) {
                 Apache->request->status(301);                  Apache->request->status(301);
Line 947  sub redirect {
Line 993  sub redirect {
         exit(1);          exit(1);
 }  }
   
 sub safeglob {  sub safeglob($) {
         my ($filename) = @_;          my ($filename) = @_;
         my ($dirname);          my ($dirname);
         my (@results);          my (@results);
Line 976  sub safeglob {
Line 1022  sub safeglob {
         @results;          @results;
 }  }
   
 sub getMimeTypeFromSuffix {  sub getMimeTypeFromSuffix($) {
     my ($fullname) = @_;      my ($fullname) = @_;
     my ($mimetype, $suffix);      my ($mimetype, $suffix);
     my $fh = do {local(*FH);};      my $fh = do {local(*FH);};
Line 984  sub getMimeTypeFromSuffix {
Line 1030  sub getMimeTypeFromSuffix {
     ($suffix = $fullname) =~ s/^.*\.([^.]*)$/$1/;      ($suffix = $fullname) =~ s/^.*\.([^.]*)$/$1/;
     $mimetype = $MTYPES{$suffix};      $mimetype = $MTYPES{$suffix};
     $mimetype = $MTYPES{'*'} if (!$mimetype);      $mimetype = $MTYPES{'*'} if (!$mimetype);
   
     if (!$mimetype && -f $mime_types) {      if (!$mimetype && -f $mime_types) {
         # okey, this is something special - search the          # okey, this is something special - search the
         # mime.types database          # mime.types database
Line 997  sub getMimeTypeFromSuffix {
Line 1043  sub getMimeTypeFromSuffix {
         }          }
         close ($fh);          close ($fh);
     }      }
   
 # okey, didn't find anything useful ..  # okey, didn't find anything useful ..
     if (!($mimetype =~ /\S\/\S/)) {      if (!($mimetype =~ /\S\/\S/)) {
         $mimetype = "text/plain";          $mimetype = "text/plain";
Line 1008  sub getMimeTypeFromSuffix {
Line 1054  sub getMimeTypeFromSuffix {
 ###############################  ###############################
 # show Annotation  # show Annotation
 ###############################  ###############################
 sub doAnnotate ($$) {  sub doAnnotate($$) {
     my ($rev) = @_;      my ($rev) = @_;
     my ($pid);      my ($pid);
     my ($pathname, $filename);      my ($pathname, $filename);
Line 1027  sub doAnnotate ($$) {
Line 1073  sub doAnnotate ($$) {
   
     http_header();      http_header();
   
     navigateHeader ($scriptwhere,$pathname,$filename,$rev, "annotate");      navigateHeader($scriptwhere,$pathname,$filename,$rev, "annotate");
     print "<h3 align=center>Annotation of $pathname$filename, Revision $rev</h3>\n";      print "<h3 align=center>Annotation of $pathname$filename, Revision $rev</h3>\n";
   
     # this seems to be necessary      # this seems to be necessary
Line 1039  sub doAnnotate ($$) {
Line 1085  sub doAnnotate ($$) {
     # the public domain.      # the public domain.
     # we could abandon the use of rlog, rcsdiff and co using      # we could abandon the use of rlog, rcsdiff and co using
     # the cvsserver in a similiar way one day (..after rewrite)      # the cvsserver in a similiar way one day (..after rewrite)
     $pid = open2($reader, $writer, "cvs server") || fatal ("500 Internal Error",      $pid = open2($reader, $writer, "cvs server") || fatal ("500 Internal Error",
                                                                "Fatal Error - unable to open cvs for annotation");                                                                 "Fatal Error - unable to open cvs for annotation");
   
     # OK, first send the request to the server.  A simplified example is:      # OK, first send the request to the server.  A simplified example is:
     #     Root /home/kingdon/zwork/cvsroot      #     Root /home/kingdon/zwork/cvsroot
     #     Argument foo/xx      #     Argument foo/xx
Line 1051  sub doAnnotate ($$) {
Line 1097  sub doAnnotate ($$) {
     #     /home/kingdon/zwork/cvsroot      #     /home/kingdon/zwork/cvsroot
     #     annotate      #     annotate
     # although as you can see there are a few more details.      # although as you can see there are a few more details.
   
     print $writer "Root $cvsroot\n";      print $writer "Root $cvsroot\n";
     print $writer "Valid-responses ok error Valid-requests Checked-in Updated Merged Removed M E\n";      print $writer "Valid-responses ok error Valid-requests Checked-in Updated Merged Removed M E\n";
     # Don't worry about sending valid-requests, the server just needs to      # Don't worry about sending valid-requests, the server just needs to
Line 1071  sub doAnnotate ($$) {
Line 1117  sub doAnnotate ($$) {
         if ($path eq "") {          if ($path eq "") {
             # In our example, $_ is "dir".              # In our example, $_ is "dir".
             $path = $_;              $path = $_;
         }          }
         else {          else {
             print $writer "Directory $path\n";              print $writer "Directory $path\n";
             print $writer "$cvsroot/$path\n";              print $writer "$cvsroot/$path\n";
Line 1084  sub doAnnotate ($$) {
Line 1130  sub doAnnotate ($$) {
     # And the last "Directory" before "annotate" is the top level.      # And the last "Directory" before "annotate" is the top level.
     print $writer "Directory .\n";      print $writer "Directory .\n";
     print $writer "$cvsroot\n";      print $writer "$cvsroot\n";
   
     print $writer "annotate\n";      print $writer "annotate\n";
     # OK, we've sent our command to the server.  Thing to do is to      # OK, we've sent our command to the server.  Thing to do is to
     # close the writer side and get all the responses.  If "cvs server"      # close the writer side and get all the responses.  If "cvs server"
     # were nicer about buffering, then we could just leave it open, I think.      # were nicer about buffering, then we could just leave it open, I think.
     close ($writer) || die "cannot close: $!";      close ($writer) || die "cannot close: $!";
   
     # Ready to get the responses from the server.      # Ready to get the responses from the server.
     # For example:      # For example:
     #     E Annotations for foo/xx      #     E Annotations for foo/xx
     #     E ***************      #     E ***************
     #     M 1.3          (kingdon  06-Sep-97): hello      #     M 1.3          (kingdon  06-Sep-97): hello
     #     ok      #     ok
     my ($lineNr) = 0;      my ($lineNr) = 0;
     my ($oldLrev, $oldLusr) = ("", "");      my ($oldLrev, $oldLusr) = ("", "");
Line 1136  sub doAnnotate ($$) {
Line 1182  sub doAnnotate ($$) {
             # is there a less timeconsuming way to strip spaces ?              # is there a less timeconsuming way to strip spaces ?
             ($lrev = $lrev) =~ s/\s+//g;              ($lrev = $lrev) =~ s/\s+//g;
             my $isCurrentRev = ($rev eq $lrev);              my $isCurrentRev = ($rev eq $lrev);
   
             print "<b>" if ($isCurrentRev);              print "<b>" if ($isCurrentRev);
             printf ("%8s%s%8s %4d:", $revprint, ($isCurrentRev ? "|" : " "), $usrprint, $lineNr);              printf ("%8s%s%8s %4d:", $revprint, ($isCurrentRev ? "|" : " "), $usrprint, $lineNr);
             print spacedHtmlText($line);              print spacedHtmlText($line);
Line 1163  sub doAnnotate ($$) {
Line 1209  sub doAnnotate ($$) {
 ###############################  ###############################
 # make Checkout  # make Checkout
 ###############################  ###############################
 sub doCheckout {  sub doCheckout($$) {
     my ($fullname, $rev) = @_;      my ($fullname, $rev) = @_;
     my ($mimetype,$revopt);      my ($mimetype,$revopt);
     my $fh = do {local(*FH);};      my $fh = do {local(*FH);};
Line 1197  sub doCheckout {
Line 1243  sub doCheckout {
             $moddate=$date{$symrev{HEAD}};              $moddate=$date{$symrev{HEAD}};
         }          }
     }      }
   
     ### just for the record:      ### just for the record:
     ### 'cvs co' seems to have a bug regarding single checkout of      ### 'cvs co' seems to have a bug regarding single checkout of
     ### directories/files having spaces in it;      ### directories/files having spaces in it;
Line 1207  sub doCheckout {
Line 1253  sub doCheckout {
     if (! open($fh, "-|")) { # child      if (! open($fh, "-|")) { # child
       open(STDERR, ">&STDOUT"); # Redirect stderr to stdout        open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
       exec("cvs", "-d", $cvsroot, "co", "-p", $revopt, $where);        exec("cvs", "-d", $cvsroot, "co", "-p", $revopt, $where);
     }      }
 #===================================================================  #===================================================================
 #Checking out squid/src/ftp.c  #Checking out squid/src/ftp.c
 #RCS:  /usr/src/CVS/squid/src/ftp.c,v  #RCS:  /usr/src/CVS/squid/src/ftp.c,v
Line 1246  sub doCheckout {
Line 1292  sub doCheckout {
     close($fh);      close($fh);
 }  }
   
 sub cvswebMarkup {  sub cvswebMarkup($$$) {
     my ($filehandle,$fullname,$revision) = @_;      my ($filehandle,$fullname,$revision) = @_;
     my ($pathname, $filename);      my ($pathname, $filename);
   
Line 1256  sub cvswebMarkup {
Line 1302  sub cvswebMarkup {
   
     http_header();      http_header();
   
     navigateHeader ($scriptwhere, $pathname, $filename, $revision, "view");      navigateHeader($scriptwhere, $pathname, $filename, $revision, "view");
     print "<HR noshade>";      print "<HR noshade>";
     print "<table width=\"100%\"><tr><td bgcolor=\"$markupLogColor\">";      print "<table width=\"100%\"><tr><td bgcolor=\"$markupLogColor\">";
     print "File: ", &clickablePath($where, 1);      print "File: ", &clickablePath($where, 1);
Line 1264  sub cvswebMarkup {
Line 1310  sub cvswebMarkup {
     &download_link(urlencode($fileurl), $revision, "(download)");      &download_link(urlencode($fileurl), $revision, "(download)");
     if (!$defaultTextPlain) {      if (!$defaultTextPlain) {
         print "&nbsp;";          print "&nbsp;";
         &download_link(urlencode($fileurl), $revision, "(as text)",          &download_link(urlencode($fileurl), $revision, "(as text)",
                "text/plain");                 "text/plain");
     }      }
     print "<BR>\n";      print "<BR>\n";
Line 1296  sub cvswebMarkup {
Line 1342  sub cvswebMarkup {
 sub viewable($) {  sub viewable($) {
     my ($mimetype) = @_;      my ($mimetype) = @_;
   
     $mimetype =~ m%^text/% ||      $mimetype =~ m%^(text|image)/%;
     $mimetype =~ m%^image/% ||  
     0;  
 }  }
   
 ###############################  ###############################
 # Show Colored Diff  # Show Colored Diff
 ###############################  ###############################
 sub doDiff {  sub doDiff($$$$$$) {
         my($fullname, $r1, $tr1, $r2, $tr2, $f) = @_;          my($fullname, $r1, $tr1, $r2, $tr2, $f) = @_;
         my $fh = do {local(*FH);};          my $fh = do {local(*FH);};
         my ($rev1, $rev2, $sym1, $sym2, @difftype, $diffname, $f1, $f2);          my ($rev1, $rev2, $sym1, $sym2, @difftype, $diffname, $f1, $f2);
Line 1448  sub doDiff {
Line 1492  sub doDiff {
 ###############################  ###############################
 # Show Logs ..  # Show Logs ..
 ###############################  ###############################
 sub getDirLogs {  sub getDirLogs($$@) {
     my ($cvsroot,$dirname,@otherFiles) = @_;      my ($cvsroot,$dirname,@otherFiles) = @_;
     my ($state,$otherFiles,$tag, $file, $date, $branchpoint, $branch, $log);      my ($state,$otherFiles,$tag, $file, $date, $branchpoint, $branch, $log);
     my ($rev, $revision, $revwanted, $filename, $head, $author);      my ($rev, $revision, $revwanted, $filename, $head, $author);
Line 1466  sub getDirLogs {
Line 1510  sub getDirLogs {
     }      }
   
     # just execute rlog if there are any files      # just execute rlog if there are any files
     if ($#files < 0) {      if ($#files < 0) {
         return;          return;
     }      }
   
Line 1511  again:
Line 1555  again:
         }          }
         if ($state eq "head" && /^symbolic names/) {          if ($state eq "head" && /^symbolic names/) {
             $state = "tags";              $state = "tags";
             ($branch = $head) =~ s/\.\d+$// if (!defined($branch));              ($branch = $head) =~ s/\.\d+$// if (!defined($branch));
             $branch =~ s/(\.?)(\d+)$/${1}0.$2/;              $branch =~ s/(\.?)(\d+)$/${1}0.$2/;
             $symrev{MAIN} = $branch;              $symrev{MAIN} = $branch;
             $symrev{HEAD} = $branch;              $symrev{HEAD} = $branch;
Line 1609  again:
Line 1653  again:
         }          }
     }      }
     if ($. == 0) {      if ($. == 0) {
         fatal("500 Internal Error",          fatal("500 Internal Error",
               "Failed to spawn GNU rlog on <em>'".join(", ", @files)."'</em><p>did you set the <b>\$ENV{PATH}</b> in your configuration file correctly ?");                "Failed to spawn GNU rlog on <em>'".join(", ", @files)."'</em><p>did you set the <b>\$ENV{PATH}</b> in your configuration file correctly ?");
     }      }
     close($fh);      close($fh);
 }  }
   
 sub readLog {  sub readLog($;$) {
         my($fullname,$revision) = @_;          my($fullname,$revision) = @_;
         my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev);          my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev);
         my $fh = do {local(*FH);};          my $fh = do {local(*FH);};
Line 1878  sub printLog($;$) {
Line 1922  sub printLog($;$) {
             }              }
             if (not $defaultTextPlain) {              if (not $defaultTextPlain) {
                 print " / ";                  print " / ";
                 &download_link($fileurl, $_, "(as text)",                  &download_link($fileurl, $_, "(as text)",
                            "text/plain");                             "text/plain");
             }              }
             if (!$defaultViewable) {              if (!$defaultViewable) {
Line 2019  sub printLog($;$) {
Line 2063  sub printLog($;$) {
         print "</PRE>\n";          print "</PRE>\n";
 }  }
   
 sub doLog {  sub doLog($) {
         my($fullname) = @_;          my($fullname) = @_;
         my ($diffrev, $upwhere, $filename, $backurl);          my ($diffrev, $upwhere, $filename, $backurl);
   
         readLog($fullname);          readLog($fullname);
   
         html_header("CVS log for $where");          html_header("CVS log for $where");
Line 2081  EOF
Line 2125  EOF
         print "</SELECT>\n";          print "</SELECT>\n";
         $diffrev = $revdisplayorder[0];          $diffrev = $revdisplayorder[0];
         $diffrev = $input{"r2"} if (defined($input{"r2"}));          $diffrev = $input{"r2"} if (defined($input{"r2"}));
         print "<INPUT TYPE=\"TEXT\" SIZE=\"$inputTextSize\" NAME=\"tr2\" VALUE=\"$diffrev\" onChange='docuement.diff_select.r2.selectedIndex=0'>\n";          print "<INPUT TYPE=\"TEXT\" SIZE=\"$inputTextSize\" NAME=\"tr2\" VALUE=\"$diffrev\" onChange='document.diff_select.r2.selectedIndex=0'>\n";
         print "<BR>Type of Diff should be a&nbsp;";          print "<BR>Type of Diff should be a&nbsp;";
         printDiffSelect();          printDiffSelect(0);
         print "<INPUT TYPE=SUBMIT VALUE=\"  Get Diffs  \">\n";          print "<INPUT TYPE=SUBMIT VALUE=\"  Get Diffs  \">\n";
         print "</FORM>\n";          print "</FORM>\n";
         print "<HR noshade>\n";          print "<HR noshade>\n";
Line 2138  EOF
Line 2182  EOF
         print "</BODY></HTML>\n";          print "</BODY></HTML>\n";
 }  }
   
 sub flush_diff_rows ($$$$)  sub flush_diff_rows($$$$) {
 {  
     my $j;      my $j;
     my ($leftColRef,$rightColRef,$leftRow,$rightRow) = @_;      my ($leftColRef,$rightColRef,$leftRow,$rightRow) = @_;
     if ($state eq "PreChangeRemove") {          # we just got remove-lines before      if ($state eq "PreChangeRemove") {          # we just got remove-lines before
Line 2184  sub human_readable_diff($){
Line 2227  sub human_readable_diff($){
   ($pathname = $where_nd) =~ s/(Attic\/)?[^\/]*$//;    ($pathname = $where_nd) =~ s/(Attic\/)?[^\/]*$//;
   ($scriptwhere_nd = $scriptwhere) =~ s/.diff$//;    ($scriptwhere_nd = $scriptwhere) =~ s/.diff$//;
   
   navigateHeader ($scriptwhere_nd, $pathname, $filename, $rev, "diff");    navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, "diff");
   
   # Read header to pick up read revision and date, if possible    # Read header to pick up read revision and date, if possible
   while (<$fh>) {    while (<$fh>) {
Line 2200  sub human_readable_diff($){
Line 2243  sub human_readable_diff($){
     $rev2 = $r2r;      $rev2 = $r2r;
     $date2 = $r2d;      $date2 = $r2d;
   }    }
   
   print "<h3 align=center>Diff for /$where_nd between version $rev1 and $rev2</h3>\n";    print "<h3 align=center>Diff for /$where_nd between version $rev1 and $rev2</h3>\n";
   
   print "<table border=0 cellspacing=0 cellpadding=0 width=\"100%\">\n";    print "<table border=0 cellspacing=0 cellpadding=0 width=\"100%\">\n";
Line 2230  sub human_readable_diff($){
Line 2273  sub human_readable_diff($){
   ####    ####
   while (<$fh>) {    while (<$fh>) {
       $difftxt = $_;        $difftxt = $_;
   
       if ($difftxt =~ /^@@/) {        if ($difftxt =~ /^@@/) {
           ($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;            ($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
           print  "<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">";            print  "<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">";
Line 2250  sub human_readable_diff($){
Line 2293  sub human_readable_diff($){
   
           # Add fontface, size            # Add fontface, size
           $_ = "$fs&nbsp;$_$fe";            $_ = "$fs&nbsp;$_$fe";
   
           #########            #########
           # little state machine to parse unified-diff output (Hen, zeller@think.de)            # little state machine to parse unified-diff output (Hen, zeller@think.de)
           # in order to get some nice 'ediff'-mode output            # in order to get some nice 'ediff'-mode output
Line 2268  sub human_readable_diff($){
Line 2311  sub human_readable_diff($){
                   $state = "PreChange";                    $state = "PreChange";
                   $rightCol[$rightRow++] = $_;                    $rightCol[$rightRow++] = $_;
               }                }
           }            }
           elsif ($diffcode eq '-') {            elsif ($diffcode eq '-') {
               $state = "PreChangeRemove";                $state = "PreChangeRemove";
               $leftCol[$leftRow++] = $_;                $leftCol[$leftRow++] = $_;
Line 2324  sub human_readable_diff($){
Line 2367  sub human_readable_diff($){
   print "</tr></table>";    print "</tr></table>";
 }  }
   
 sub navigateHeader ($$$$$) {  sub navigateHeader($$$$$) {
     my ($swhere,$path,$filename,$rev,$title) = @_;      my ($swhere,$path,$filename,$rev,$title) = @_;
     $swhere = "" if ($swhere eq $scriptwhere);      $swhere = "" if ($swhere eq $scriptwhere);
     $swhere = urlencode($filename) if ($swhere eq "");      $swhere = urlencode($filename) if ($swhere eq "");
     print "<\!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">";      print "<\!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">";
     print "<HTML>\n<HEAD>\n";      print "<HTML>\n<HEAD>\n";
     print '<!-- CVSweb $zRevision: 1.93 $  $Revision$ -->';      print '<!-- CVSweb $zRevision: 1.94 $  $Revision$ -->';
     print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";      print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";
     print  "<BODY BGCOLOR=\"$backcolor\">\n";      print  "<BODY BGCOLOR=\"$backcolor\">\n";
     print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">";      print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">";
Line 2338  sub navigateHeader ($$$$$) {
Line 2381  sub navigateHeader ($$$$$) {
     print  "<a href=\"$swhere$query#rev$rev\">$backicon";      print  "<a href=\"$swhere$query#rev$rev\">$backicon";
     print "</a> <b>Return to ", &link("$filename","$swhere$query#rev$rev")," CVS log";      print "</a> <b>Return to ", &link("$filename","$swhere$query#rev$rev")," CVS log";
     print "</b> $fileicon</td>";      print "</b> $fileicon</td>";
   
     print "<td align=right>$diricon <b>Up to ", &clickablePath($path, 1), "</b></td>";      print "<td align=right>$diricon <b>Up to ", &clickablePath($path, 1), "</b></td>";
     print "</tr></table>";      print "</tr></table>";
 }  }
   
 sub plural_write ($$)  sub plural_write($$) {
 {  
     my ($num,$text) = @_;      my ($num,$text) = @_;
     if ($num != 1) {      if ($num != 1) {
         $text = $text . "s";          $text = $text . "s";
Line 2362  sub plural_write ($$)
Line 2404  sub plural_write ($$)
 # '..time ago'  # '..time ago'
 # H. Zeller <zeller@think.de>  # H. Zeller <zeller@think.de>
 ##  ##
 sub readableTime ($$)  sub readableTime($$) {
 {  
     my ($i, $break, $retval);      my ($i, $break, $retval);
     my ($secs,$long) = @_;      my ($secs,$long) = @_;
   
Line 2381  sub readableTime ($$)
Line 2422  sub readableTime ($$)
                    31536000, 'year');                     31536000, 'year');
     my @breaks = sort {$a <=> $b} keys %desc;      my @breaks = sort {$a <=> $b} keys %desc;
     $i = 0;      $i = 0;
     while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) {      while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) {
         $i++;          $i++;
     }      }
     $i--;      $i--;
Line 2392  sub readableTime ($$)
Line 2433  sub readableTime ($$)
         my $rest = $secs % $break;          my $rest = $secs % $break;
         $i--;          $i--;
         $break = $breaks[$i];          $break = $breaks[$i];
         my $resttime = plural_write(int ($rest / $break),          my $resttime = plural_write(int ($rest / $break),
                                 $desc{$break});                                  $desc{$break});
         if ($resttime) {          if ($resttime) {
             $retval = $retval . ", " . $resttime;              $retval = $retval . ", " . $resttime;
Line 2410  sub readableTime ($$)
Line 2451  sub readableTime ($$)
 # basename (last directory/file) is a link as well  # basename (last directory/file) is a link as well
 ##  ##
 sub clickablePath($$) {  sub clickablePath($$) {
     my ($pathname,$clickLast) = @_;      my ($pathname,$clickLast) = @_;
     my $retval = '';      my $retval = '';
   
     if ($pathname eq '/') {      if ($pathname eq '/') {
         # this should never happen - chooseCVSRoot() is          # this should never happen - chooseCVSRoot() is
         # intended to do this          # intended to do this
Line 2454  sub chooseCVSRoot() {
Line 2495  sub chooseCVSRoot() {
         my ($k);          my ($k);
         print "<form method=\"GET\" action=\"${scriptwhere}\">\n";          print "<form method=\"GET\" action=\"${scriptwhere}\">\n";
         foreach $k (keys %input) {          foreach $k (keys %input) {
             print "<input type=hidden NAME=$k VALUE=$input{$k}>\n"              print "<input type=hidden NAME=$k VALUE=$input{$k}>\n"
                 if ($input{$k}) && ($k ne "cvsroot");                  if ($input{$k}) && ($k ne "cvsroot");
         }          }
         # Form-Elements look wierd in Netscape if the background          # Form-Elements look wierd in Netscape if the background
Line 2488  sub chooseMirror() {
Line 2529  sub chooseMirror() {
     # and may not be useful for your site; If you don't      # and may not be useful for your site; If you don't
     # set %MIRRORS this won't show up, anyway      # set %MIRRORS this won't show up, anyway
     #      #
     # Should perhaps exlude the current site somehow..      # Should perhaps exlude the current site somehow..
     if (keys %MIRRORS) {      if (keys %MIRRORS) {
         print "\nThis cvsweb is mirrored in:\n";          print "\nThis cvsweb is mirrored in:\n";
         foreach $mirror (keys %MIRRORS) {          foreach $mirror (keys %MIRRORS) {
Line 2500  sub chooseMirror() {
Line 2541  sub chooseMirror() {
     }      }
 }  }
   
 sub fileSortCmp {  sub fileSortCmp() {
     my ($comp) = 0;      my ($comp) = 0;
     my ($c,$d,$af,$bf);      my ($c,$d,$af,$bf);
   
Line 2531  sub fileSortCmp {
Line 2572  sub fileSortCmp {
 }  }
   
 # make A url for downloading  # make A url for downloading
 sub download_url {  sub download_url($$;$) {
     my ($url,$revision,$mimetype) = @_;      my ($url,$revision,$mimetype) = @_;
   
     $revision =~ s/\b0\.//;      $revision =~ s/\b0\.//;
Line 2548  sub download_url {
Line 2589  sub download_url {
     return $url;      return $url;
 }  }
   
 # Presents a link to download the  # Presents a link to download the
 # selected revision  # selected revision
 sub download_link {  sub download_link($$$;$) {
     my ($url,$revision,$textlink,$mimetype) = @_;      my ($url,$revision,$textlink,$mimetype) = @_;
     my ($fullurl) = download_url($url,$revision,$mimetype);      my ($fullurl) = download_url($url,$revision,$mimetype);
     my ($paren) = $textlink =~ /^\(/;      my ($paren) = $textlink =~ /^\(/;
Line 2622  sub toggleQuery($$) {
Line 2663  sub toggleQuery($$) {
     return "";      return "";
 }  }
   
 sub urlencode {  sub urlencode($) {
     my ($in) = @_;      my ($in) = @_;
     my ($out);      my ($out);
     ($out = $in) =~ s/([\000-+{-\377])/sprintf("%%%02x", ord($1))/ge;      ($out = $in) =~ s/([\000-+{-\377])/sprintf("%%%02x", ord($1))/ge;
     return $out;      return $out;
 }  }
   
 sub http_header {  sub http_header(;$) {
     my $content_type = shift || "text/html";      my $content_type = shift || "text/html";
     if (defined($moddate)) {      if (defined($moddate)) {
         if ($is_mod_perl) {          if ($is_mod_perl) {
Line 2684  sub http_header {
Line 2725  sub http_header {
   
 sub html_header($) {  sub html_header($) {
     my ($title) = @_;      my ($title) = @_;
     my $version = '$zRevision: 1.93 $  $Revision$';      my $version = '$zRevision: 1.94 $  $Revision$'; #'
     http_header();      http_header();
     print <<EOH;      print <<EOH;
 <!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"  <!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"
Line 2698  $logo <h1 align="center">$title</h1>
Line 2739  $logo <h1 align="center">$title</h1>
 EOH  EOH
 }  }
   
 sub html_footer {  sub html_footer() {
     return "<hr noshade><address>$address</address>\n";      return "<hr noshade><address>$address</address>\n";
 }  }
   
 sub link_tags  sub link_tags($) {
 {  
     my ($tags) = @_;      my ($tags) = @_;
     my ($ret) = "";      my ($ret) = "";
     my ($fileurl,$filename);      my ($fileurl,$filename);
Line 2722  sub link_tags
Line 2762  sub link_tags
 #  #
 # See if a module is listed in the config file's @HideModule list.  # See if a module is listed in the config file's @HideModule list.
 #  #
 sub forbidden_module {  sub forbidden_module($) {
     my($module) = @_;      my($module) = @_;
   
     for (my $i=0; $i < @HideModules; $i++) {      for (my $i=0; $i < @HideModules; $i++) {
         return 1 if $module eq $HideModules[$i];          return 1 if $module eq $HideModules[$i];
     }      }

Legend:
Removed from v.3.9  
changed lines
  Added in v.3.14

CVSweb