Platon Technologies
not logged in Login Registration
EnglishSlovak
open source software development celebrating 10 years of open source development! Wednesday, October 14, 2026
[BACK] [TXT][DIR] Up to [Platon] / scripts / cgi / cvsweb

Diff for scripts/cgi/cvsweb/cvsweb.cgi between version 1.1 and 1.2

version 1.1, 2002/08/13 11:40:56 version 1.2, 2002/08/13 12:10:57
Line 1 
Line 1 
 #!/usr/bin/perl -wT  #!/usr/bin/perl -wT
 #  #
 # 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)
Line 49 
Line 49 
 # $Id$  # $Id$
 # $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $  # $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $
 #  #
 ###  ### }}}
   
 require 5.000;  require 5.000;
   
 use strict;  use strict;
   
   # variables {{{
 use vars qw (  use vars qw (
     $cvsweb_revision      $cvsweb_revision
     $mydir $uname $config $allow_version_select $verbose      $mydir $uname $config $allow_version_select $verbose
Line 96  use vars qw (
Line 97  use vars qw (
     $LOG_FILESEPARATOR $LOG_REVSEPARATOR      $LOG_FILESEPARATOR $LOG_REVSEPARATOR
     $tmpdir $HTML_DOCTYPE $HTML_META      $tmpdir $HTML_DOCTYPE $HTML_META
 );  );
   # }}}
   
   # subroutines/functions {{{
 sub printDiffSelect($);  sub printDiffSelect($);
 sub printDiffLinks($$);  sub printDiffLinks($$);
 sub printLogSortSelect($);  sub printLogSortSelect($);
Line 145  sub html_footer();
Line 148  sub html_footer();
 sub link_tags($);  sub link_tags($);
 sub forbidden_file($);  sub forbidden_file($);
 sub forbidden_module($);  sub forbidden_module($);
   # }}}
   
   # Configuration area {{{
 ##### Start of Configuration Area ########  ##### Start of Configuration Area ########
 delete $ENV{PATH};  delete $ENV{PATH};
   
Line 170  for ("$mydir/cvsweb.conf", '/usr/local/e
Line 175  for ("$mydir/cvsweb.conf", '/usr/local/e
 $allow_version_select = 1;  $allow_version_select = 1;
 $allow_log_extra = 1;  $allow_log_extra = 1;
   
 ##### End of Configuration Area   ########  ##### End of Configuration Area   ######## }}}
   
   # configuration variables {{{
 ######## Configuration variables #########  ######## Configuration variables #########
 # These are defined to allow checking with perl -cw  # These are defined to allow checking with perl -cw
 @CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =  @CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =
Line 245  $HTML_META = <<EOM;
Line 251  $HTML_META = <<EOM;
 <meta http-equiv="Content-Style-Type" content="text/css">  <meta http-equiv="Content-Style-Type" content="text/css">
 EOM  EOM
   
 ##### End of configuration variables #####  ##### End of configuration variables ##### }}}
   
 use Time::Local ();  use Time::Local ();
 use IPC::Open2 qw(open2);  use IPC::Open2 qw(open2);
Line 255  use IPC::Open2 qw(open2);
Line 261  use IPC::Open2 qw(open2);
 eval { require Compress::Zlib; };  eval { require Compress::Zlib; };
 $has_zlib = !$@;  $has_zlib = !$@;
   
   ## MAIN {{{
   
 $verbose       = $v;  $verbose       = $v;
 $checkoutMagic = "~checkout~";  $checkoutMagic = "~checkout~";
 $pathinfo      = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';  $pathinfo      = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
Line 544  if ($module && &forbidden_module($module
Line 552  if ($module && &forbidden_module($module
   
 #  #
 # Handle tarball downloads before any headers are output.  # Handle tarball downloads before any headers are output.
 #  # {{{
 if ($input{tarball}) {  if ($input{tarball}) {
         fatal("403 Forbidden",          fatal("403 Forbidden",
               'Downloading tarballs is prohibited.')                'Downloading tarballs is prohibited.')
Line 615  if ($input{tarball}) {
Line 623  if ($input{tarball}) {
         &fatal(@fatal) if @fatal;          &fatal(@fatal) if @fatal;
   
         exit;          exit;
 }  } # }}}
   
 ##############################  ###############################
 # View a directory  # View a directory
 ###############################  ###############################
   # {{{
 if (-d $fullname) {  if (-d $fullname) {
         my $dh = do { local (*DH); };          my $dh = do { local (*DH); };
         opendir($dh, $fullname) or fatal("404 Not Found",          opendir($dh, $fullname) or fatal("404 Not Found",
Line 1106  if (-d $fullname) {
Line 1115  if (-d $fullname) {
                 print "</td>\n</tr>\n</table>\n</center>\n</form>\n";                  print "</td>\n</tr>\n</table>\n</center>\n</form>\n";
         }          }
         html_footer();          html_footer();
 }  } # }}}
   
 ###############################  ###############################
 # View Files  # View Files
 ###############################  ###############################
   # {{{
 elsif (-f $fullname . ',v') {  elsif (-f $fullname . ',v') {
   
         if (forbidden_file($fullname)) {          if (forbidden_file($fullname)) {
Line 1205  elsif (-f $fullname . ',v') {
Line 1215  elsif (-f $fullname . ',v') {
               '%s: no such file or directory',                '%s: no such file or directory',
               $where);                $where);
 }  }
   # }}}
 gzipclose();  gzipclose();
   
 ## End MAIN  ## }}} End MAIN
   
   # sub printDiffSelect($) {{{
 sub printDiffSelect($) {  sub printDiffSelect($) {
         my ($use_java_script) = @_;          my ($use_java_script) = @_;
         my $f = $input{'f'};          my $f = $input{'f'};
Line 1225  sub printDiffSelect($) {
Line 1236  sub printDiffSelect($) {
         }          }
   
         print "</select>";          print "</select>";
 }  } # }}}
   
   # sub printLogSortSelect($) {{{
 sub printLogSortSelect($) {  sub printLogSortSelect($) {
         my ($use_java_script) = @_;          my ($use_java_script) = @_;
   
Line 1242  sub printLogSortSelect($) {
Line 1254  sub printLogSortSelect($) {
         }          }
   
         print "</select>";          print "</select>";
 }  } # }}}
   
   # sub findLastModifiedSubdirs(@) {{{
 sub findLastModifiedSubdirs(@) {  sub findLastModifiedSubdirs(@) {
         my (@dirs) = @_;          my (@dirs) = @_;
         my ($dirname, @files);          my ($dirname, @files);
Line 1282  sub findLastModifiedSubdirs(@) {
Line 1295  sub findLastModifiedSubdirs(@) {
                 push (@files, $lastmod) if (defined($lastmod));                  push (@files, $lastmod) if (defined($lastmod));
         }          }
         return @files;          return @files;
 }  } # }}}
   
   # sub htmlify_sub(&$) {{{
 sub htmlify_sub(&$) {  sub htmlify_sub(&$) {
         (my $proc, local $_) = @_;          (my $proc, local $_) = @_;
         my @a = split (m`(<a [^>]+>[^<]*</a>)`i);          my @a = split (m`(<a [^>]+>[^<]*</a>)`i);
Line 1297  sub htmlify_sub(&$) {
Line 1311  sub htmlify_sub(&$) {
         }          }
   
         $result;          $result;
 }  } # }}}
   
   # sub htmlify($;$) {{{
 sub htmlify($;$) {  sub htmlify($;$) {
         (local $_, my $extra) = @_;          (local $_, my $extra) = @_;
   
Line 1379  sub htmlify($;$) {
Line 1394  sub htmlify($;$) {
         }          }
   
         $_;          $_;
 }  } # }}}
   
   # sub spacedHtmlText($;$) {{{
 sub spacedHtmlText($;$) {  sub spacedHtmlText($;$) {
         local $_ = $_[0];          local $_ = $_[0];
         my $ts = $_[1] || $tabstop;          my $ts = $_[1] || $tabstop;
Line 1411  sub spacedHtmlText($;$) {
Line 1427  sub spacedHtmlText($;$) {
         y/\001/&/;          y/\001/&/;
   
         return $_;          return $_;
 }  } # }}}
   
   # sub link($$) {{{
 sub link($$) {  sub link($$) {
         my ($name, $url) = @_;          my ($name, $url) = @_;
   
Line 1420  sub link($$) {
Line 1437  sub link($$) {
             if $url =~ /^[^a-z]/;    # relative              if $url =~ /^[^a-z]/;    # relative
   
         sprintf '<a href="%s">%s</a>', hrefquote($url), $name;          sprintf '<a href="%s">%s</a>', hrefquote($url), $name;
 }  } # }}}
   
   # sub revcmp($$) {{{
 sub revcmp($$) {  sub revcmp($$) {
         my ($rev1, $rev2) = @_;          my ($rev1, $rev2) = @_;
   
Line 1440  sub revcmp($$) {
Line 1458  sub revcmp($$) {
         if (@r1) { return 1; }          if (@r1) { return 1; }
         if (@r2) { return -1; }          if (@r2) { return -1; }
         return 0;          return 0;
 }  } # }}}
   
   # sub fatal($$@) {{{
 sub fatal($$@) {  sub fatal($$@) {
         my ($errcode, $format, @args) = @_;          my ($errcode, $format, @args) = @_;
         if ($is_mod_perl) {          if ($is_mod_perl) {
Line 1455  sub fatal($$@) {
Line 1474  sub fatal($$@) {
           "</p>\n";            "</p>\n";
         html_footer();          html_footer();
         exit(1);          exit(1);
 }  } # }}}
   
   # sub redirect($) {{{
 sub redirect($) {  sub redirect($) {
         my ($url) = @_;          my ($url) = @_;
         if ($is_mod_perl) {          if ($is_mod_perl) {
Line 1470  sub redirect($) {
Line 1490  sub redirect($) {
         print "<p>This document is located ", &link('here', $url), "</p>\n";          print "<p>This document is located ", &link('here', $url), "</p>\n";
         html_footer();          html_footer();
         exit(1);          exit(1);
 }  } # }}}
   
   # sub safeglob($) {{{
 sub safeglob($) {  sub safeglob($) {
         my ($filename) = @_;          my ($filename) = @_;
         my ($dirname);          my ($dirname);
Line 1502  sub safeglob($) {
Line 1523  sub safeglob($) {
         }          }
   
         @results;          @results;
 }  } # }}}
   
   # sub search_path($) {{{
 sub search_path($) {  sub search_path($) {
         my ($command) = @_;          my ($command) = @_;
         my $d;          my $d;
Line 1513  sub search_path($) {
Line 1535  sub search_path($) {
         }          }
   
         '';          '';
 }  } # }}}
   
   # sub getMimeTypeFromSuffix($) {{{
 sub getMimeTypeFromSuffix($) {  sub getMimeTypeFromSuffix($) {
         my ($fullname) = @_;          my ($fullname) = @_;
         my ($mimetype, $suffix);          my ($mimetype, $suffix);
Line 1543  sub getMimeTypeFromSuffix($) {
Line 1566  sub getMimeTypeFromSuffix($) {
                 $mimetype = "text/plain";                  $mimetype = "text/plain";
         }          }
         return $mimetype;          return $mimetype;
 }  } # }}}
   
 ###############################  ###############################
 # read first lines like head(1)  # read first lines like head(1)
 ###############################  ###############################
   # sub head($;$) {{{
 sub head($;$) {  sub head($;$) {
         my $fh        = $_[0];          my $fh        = $_[0];
         my $linecount = $_[1] || 10;          my $linecount = $_[1] || 10;
Line 1564  sub head($;$) {
Line 1588  sub head($;$) {
         }          }
   
         @buf;          @buf;
 }  } # }}}
   
 ###############################  ###############################
 # scan vim and Emacs directives  # scan vim and Emacs directives
 ###############################  ###############################
   # sub scan_directives(@) {{{
 sub scan_directives(@) {  sub scan_directives(@) {
         my $ts = undef;          my $ts = undef;
   
Line 1577  sub scan_directives(@) {
Line 1602  sub scan_directives(@) {
         }          }
   
         ('tabstop' => $ts);          ('tabstop' => $ts);
 }  } # }}}
   
   # sub openOutputFilter() {{{
 sub openOutputFilter() {  sub openOutputFilter() {
         return if !defined($output_filter) || $output_filter eq '';          return if !defined($output_filter) || $output_filter eq '';
   
Line 1587  sub openOutputFilter() {
Line 1613  sub openOutputFilter() {
         # child of child          # child of child
         open(STDERR, '>/dev/null');          open(STDERR, '>/dev/null');
         exec($output_filter) or exit -1;          exec($output_filter) or exit -1;
 }  } # }}}
   
 ###############################  ###############################
 # show Annotation  # show Annotation
 ###############################  ###############################
   # sub doAnnotate($$) {{{
 sub doAnnotate($$) {  sub doAnnotate($$) {
         my ($rev) = @_;          my ($rev) = @_;
         my ($pid);          my ($pid);
Line 1769  sub doAnnotate($$) {
Line 1796  sub doAnnotate($$) {
         }          }
         close($reader) or warn "cannot close: $!";          close($reader) or warn "cannot close: $!";
         wait;          wait;
 }  } # }}}
   
 ###############################  ###############################
 # make Checkout  # make Checkout
 ###############################  ###############################
   # sub doCheckout($$) {{{
 sub doCheckout($$) {  sub doCheckout($$) {
         my ($fullname, $rev) = @_;          my ($fullname, $rev) = @_;
         my ($mimetype, $revopt);          my ($mimetype, $revopt);
Line 1874  sub doCheckout($$) {
Line 1902  sub doCheckout($$) {
                 print <$fh>;                  print <$fh>;
         }          }
         close($fh);          close($fh);
 }  } # }}}
   
   # sub cvswebMarkup($$$) {{{
 sub cvswebMarkup($$$) {  sub cvswebMarkup($$$) {
         my ($filehandle, $fullname, $revision) = @_;          my ($filehandle, $fullname, $revision) = @_;
         my ($pathname,   $filename);          my ($pathname,   $filename);
Line 1940  sub cvswebMarkup($$$) {
Line 1969  sub cvswebMarkup($$$) {
                 }                  }
                 print "</pre>";                  print "</pre>";
         }          }
 }  } # }}}
   
   # sub viewable($) {{{
 sub viewable($) {  sub viewable($) {
         my ($mimetype) = @_;          my ($mimetype) = @_;
   
         $mimetype =~ m%^((text|image)/|application/pdf)%;          $mimetype =~ m%^((text|image)/|application/pdf)%;
 }  } # }}}
   
 ###############################  ###############################
 # Show Colored Diff  # Show Colored Diff
 ###############################  ###############################
   # sub doDiff($$$$$$) {{{
 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); };
Line 2089  sub doDiff($$$$$$) {
Line 2120  sub doDiff($$$$$$) {
                 print $_;                  print $_;
         }          }
         close($fh);          close($fh);
 }  } # }}}
   
 ###############################  ###############################
 # Show Logs ..  # Show Logs ..
 ###############################  ###############################
   # sub getDirLogs($$@) {{{
 sub getDirLogs($$@) {  sub getDirLogs($$@) {
         my ($cvsroot, $dirname, @otherFiles) = @_;          my ($cvsroot, $dirname, @otherFiles) = @_;
         my ($state, $otherFiles, $tag, $file, $date, $branchpoint, $branch,          my ($state, $otherFiles, $tag, $file, $date, $branchpoint, $branch,
Line 2301  sub getDirLogs($$@) {
Line 2333  sub getDirLogs($$@) {
                       join (", ", @files), $command_path);                        join (", ", @files), $command_path);
         }          }
         close($fh);          close($fh);
 }  } # }}}
   
   # sub readLog($;$) {{{
 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);
Line 2548  sub readLog($;$) {
Line 2581  sub readLog($;$) {
                 @revdisplayorder = @revisions;                  @revdisplayorder = @revisions;
         }          }
   
 }  } # }}}
   
   # sub printDiffLinks($$) {{{
 sub printDiffLinks($$) {  sub printDiffLinks($$) {
         my ($text, $url) = @_;          my ($text, $url) = @_;
         my @extra;          my @extra;
Line 2562  sub printDiffLinks($$) {
Line 2596  sub printDiffLinks($$) {
         }          }
   
         print &link($text, $url), ' (', join (', ', @extra), ')';          print &link($text, $url), ' (', join (', ', @extra), ')';
 }  } # }}}
   
   # sub printLog($;$) {{{
 sub printLog($;$) {  sub printLog($;$) {
         my ($link, $br, $brp);          my ($link, $br, $brp);
         ($_, $link) = @_;          ($_, $link) = @_;
Line 2790  sub printLog($;$) {
Line 2825  sub printLog($;$) {
         print "\n</p>\n<pre>\n";          print "\n</p>\n<pre>\n";
         print &htmlify($log{$_}, $allow_log_extra);          print &htmlify($log{$_}, $allow_log_extra);
         print "</pre>\n";          print "</pre>\n";
 }  } # }}}
   
   # sub doLog($) {{{
 sub doLog($) {  sub doLog($) {
         my ($fullname) = @_;          my ($fullname) = @_;
         my ($diffrev, $upwhere, $filename, $backurl);          my ($diffrev, $upwhere, $filename, $backurl);
Line 2925  sub doLog($) {
Line 2961  sub doLog($) {
         print "</tr>\n</table>\n";          print "</tr>\n</table>\n";
         print "</form>\n";          print "</form>\n";
         html_footer();          html_footer();
 }  } # }}}
   
   # sub flush_diff_rows($$$$) {{{
 sub flush_diff_rows($$$$) {  sub flush_diff_rows($$$$) {
         my $j;          my $j;
         my ($leftColRef, $rightColRef, $leftRow, $rightRow) = @_;          my ($leftColRef, $rightColRef, $leftRow, $rightRow) = @_;
Line 2967  sub flush_diff_rows($$$$) {
Line 3004  sub flush_diff_rows($$$$) {
                         print "\n</tr>\n";                          print "\n</tr>\n";
                 }                  }
         }          }
 }  } # }}}
   
 ##  ##
 # Function to generate Human readable diff-files  # Function to generate Human readable diff-files
 # human_readable_diff(String revision_to_return_to);  # human_readable_diff(String revision_to_return_to);
 ##  ##
   # sub human_readable_diff($) {{{
 sub human_readable_diff($) {  sub human_readable_diff($) {
         my ($difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd);          my ($difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd);
         my ($fh, $rev) = @_;          my ($fh, $rev) = @_;
Line 3127  sub human_readable_diff($) {
Line 3165  sub human_readable_diff($) {
   
         print "</tr>\n</table>\n";          print "</tr>\n</table>\n";
         print "</form>\n";          print "</form>\n";
 }  } # }}}
   
   # sub navigateHeader($$$$$) {{{
 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);
Line 3190  EOF
Line 3229  EOF
           &clickablePath($path, 1),            &clickablePath($path, 1),
             "</b></td>";              "</b></td>";
         print "</tr></table>";          print "</tr></table>";
 }  } # }}}
   
   # sub plural_write($$) {{{
 sub plural_write($$) {  sub plural_write($$) {
         my ($num, $text) = @_;          my ($num, $text) = @_;
         if ($num != 1) {          if ($num != 1) {
Line 3203  sub plural_write($$) {
Line 3243  sub plural_write($$) {
         } else {          } else {
                 return "";                  return "";
         }          }
 }  } # }}}
   
 ##  ##
 # print readable timestamp in terms of  # print readable timestamp in terms of
 # '..time ago'  # '..time ago'
 # H. Zeller <zeller@think.de>  # H. Zeller <zeller@think.de>
 ##  ##
   # sub readableTime($$) {{{
 sub readableTime($$) {  sub readableTime($$) {
         my ($i, $break, $retval);          my ($i, $break, $retval);
         my ($secs, $long) = @_;          my ($secs, $long) = @_;
Line 3245  sub readableTime($$) {
Line 3286  sub readableTime($$) {
         }          }
   
         return $retval;          return $retval;
 }  } # }}}
   
 ##  ##
 # clickablePath(String pathname, boolean last_item_clickable)  # clickablePath(String pathname, boolean last_item_clickable)
Line 3254  sub readableTime($$) {
Line 3295  sub readableTime($$) {
 # faster navigation. last_item_clickable controls whether the  # faster navigation. last_item_clickable controls whether the
 # basename (last directory/file) is a link as well  # basename (last directory/file) is a link as well
 ##  ##
   # sub clickablePath($$) {{{
 sub clickablePath($$) {  sub clickablePath($$) {
         my ($pathname, $clickLast) = @_;          my ($pathname, $clickLast) = @_;
         my $retval = '';          my $retval = '';
Line 3289  sub clickablePath($$) {
Line 3331  sub clickablePath($$) {
                 }                  }
         }          }
         return $retval;          return $retval;
 }  } # }}}
   
   # sub chooseCVSRoot() {{{
 sub chooseCVSRoot() {  sub chooseCVSRoot() {
   
         print "<form method=\"get\" action=\"${scriptwhere}\">\n";          print "<form method=\"get\" action=\"${scriptwhere}\">\n";
Line 3336  sub chooseCVSRoot() {
Line 3379  sub chooseCVSRoot() {
                 print "</p>";                  print "</p>";
         }          }
         print "\n</form>";          print "\n</form>";
 }  } # }}}
   
   # sub chooseMirror() {{{
 sub chooseMirror() {  sub chooseMirror() {
   
         # This code comes from the original BSD-cvsweb          # This code comes from the original BSD-cvsweb
Line 3357  sub chooseMirror() {
Line 3401  sub chooseMirror() {
         }          }
   
         print "$tmp.\n</p>\n";          print "$tmp.\n</p>\n";
 }  } # }}}
   
   # sub fileSortCmp() {{{
 sub fileSortCmp() {  sub fileSortCmp() {
         my ($comp) = 0;          my ($comp) = 0;
         my ($c, $d, $af, $bf);          my ($c, $d, $af, $bf);
Line 3397  sub fileSortCmp() {
Line 3442  sub fileSortCmp() {
                 $comp = ("$ad$c" cmp "$bd$d");                  $comp = ("$ad$c" cmp "$bd$d");
         }          }
         return $comp;          return $comp;
 }  } # }}}
   
 # make A url for downloading  # make A url for downloading
   # sub download_url($$;$) {{{
 sub download_url($$;$) {  sub download_url($$;$) {
         my ($url, $revision, $mimetype) = @_;          my ($url, $revision, $mimetype) = @_;
   
Line 3416  sub download_url($$;$) {
Line 3462  sub download_url($$;$) {
         $url .= '&content-type=' . urlencode($mimetype) if (defined($mimetype));          $url .= '&content-type=' . urlencode($mimetype) if (defined($mimetype));
   
         $url;          $url;
 }  } # }}}
   
 # Presents a link to download the  # Presents a link to download the
 # selected revision  # selected revision
   # sub download_link($$$;$) {{{
 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);
Line 3472  sub download_link($$$;$) {
Line 3519  sub download_link($$$;$) {
                 }                  }
         }          }
         print "><b>$textlink</b></a>";          print "><b>$textlink</b></a>";
 }  } # }}}
   
 # Returns a Query string with the  # Returns a Query string with the
 # specified parameter toggled  # specified parameter toggled
   # sub toggleQuery($$) {{{
 sub toggleQuery($$) {  sub toggleQuery($$) {
         my ($toggle, $value) = @_;          my ($toggle, $value) = @_;
         my ($newquery, $var);          my ($newquery, $var);
Line 3505  sub toggleQuery($$) {
Line 3553  sub toggleQuery($$) {
                 return '?' . $newquery;                  return '?' . $newquery;
         }          }
         return "";          return "";
 }  } # }}}
   
   # sub urlencode($) {{{
 sub urlencode($) {  sub urlencode($) {
         local ($_) = @_;          local ($_) = @_;
   
         s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;          s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;
   
         $_;          $_;
 }  } # }}}
   
   # sub htmlquote($) {{{
 sub htmlquote($) {  sub htmlquote($) {
         local ($_) = @_;          local ($_) = @_;
   
Line 3525  sub htmlquote($) {
Line 3575  sub htmlquote($) {
         s/>/&gt;/g;          s/>/&gt;/g;
   
         $_;          $_;
 }  } # }}}
   
   # sub htmlunquote($) {{{
 sub htmlunquote($) {  sub htmlunquote($) {
         local ($_) = @_;          local ($_) = @_;
   
Line 3537  sub htmlunquote($) {
Line 3588  sub htmlunquote($) {
         s/&amp;/&/g;          s/&amp;/&/g;
   
         $_;          $_;
 }  } # }}}
   
   # sub hrefquote($) {{{
 sub hrefquote($) {  sub hrefquote($) {
         local ($_) = @_;          local ($_) = @_;
   
         y/ /+/;          y/ /+/;
   
         htmlquote($_)          htmlquote($_)
 }  } # }}}
   
   # sub http_header(;$) {{{
 sub http_header(;$) {  sub http_header(;$) {
         my $content_type = shift || "text/html";          my $content_type = shift || "text/html";
   
Line 3614  sub http_header(;$) {
Line 3667  sub http_header(;$) {
                         print "\r\n";    # Close headers                          print "\r\n";    # Close headers
                 }                  }
         }          }
 }  } # }}}
   
   # sub html_header($) {{{
 sub html_header($) {  sub html_header($) {
         my ($title) = @_;          my ($title) = @_;
         http_header("text/html");          http_header("text/html");
Line 3628  $HTML_META</head>
Line 3682  $HTML_META</head>
 $body_tag  $body_tag
 $logo <h1 align="center">$title</h1>  $logo <h1 align="center">$title</h1>
 EOH  EOH
 }  } # }}}
   
   # sub html_footer() {{{
 sub html_footer() {  sub html_footer() {
         print "<hr noshade>\n<address>$address</address>\n</body>\n</html>\n";          print "<hr noshade>\n<address>$address</address>\n</body>\n</html>\n";
 }  } # }}}
   
   # sub link_tags($) {{{
 sub link_tags($) {  sub link_tags($) {
         my ($tags) = @_;          my ($tags) = @_;
         my ($ret)  = "";          my ($ret)  = "";
Line 3648  sub link_tags($) {
Line 3704  sub link_tags($) {
                     &link($sym, $fileurl . toggleQuery('only_with_tag', $sym));                      &link($sym, $fileurl . toggleQuery('only_with_tag', $sym));
         }          }
         return "$ret\n";          return "$ret\n";
 }  } # }}}
   
 #  #
 # See if a module is listed in the config file's @HideModules list.  # See if a module is listed in the config file's @HideModules list.
 #  #
   # sub forbidden_module($) {{{
 sub forbidden_module($) {  sub forbidden_module($) {
         my ($module) = @_;          my ($module) = @_;
         local $_;          local $_;
Line 3661  sub forbidden_module($) {
Line 3718  sub forbidden_module($) {
                 return 1 if $module =~ $_;                  return 1 if $module =~ $_;
         }          }
         return 0;          return 0;
 }  } # }}}
   
   # sub forbidden_file($) {{{
 sub forbidden_file($) {  sub forbidden_file($) {
         my ($path) = @_;          my ($path) = @_;
         $path =  substr($path, length($cvsroot) + 1);          $path =  substr($path, length($cvsroot) + 1);
Line 3671  sub forbidden_file($) {
Line 3729  sub forbidden_file($) {
                 return 1 if $path =~ $_;                  return 1 if $path =~ $_;
         }          }
         return 0;          return 0;
 }  } # }}}
   
 # Close the GZIP handle remove the tie.  # Close the GZIP handle remove the tie.
   
   # sub gzipclose {{{
 sub gzipclose {  sub gzipclose {
         if ($gzip_open) {          if ($gzip_open) {
                 select(STDOUT);                  select(STDOUT);
Line 3682  sub gzipclose {
Line 3741  sub gzipclose {
                 untie *GZIP;                  untie *GZIP;
                 $gzip_open = 0;                  $gzip_open = 0;
         }          }
 }  } # }}}
   
 # implement a gzipped file handle via the Compress:Zlib compression  # implement a gzipped file handle via the Compress:Zlib compression
 # library.  # library.
Line 3691  sub MAGIC1() { 0x1f }
Line 3750  sub MAGIC1() { 0x1f }
 sub MAGIC2() { 0x8b }  sub MAGIC2() { 0x8b }
 sub OSCODE() { 3 }  sub OSCODE() { 3 }
   
   # sub TIEHANDLE {{{
 sub TIEHANDLE {  sub TIEHANDLE {
         my ($class, $out) = @_;          my ($class, $out) = @_;
         my ($d) = Compress::Zlib::deflateInit(          my ($d) = Compress::Zlib::deflateInit(
Line 3708  sub TIEHANDLE {
Line 3768  sub TIEHANDLE {
             0, 0, 0, OSCODE);              0, 0, 0, OSCODE);
         print {$o->{handle}} $header;          print {$o->{handle}} $header;
         return bless($o, $class);          return bless($o, $class);
 }  } # }}}
   
   # sub PRINT {{{
 sub PRINT {  sub PRINT {
         my ($o)   = shift;          my ($o)   = shift;
         my ($buf) = join (defined $, ? $, : "", @_);          my ($buf) = join (defined $, ? $, : "", @_);
Line 3719  sub PRINT {
Line 3780  sub PRINT {
         $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});          $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});
         $o->{len} += $len;          $o->{len} += $len;
         return $len;          return $len;
 }  } # }}}
   
   # sub PRINTF {{{
 sub PRINTF {  sub PRINTF {
         my ($o)   = shift;          my ($o)   = shift;
         my ($fmt) = shift;          my ($fmt) = shift;
Line 3731  sub PRINTF {
Line 3793  sub PRINTF {
         $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});          $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});
         $o->{len} += $len;          $o->{len} += $len;
         return $len;          return $len;
 }  } # }}}
   
   # sub WRITE {{{
 sub WRITE {  sub WRITE {
         my ($o, $buf, $len, $off) = @_;          my ($o, $buf, $len, $off) = @_;
         my ($compressed, $status) = $o->{dh}->deflate(substr($buf, 0, $len));          my ($compressed, $status) = $o->{dh}->deflate(substr($buf, 0, $len));
Line 3740  sub WRITE {
Line 3803  sub WRITE {
         $o->{crc} = Compress::Zlib::crc32(substr($buf, 0, $len), $o->{crc});          $o->{crc} = Compress::Zlib::crc32(substr($buf, 0, $len), $o->{crc});
         $o->{len} += $len;          $o->{len} += $len;
         return $len;          return $len;
 }  } # }}}
   
   # sub CLOSE {{{
 sub CLOSE {  sub CLOSE {
         my ($o) = @_;          my ($o) = @_;
         return if !defined($o->{dh});          return if !defined($o->{dh});
Line 3749  sub CLOSE {
Line 3813  sub CLOSE {
         $buf .= pack("V V", $o->{crc}, $o->{len});          $buf .= pack("V V", $o->{crc}, $o->{len});
         print {$o->{handle}} $buf;          print {$o->{handle}} $buf;
         undef $o->{dh};          undef $o->{dh};
 }  } # }}}
   
   # sub DESTROY {{{
 sub DESTROY {  sub DESTROY {
         my ($o) = @_;          my ($o) = @_;
         CLOSE($o);          CLOSE($o);
 }  } # }}}
   
   # vim600: fdm=marker fdl=0 fdc=3
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
Platon Group <platon@platon.org> http://platon.org/
Copyright © 2002-2006 Platon Group
Site powered by Metafox CMS 		Go to Top