Platon Technologies
neprihlásený Prihlásiť Registrácia
SlovakEnglish
open source software development oslavujeme 10 rokov vývoja otvoreného softvéru! Štvrtok, 15. október 2026
[BACK] [TXT][DIR] Vyššie na [Platon] / scripts / cgi / cvsweb

Rozdiely pre scripts/cgi/cvsweb/cvsweb.cgi medzi verziami 1.1 a 1.2

verzia 1.1, 2002/08/13 11:40:56 verzia 1.2, 2002/08/13 12:10:57
Riadok 1 
Riadok 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)
Riadok 49 
Riadok 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
Riadok 96  use vars qw (
Riadok 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($);
Riadok 145  sub html_footer();
Riadok 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};
   
Riadok 170  for ("$mydir/cvsweb.conf", '/usr/local/e
Riadok 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 =
Riadok 245  $HTML_META = <<EOM;
Riadok 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);
Riadok 255  use IPC::Open2 qw(open2);
Riadok 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} : '';
Riadok 544  if ($module && &forbidden_module($module
Riadok 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.')
Riadok 615  if ($input{tarball}) {
Riadok 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",
Riadok 1106  if (-d $fullname) {
Riadok 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)) {
Riadok 1205  elsif (-f $fullname . ',v') {
Riadok 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'};
Riadok 1225  sub printDiffSelect($) {
Riadok 1236  sub printDiffSelect($) {
         }          }
   
         print "</select>";          print "</select>";
 }  } # }}}
   
   # sub printLogSortSelect($) {{{
 sub printLogSortSelect($) {  sub printLogSortSelect($) {
         my ($use_java_script) = @_;          my ($use_java_script) = @_;
   
Riadok 1242  sub printLogSortSelect($) {
Riadok 1254  sub printLogSortSelect($) {
         }          }
   
         print "</select>";          print "</select>";
 }  } # }}}
   
   # sub findLastModifiedSubdirs(@) {{{
 sub findLastModifiedSubdirs(@) {  sub findLastModifiedSubdirs(@) {
         my (@dirs) = @_;          my (@dirs) = @_;
         my ($dirname, @files);          my ($dirname, @files);
Riadok 1282  sub findLastModifiedSubdirs(@) {
Riadok 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);
Riadok 1297  sub htmlify_sub(&$) {
Riadok 1311  sub htmlify_sub(&$) {
         }          }
   
         $result;          $result;
 }  } # }}}
   
   # sub htmlify($;$) {{{
 sub htmlify($;$) {  sub htmlify($;$) {
         (local $_, my $extra) = @_;          (local $_, my $extra) = @_;
   
Riadok 1379  sub htmlify($;$) {
Riadok 1394  sub htmlify($;$) {
         }          }
   
         $_;          $_;
 }  } # }}}
   
   # sub spacedHtmlText($;$) {{{
 sub spacedHtmlText($;$) {  sub spacedHtmlText($;$) {
         local $_ = $_[0];          local $_ = $_[0];
         my $ts = $_[1] || $tabstop;          my $ts = $_[1] || $tabstop;
Riadok 1411  sub spacedHtmlText($;$) {
Riadok 1427  sub spacedHtmlText($;$) {
         y/\001/&/;          y/\001/&/;
   
         return $_;          return $_;
 }  } # }}}
   
   # sub link($$) {{{
 sub link($$) {  sub link($$) {
         my ($name, $url) = @_;          my ($name, $url) = @_;
   
Riadok 1420  sub link($$) {
Riadok 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) = @_;
   
Riadok 1440  sub revcmp($$) {
Riadok 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) {
Riadok 1455  sub fatal($$@) {
Riadok 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) {
Riadok 1470  sub redirect($) {
Riadok 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);
Riadok 1502  sub safeglob($) {
Riadok 1523  sub safeglob($) {
         }          }
   
         @results;          @results;
 }  } # }}}
   
   # sub search_path($) {{{
 sub search_path($) {  sub search_path($) {
         my ($command) = @_;          my ($command) = @_;
         my $d;          my $d;
Riadok 1513  sub search_path($) {
Riadok 1535  sub search_path($) {
         }          }
   
         '';          '';
 }  } # }}}
   
   # sub getMimeTypeFromSuffix($) {{{
 sub getMimeTypeFromSuffix($) {  sub getMimeTypeFromSuffix($) {
         my ($fullname) = @_;          my ($fullname) = @_;
         my ($mimetype, $suffix);          my ($mimetype, $suffix);
Riadok 1543  sub getMimeTypeFromSuffix($) {
Riadok 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;
Riadok 1564  sub head($;$) {
Riadok 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;
   
Riadok 1577  sub scan_directives(@) {
Riadok 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 '';
   
Riadok 1587  sub openOutputFilter() {
Riadok 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);
Riadok 1769  sub doAnnotate($$) {
Riadok 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);
Riadok 1874  sub doCheckout($$) {
Riadok 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);
Riadok 1940  sub cvswebMarkup($$$) {
Riadok 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); };
Riadok 2089  sub doDiff($$$$$$) {
Riadok 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,
Riadok 2301  sub getDirLogs($$@) {
Riadok 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);
Riadok 2548  sub readLog($;$) {
Riadok 2581  sub readLog($;$) {
                 @revdisplayorder = @revisions;                  @revdisplayorder = @revisions;
         }          }
   
 }  } # }}}
   
   # sub printDiffLinks($$) {{{
 sub printDiffLinks($$) {  sub printDiffLinks($$) {
         my ($text, $url) = @_;          my ($text, $url) = @_;
         my @extra;          my @extra;
Riadok 2562  sub printDiffLinks($$) {
Riadok 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) = @_;
Riadok 2790  sub printLog($;$) {
Riadok 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);
Riadok 2925  sub doLog($) {
Riadok 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) = @_;
Riadok 2967  sub flush_diff_rows($$$$) {
Riadok 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) = @_;
Riadok 3127  sub human_readable_diff($) {
Riadok 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);
Riadok 3190  EOF
Riadok 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) {
Riadok 3203  sub plural_write($$) {
Riadok 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) = @_;
Riadok 3245  sub readableTime($$) {
Riadok 3286  sub readableTime($$) {
         }          }
   
         return $retval;          return $retval;
 }  } # }}}
   
 ##  ##
 # clickablePath(String pathname, boolean last_item_clickable)  # clickablePath(String pathname, boolean last_item_clickable)
Riadok 3254  sub readableTime($$) {
Riadok 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 = '';
Riadok 3289  sub clickablePath($$) {
Riadok 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";
Riadok 3336  sub chooseCVSRoot() {
Riadok 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
Riadok 3357  sub chooseMirror() {
Riadok 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);
Riadok 3397  sub fileSortCmp() {
Riadok 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) = @_;
   
Riadok 3416  sub download_url($$;$) {
Riadok 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);
Riadok 3472  sub download_link($$$;$) {
Riadok 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);
Riadok 3505  sub toggleQuery($$) {
Riadok 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 ($_) = @_;
   
Riadok 3525  sub htmlquote($) {
Riadok 3575  sub htmlquote($) {
         s/>/&gt;/g;          s/>/&gt;/g;
   
         $_;          $_;
 }  } # }}}
   
   # sub htmlunquote($) {{{
 sub htmlunquote($) {  sub htmlunquote($) {
         local ($_) = @_;          local ($_) = @_;
   
Riadok 3537  sub htmlunquote($) {
Riadok 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";
   
Riadok 3614  sub http_header(;$) {
Riadok 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");
Riadok 3628  $HTML_META</head>
Riadok 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)  = "";
Riadok 3648  sub link_tags($) {
Riadok 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 $_;
Riadok 3661  sub forbidden_module($) {
Riadok 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);
Riadok 3671  sub forbidden_file($) {
Riadok 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);
Riadok 3682  sub gzipclose {
Riadok 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.
Riadok 3691  sub MAGIC1() { 0x1f }
Riadok 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(
Riadok 3708  sub TIEHANDLE {
Riadok 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 $, ? $, : "", @_);
Riadok 3719  sub PRINT {
Riadok 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;
Riadok 3731  sub PRINTF {
Riadok 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));
Riadok 3740  sub WRITE {
Riadok 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});
Riadok 3749  sub CLOSE {
Riadok 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:
Odstranené z verzie1.1  
zmenené riadky
  Pridané vo verzii1.2
Platon Group <platon@platon.sk> http://platon.sk/
Copyright © 2002-2006 Platon Group
Stránka používa redakčný systém Metafox 		Na začiatok