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

Diff for /cvsweb/cvsweb.cgi between version 1.1.1.17 and 3.36

version 1.1.1.17, 2000/12/29 09:20:45 version 3.36, 2000/10/20 12:28:45
Line 42 
Line 42 
 # 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.104 2000/11/01 22:05:12 hnordstrom Exp $  # $zId: cvsweb.cgi,v 1.103 2000/09/20 17:02:29 jumager Exp $
 # $kId: cvsweb.cgi,v 1.49 2000/12/29 09:12:15 knu Exp $  # $Id$
 #  #
 ###  ###
   
Line 52  use strict;
Line 52  use strict;
 use vars qw (  use vars qw (
     $config $allow_version_select $verbose      $config $allow_version_select $verbose
     %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES      %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
     @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS  
     %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted      %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted
     %symrev %revsym @allrevisions %date %author @revdisplayorder      %symrev %revsym @allrevisions %date %author @revdisplayorder
     @revisions %state %difflines %log %branchpoint @revorder      @revisions %state %difflines %log %branchpoint @revorder
Line 62  use vars qw (
Line 61  use vars qw (
     %funcline_regexp $is_mod_perl      %funcline_regexp $is_mod_perl
     $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased      $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased
     %input $query $barequery $sortby $bydate $byrev $byauthor      %input $query $barequery $sortby $bydate $byrev $byauthor
     $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot      $bylog $byfile $hr_default $logsort $cvstree $cvsroot
     $mimetype $charset $defaultTextPlain $defaultViewable      $mimetype $defaultTextPlain $defaultViewable $allow_compress
     $allow_compress $GZIPBIN $backicon $diricon $fileicon      $GZIPBIN $backicon $diricon $fileicon $fullname $newname
     $fullname $newname $cvstreedefault      $cvstreedefault $body_tag $body_tag_for_src
     $body_tag $body_tag_for_src $logo $defaulttitle $address      $logo $defaulttitle $address
     $long_intro $short_instruction $shortLogLen      $long_intro $short_instruction $shortLogLen
     $show_author $dirtable $tablepadding $columnHeaderColorDefault      $show_author $dirtable $tablepadding $columnHeaderColorDefault
     $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite      $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite
Line 79  use vars qw (
Line 78  use vars qw (
     $navigationHeaderColor $tableBorderColor $markupLogColor      $navigationHeaderColor $tableBorderColor $markupLogColor
     $tabstop $state $annTable $sel $curbranch @HideModules      $tabstop $state $annTable $sel $curbranch @HideModules
     $module $use_descriptions %descriptions @mytz $dwhere $moddate      $module $use_descriptions %descriptions @mytz $dwhere $moddate
     $use_moddate $has_zlib $gzip_open $allow_tar      $use_moddate $has_zlib $gzip_open
     $LOG_FILESEPARATOR $LOG_REVSEPARATOR      $LOG_FILESEPARATOR $LOG_REVSEPARATOR
 );  );
   
 sub printDiffSelect($);  sub printDiffSelect($);
 sub printDiffLinks($$);  
 sub printLogSortSelect($);  
 sub findLastModifiedSubdirs(@);  sub findLastModifiedSubdirs(@);
 sub htmlify_sub(&$);  sub htmlify_sub(&$);
 sub htmlify($;$);  sub htmlify($;$);
Line 122  sub toggleQuery($$);
Line 119  sub toggleQuery($$);
 sub urlencode($);  sub urlencode($);
 sub htmlquote($);  sub htmlquote($);
 sub htmlunquote($);  sub htmlunquote($);
 sub hrefquote($);  
 sub http_header(;$);  sub http_header(;$);
 sub html_header($);  sub html_header($);
 sub html_footer();  sub html_footer();
Line 170  $tabstop = $use_moddate = $moddate = $gzip_open = unde
Line 166  $tabstop = $use_moddate = $moddate = $gzip_open = unde
 $LOG_FILESEPARATOR = q/^={77}$/;  $LOG_FILESEPARATOR = q/^={77}$/;
 $LOG_REVSEPARATOR = q/^-{28}$/;  $LOG_REVSEPARATOR = q/^-{28}$/;
   
 @DIFFTYPES = qw(h H u c s);  
 @DIFFTYPES{@DIFFTYPES} = (  
                           {  
                            'descr'   => 'colored',  
                            'opts'    => [ '-u' ],  
                            'colored' => 1,  
                           },  
                           {  
                            'descr'   => 'long colored',  
                            'opts'    => [ '--unified=15' ],  
                            'colored' => 1,  
                           },  
                           {  
                            'descr'   => 'unified',  
                            'opts'    => [ '-u' ],  
                            'colored' => 0,  
                           },  
                           {  
                            'descr'   => 'context',  
                            'opts'    => [ '-c' ],  
                            'colored' => 0,  
                           },  
                           {  
                            'descr'   => 'side by side',  
                            'opts'    => [ '--side-by-side', '--width=164' ],  
                            'colored' => 0,  
                           },  
                          );  
   
 @LOGSORTKEYS = qw(cvs date rev);  
 @LOGSORTKEYS{@LOGSORTKEYS} = (  
                               {  
                                'descr' => 'Not sorted',  
                               },  
                               {  
                                'descr' => 'Commit date',  
                               },  
                               {  
                                'descr' => 'Revision',  
                               },  
                              );  
   
   
 ##### End of configuration variables #####  ##### End of configuration variables #####
   
 use Time::Local;  use Time::Local;
Line 229  $verbose = $v;
Line 182  $verbose = $v;
 $checkoutMagic = "~checkout~";  $checkoutMagic = "~checkout~";
 $pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';  $pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
 $where = $pathinfo;  $where = $pathinfo;
 $where =~ tr|/|/|s;  
 $doCheckout = ($where =~ /^\/$checkoutMagic/);  $doCheckout = ($where =~ /^\/$checkoutMagic/);
 $where =~ s|^/($checkoutMagic)?||;  $where =~ s|^/($checkoutMagic)?||;
 $where =~ s|/$||;  $where =~ s|/+$||;
 $scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';  $scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
 $scriptname =~ s|^/?|/|;  $scriptname =~ s|^/?|/|;
 $scriptname =~ s|/+$||;  $scriptname =~ s|/+$||;
Line 246  $is_mod_perl = defined($ENV{MOD_PERL});
Line 198  $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_links = ($Browser =~ m`^Links `);  $is_links = ($Browser =~ m`^Links `);
 $is_lynx = ($Browser =~ m`^Lynx/`i);  $is_lynx = ($Browser =~ m`^Lynx/`i);
 $is_w3m = ($Browser =~ m`^w3m/`i);  $is_w3m = ($Browser =~ m`^w3m/`i);
Line 279  $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING})
Line 231  $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING})
 @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);  @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);
   
 if (-f $config) {  if (-f $config) {
    require $config     do $config
      || &fatal("500 Internal Error",       || &fatal("500 Internal Error",
                sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>',                 sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>',
                        $config, &htmlify($@)));                         $config, &htmlify($@)));
Line 296  $query = $ENV{QUERY_STRING};
Line 248  $query = $ENV{QUERY_STRING};
   
 if (defined($query) && $query ne '') {  if (defined($query) && $query ne '') {
     foreach (split(/&/, $query)) {      foreach (split(/&/, $query)) {
         y/+/ /;  
         s/%(..)/sprintf("%c", hex($1))/ge;      # unquote %-quoted          s/%(..)/sprintf("%c", hex($1))/ge;      # unquote %-quoted
         if (/(\S+)=(.*)/) {          if (/(\S+)=(.*)/) {
             $input{$1} = $2 if ($2 ne "");              $input{$1} = $2 if ($2 ne "");
Line 378  else {
Line 329  else {
     $byfile = 1;      $byfile = 1;
 }  }
   
 $defaultDiffType = $input{'f'};  $hr_default = ($input{'f'} eq 'h' || $input{'f'} eq 'H');
   
 $logsort = $input{'logsort'};  $logsort = $input{'logsort'};
   
Line 407  foreach $k (keys %ICONS) {
Line 358  foreach $k (keys %ICONS) {
     my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}};      my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}};
     if ($ipath) {      if ($ipath) {
         ${"${k}icon"} = sprintf('<IMG SRC="%s" ALT="%s" BORDER="0" WIDTH="%d" HEIGHT="%d">',          ${"${k}icon"} = sprintf('<IMG SRC="%s" ALT="%s" BORDER="0" WIDTH="%d" HEIGHT="%d">',
                                 hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight)                                  htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight)
     }      }
     else {      else {
         ${"${k}icon"} = $itxt;          ${"${k}icon"} = $itxt;
Line 419  my $config_cvstree = "$config-$cvstree";
Line 370  my $config_cvstree = "$config-$cvstree";
   
 # Do some special configuration for cvstrees  # Do some special configuration for cvstrees
 if (-f $config_cvstree) {  if (-f $config_cvstree) {
    require $config_cvstree     do $config_cvstree
      || &fatal("500 Internal Error",       || &fatal("500 Internal Error",
                sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>',                 sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>',
                        $config_cvstree, &htmlify($@)));                         $config_cvstree, &htmlify($@)));
Line 474  $module = $1;
Line 425  $module = $1;
 if ($module && &forbidden_module($module)) {  if ($module && &forbidden_module($module)) {
     &fatal("403 Forbidden", "Access to $where forbidden.");      &fatal("403 Forbidden", "Access to $where forbidden.");
 }  }
   
 #  
 # Handle tarball downloads before any headers are output.  
 #  
 if ($input{tarball}) {  
     &fatal("403 Forbidden", "Downloading tarballs is prohibited.")  
       unless $allow_tar;  
     $where =~ s,/[^/]*$,,;  
     $where =~ s,^/,,;  
     my($basedir) = ($where =~ m,([^/]+)$,);  
   
     if ($basedir eq '' || $where eq '') {  
         &fatal("500 Internal Error", "You cannot download the top level directory.");  
     }  
   
     my $tmpdir = "/tmp/.cvsweb.$$." . int(time);  
   
     mkdir($tmpdir, 0700)  
       or &fatal("500 Internal Error", "Unable to make temporary directory: $!");  
   
     my $fatal = '';  
   
     do {  
         chdir $tmpdir  
           or $fatal = "500 Internal Error", "Unable to cd to temporary directory: $!"  
             && last;  
   
         my @params = (exists $input{only_with_tag} && length $input{only_with_tag})  
           ? ("-r", $input{only_with_tag}) : ();  
   
         system "cvs", "-RlQd", $cvsroot, "co", @params, $where  
           and $fatal = "500 Internal Error","cvs co failure: $!: $where"  
             && last;  
   
         chdir "$where/.."  
           or $fatal = "500 Internal Error","Cannot find expected directory in checkout"  
             && last;  
   
         $| = 1; # Essential to get the buffering right.  
   
         print "Content-type: application/x-gzip\r\n\r\n";  
   
         system "tar", "--ignore-failed-read", "--exclude", "CVS", "-zcf", "-", $basedir  
           and $fatal = "500 Internal Error","tar zc failure: $!: $basedir"  
             && last;  
   
         chdir $tmpdir  
           or $fatal = "500 Internal Error","Unable to cd to temporary directory: $!"  
             && last;  
     } while (0);  
   
     system "rm", "-rf", $tmpdir if -d $tmpdir;  
   
     &fatal($fatal) if $fatal;  
   
     exit;  
 }  
   
 ##############################  ##############################
 # View a directory  # View a directory
 ###############################  ###############################
 if (-d $fullname) {  elsif (-d $fullname) {
         my $dh = do {local(*DH);};          my $dh = do {local(*DH);};
         opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!");          opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!");
         my @dir = readdir($dh);          my @dir = readdir($dh);
Line 873  if (-d $fullname) {
Line 766  if (-d $fullname) {
             print "<INPUT TYPE=SUBMIT VALUE=\"Go\">\n";              print "<INPUT TYPE=SUBMIT VALUE=\"Go\">\n";
             print "</FORM>\n";              print "</FORM>\n";
         }          }
   
         if ($allow_tar) {  
             my($basefile) = ($where =~ m,(?:.*/)?([^/]+),);  
   
             if ($basefile ne '') {  
                 print "<HR NOSHADE>\n",  
                   "<DIV align=center>",  
                     &link("Download this directory in tarball",  
                           # Mangle the filename so browsers show a reasonable  
                           # filename to download.  
                           "$basefile.tar.gz$query".  
                           ($query ? "&" : "?")."tarball=1"),  
                             "</DIV>";  
             }  
         }  
   
         my $formwhere = $scriptwhere;          my $formwhere = $scriptwhere;
         $formwhere =~ s|Attic/?$|| if ($input{'hideattic'});          $formwhere =~ s|Attic/?$|| if ($input{'hideattic'});
   
Line 908  if (-d $fullname) {
Line 785  if (-d $fullname) {
             print "<OPTION",$byrev ? " SELECTED" : ""," VALUE=rev>Revision";              print "<OPTION",$byrev ? " SELECTED" : ""," VALUE=rev>Revision";
             print "<OPTION",$bylog ? " SELECTED" : ""," VALUE=log>Log message";              print "<OPTION",$bylog ? " SELECTED" : ""," VALUE=log>Log message";
             print "</SELECT></td>";              print "</SELECT></td>";
             print "<td>Sort log by: ";              print "<td>revisions by: \n";
             printLogSortSelect(0);              print "<SELECT NAME=logsort>\n";
             print "</td></tr>";              print "<OPTION VALUE=cvs",$logsort eq "cvs" ? " SELECTED" : "", ">Not sorted";
               print "<OPTION VALUE=date",$logsort eq "date" ? " SELECTED" : "", ">Commit date";
               print "<OPTION VALUE=rev",$logsort eq "rev" ? " SELECTED" : "", ">Revision";
               print "</SELECT></td></tr>";
             print "<tr><td>Diff format: ";              print "<tr><td>Diff format: ";
             printDiffSelect(0);              printDiffSelect(0);
             print "</td>";              print "</td>";
Line 986  if (-d $fullname) {
Line 866  if (-d $fullname) {
         my $fh = do {local(*FH);};          my $fh = do {local(*FH);};
         my ($xtra, $module);          my ($xtra, $module);
         # Assume it's a module name with a potential path following it.          # Assume it's a module name with a potential path following it.
         $xtra = (($module = $where) =~ s|/.*||) ? $& : '';          $xtra = $& if (($module = $where) =~ s|/.*||);
         # Is there an indexed version of modules?          # Is there an indexed version of modules?
         if (open($fh, "$cvsroot/CVSROOT/modules")) {          if (open($fh, "$cvsroot/CVSROOT/modules")) {
             while (<$fh>) {              while (<$fh>) {
                 if (/^(\S+)\s+(\S+)/o && $module eq $1                  if (/^(\S+)\s+(\S+)/o && $module eq $1
                     && -d "$cvsroot/$2" && $module ne $2) {                      && -d "${cvsroot}/$2" && $module ne $2) {
                     &redirect("$scriptname/$2$xtra");                      &redirect($scriptname . '/' . $2 . $xtra);
                 }                  }
             }              }
         }          }
Line 1004  gzipclose();
Line 884  gzipclose();
   
 sub printDiffSelect($) {  sub printDiffSelect($) {
     my ($use_java_script) = @_;      my ($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;      print ">\n";
     print '>';      print "<OPTION VALUE=h",$f eq "h" ? " SELECTED" : "", ">Colored Diff";
       print "<OPTION VALUE=H",$f eq "H" ? " SELECTED" : "", ">Long Colored Diff";
     local $_;      print "<OPTION VALUE=u",$f eq "u" ? " SELECTED" : "", ">Unidiff";
     for (@DIFFTYPES) {      print "<OPTION VALUE=c",$f eq "c" ? " SELECTED" : "", ">Context Diff";
         printf('<OPTION VALUE="%s"%s>%s',      print "<OPTION VALUE=s",$f eq "s" ? " SELECTED" : "", ">Side by Side";
                $_,  
                $f eq $_ ? ' SELECTED' : '',  
                "\u$DIFFTYPES{$_}{'descr'}"  
               );  
     }  
   
     print "</SELECT>";      print "</SELECT>";
 }  }
   
 sub printLogSortSelect($) {  
     my ($use_java_script) = @_;  
   
     print '<SELECT NAME="logsort"';  
     print ' onchange="submit()"' if $use_java_script;  
     print '>';  
   
     local $_;  
     for (@LOGSORTKEYS) {  
         printf('<OPTION VALUE="%s"%s>%s',  
                $_,  
                $logsort eq $_ ? ' SELECTED' : '',  
                "\u$LOGSORTKEYS{$_}{'descr'}"  
               );  
     }  
   
     print "</SELECT>";  
 }  
   
 sub findLastModifiedSubdirs(@) {  sub findLastModifiedSubdirs(@) {
     my (@dirs) = @_;      my (@dirs) = @_;
     my ($dirname, @files);      my ($dirname, @files);
Line 1078  sub findLastModifiedSubdirs(@) {
Line 933  sub findLastModifiedSubdirs(@) {
 sub htmlify_sub(&$) {  sub htmlify_sub(&$) {
     (my $proc, local $_) = @_;      (my $proc, local $_) = @_;
     local @_ = split(m`(<a [^>]+>[^<]*</a>)`i);      local @_ = split(m`(<a [^>]+>[^<]*</a>)`i);
     my $linked;      my ($linked, $result);
     my $result = '';  
   
     while (($_, $linked) = splice(@_, 0, 2)) {      while (($_, $linked) = splice(@_, 0, 2)) {
         &$proc();          &$proc();
         $result .= $_ if defined($_);          $result .= $_;
         $result .= $linked if defined($linked);          $result .= $linked;
     }      }
   
     $result;      $result;
Line 1129  sub htmlify($;$) {
Line 983  sub htmlify($;$) {
                        \#?)                         \#?)
                       (\d+)\b                        (\d+)\b
                      }{                       }{
                          $1 . &link($2, sprintf($prcgi, $2))                           $1 . &link($2, sprintf($prcgi, $2)) . $3
                      }egix;                       }egix;
                 } $_;                  } $_;
             } while ($_ ne $prev);              } while ($_ ne $prev);
Line 1138  sub htmlify($;$) {
Line 992  sub htmlify($;$) {
                 s{                  s{
                   (\b$prcategories/(\d+)\b)                    (\b$prcategories/(\d+)\b)
                  }{                   }{
                      &link($1, sprintf($prcgi, $2))                       &link($1, sprintf($prcgi, $2)) . $3
                  }egox;                   }egox;
             } $_;              } $_;
         }          }
Line 1155  sub htmlify($;$) {
Line 1009  sub htmlify($;$) {
                    )                     )
                   )                    )
                  }{                   }{
                      &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2))                       &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2)) . $5
                  }egx;                   }egx;
             } $_;              } $_;
         }          }
Line 1197  sub spacedHtmlText($;$) {
Line 1051  sub spacedHtmlText($;$) {
 sub link($$) {  sub link($$) {
         my($name, $where) = @_;          my($name, $where) = @_;
   
         sprintf '<A HREF="%s">%s</A>', hrefquote($where), $name;          sprintf '<A HREF="%s">%s</A>', htmlquote($where), $name;
 }  }
   
 sub revcmp($$) {  sub revcmp($$) {
Line 1566  sub doCheckout($$) {
Line 1420  sub doCheckout($$) {
       open(STDERR, ">&STDOUT"); # Redirect stderr to stdout        open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
       exec("cvs", "-Rld", $cvsroot, "co", "-p", $revopt, $where);        exec("cvs", "-Rld", $cvsroot, "co", "-p", $revopt, $where);
     }      }
   
     if (eof($fh)) {  
         &fatal("404 Not Found",  
                "$where is not (any longer) pertinent");  
     }  
 #===================================================================  #===================================================================
 #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 1590  sub doCheckout($$) {
Line 1439  sub doCheckout($$) {
     }      }
     if ($filename ne $where) {      if ($filename ne $where) {
         &fatal("500 Internal Error",          &fatal("500 Internal Error",
                "Unexpected output from cvs co: $cvsheader");                 "Unexpected output from cvs co: $cvsheader"
                  . "<p><b>Check whether the directory $cvsroot/CVSROOT exists "
                  . "and the script has write-access to the CVSROOT/history "
                  . "file if it exists."
                  . "<br>The script needs to place lock files in the "
                  . "directory the file is in as well.</b>");
     }      }
     $| = 1;      $| = 1;
   
Line 1641  sub cvswebMarkup($$$) {
Line 1495  sub cvswebMarkup($$$) {
     my $url = download_url($fileurl, $revision, $mimetype);      my $url = download_url($fileurl, $revision, $mimetype);
     print "<HR noshade>";      print "<HR noshade>";
     if ($mimetype =~ /^image/) {      if ($mimetype =~ /^image/) {
         printf '<IMG SRC="%s"><BR>', hrefquote("$url$barequery");          printf '<IMG SRC="%s"><BR>', htmlquote("$url$barequery");
     }      }
     elsif ($mimetype =~ m%^application/pdf%) {      elsif ($mimetype =~ m%^application/pdf%) {
         printf '<EMBED SRC="%s" WIDTH="100%"><BR>', hrefquote("$url$barequery");          printf '<EMBED SRC="%s" WIDTH="100%"><BR>', htmlquote("$url$barequery");
     }      }
     else {      else {
         print "<PRE>";          print "<PRE>";
Line 1675  sub viewable($) {
Line 1529  sub viewable($) {
 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, $f1, $f2);          my ($rev1, $rev2, $sym1, $sym2, @difftype, $diffname, $f1, $f2);
   
         if ($r1 =~ /([^:]+)(:(.+))?/) {          if ($r1 =~ /([^:]+)(:(.+))?/) {
             $rev1 = $1;              $rev1 = $1;
Line 1709  sub doDiff($$$$$$) {
Line 1563  sub doDiff($$$$$$) {
             ($rev1, $sym1) = ($rev2, $sym2);              ($rev1, $sym1) = ($rev2, $sym2);
             ($rev2, $sym2) = ($tmp1, $tmp2);              ($rev2, $sym2) = ($tmp1, $tmp2);
         }          }
         my $difftype = $DIFFTYPES{$f};          my $human_readable = 0;
           if ($f eq 'c') {
         if (!$difftype) {              @difftype = qw{-c};
               $diffname = "Context diff";
           }
           elsif ($f eq 's') {
               @difftype = qw{--side-by-side --width=164};
               $diffname = "Side by Side";
           }
           elsif ($f eq 'H') {
               $human_readable = 1;
               @difftype = qw{--unified=15};
               $diffname = "Long Human readable";
           }
           elsif ($f eq 'h') {
               @difftype =qw{-u};
               $human_readable = 1;
               $diffname = "Human readable";
           }
           elsif ($f eq 'u') {
               @difftype = qw{-u};
               $diffname = "Unidiff";
           }
           else {
             fatal ("400 Bad arguments", "Diff format $f not understood");              fatal ("400 Bad arguments", "Diff format $f not understood");
         }          }
   
         my @difftype       = @{$difftype->{'opts'}};  
         my $human_readable = $difftype->{'colored'};  
   
         # apply special options          # apply special options
         if ($showfunc) {          if ($showfunc) {
             push @difftype, '-p' if $f ne 's';              push @difftype, '-p' if $f =~ /^[cHhu]$/;
   
             my($re1, $re2);              my($re1, $re2);
   
Line 1857  sub getDirLogs($$@) {
Line 1729  sub getDirLogs($$@) {
 again:  again:
         if ($state eq "head") {          if ($state eq "head") {
             #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet)              #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet)
               $filename = $1 if (/^Working file: (.+)$/);
             if (/^Working file: (.+)$/) {              $head = $1 if (/^head: (.+)$/);
                 $filename = $1;              $branch = $1 if (/^branch: (.+)$/);
             } elsif (/^head: (.+)$/) {          }
                 $head = $1;          if ($state eq "head" && /^symbolic names/) {
             } elsif (/^branch: (.+)$/) {              $state = "tags";
                 $branch = $1              ($branch = $head) =~ s/\.\d+$// if (!defined($branch));
             } elsif (/^symbolic names:/) {              $branch =~ s/(\.?)(\d+)$/${1}0.$2/;
                 $state = "tags";              $symrev{MAIN} = $branch;
                 ($branch = $head) =~ s/\.\d+$// if (!defined($branch));              $symrev{HEAD} = $branch;
                 $branch =~ s/(\d+)$/0.$1/;              $alltags{MAIN} = 1;
                 $symrev{MAIN} = $branch;              $alltags{HEAD} = 1;
                 $symrev{HEAD} = $branch;              push (@filetags, "MAIN", "HEAD");
                 $alltags{MAIN} = 1;  
                 $alltags{HEAD} = 1;  
                 push (@filetags, "MAIN", "HEAD");  
             } elsif (/$LOG_REVSEPARATOR/o) {  
                 $state = "log";  
                 $rev = undef;  
                 $date = undef;  
                 $log = "";  
                 # Try to reconstruct the relative filename if RCS spits out a full path  
                 $filename =~ s%^\Q$DirName\E/%%;  
             }  
             next;              next;
         }          }
         if ($state eq "tags") {          if ($state eq "tags" &&
             if (/^\s+(.+):\s+([\d\.]+)\s+$/) {                              /^\s+(.+):\s+([\d\.]+)\s+$/) {
                 push (@filetags, $1);              push (@filetags, $1);
                 $symrev{$1} = $2;              $symrev{$1} = $2;
                 $alltags{$1} = 1;              $alltags{$1} = 1;
               next;
           }
           if ($state eq "tags" && /^\S/) {
               if (defined($tag) && (defined($symrev{$tag}) || $tag eq "HEAD")) {
                   $revwanted = $tag eq "HEAD" ? $symrev{"MAIN"} : $symrev{$tag};
                   ($branch = $revwanted) =~ s/\b0\.//;
                   ($branchpoint = $branch) =~ s/\.?\d+$//;
                   $revwanted = undef if ($revwanted ne $branch);
               }
               elsif (defined($tag) && $tag ne "HEAD") {
                   print "Tag not found, skip this file" if ($verbose);
                   $state = "skip";
                 next;                  next;
             } elsif (/^\S/) {  
                 if (defined($tag)) {  
                     if(defined($symrev{$tag}) || $tag eq "HEAD") {  
                         $revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag};  
                         ($branch = $revwanted) =~ s/\b0\.//;  
                         ($branchpoint = $branch) =~ s/\.?\d+$//;  
                         $revwanted = undef if ($revwanted ne $branch);  
                     } elsif ($tag ne "HEAD") {  
                         print "Tag not found, skip this file" if ($verbose);  
                         $state = "skip";  
                         next;  
                     }  
                 }  
                 foreach my $tagfound (@filetags) {  
                     $tags{$tagfound} = 1;  
                 }  
                 $state = "head";  
                 goto again;  
             }              }
               foreach my $tagfound (@filetags) {
                   $tags{$tagfound} = 1;
               }
               $state = "head";
               goto again;
         }          }
           if ($state eq "head" && /$LOG_REVSEPARATOR/o) {
               $state = "log";
               $rev = undef;
               $date = undef;
               $log = "";
               # Try to reconstruct the relative filename if RCS spits out a full path
               $filename =~ s%^\Q$DirName\E/%%;
               next;
           }
         if ($state eq "log") {          if ($state eq "log") {
             if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {              if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {
                 # End of a log entry.                  # End of a log entry.
Line 2091  sub readLog($;$) {
Line 1960  sub readLog($;$) {
 # is the first commit listed on the appropriate branch.  # is the first commit listed on the appropriate branch.
 # This is not neccesary the same revision as marked as head in the RCS file.  # This is not neccesary the same revision as marked as head in the RCS file.
         my $headrev = $curbranch || "1";          my $headrev = $curbranch || "1";
         ($symrev{"MAIN"} = $headrev) =~ s/(\d+)$/0.$1/;          ($symrev{"MAIN"} = $headrev) =~ s/(\.?)(\d+)$/${1}0.$2/;
           revision:
         foreach $rev (@revorder) {          foreach $rev (@revorder) {
             if ($rev =~ /^(\S*)\.\d+$/ && $headrev eq $1) {              if ($rev =~ /^(\S*)\.\d+$/ && $headrev eq $1) {
                 $symrev{"HEAD"} = $rev;                  $symrev{"HEAD"} = $rev;
                 last;                  last revision;
             }              }
         }          }
         ($symrev{"HEAD"} = $headrev) =~ s/\.\d+$//          ($symrev{"HEAD"} = $headrev) =~ s/\.\d+$//
Line 2126  sub readLog($;$) {
Line 1996  sub readLog($;$) {
                 # with the branch number 0.A, with the exception that                  # with the branch number 0.A, with the exception that
                 # it has no head to translate to if there is nothing on                  # it has no head to translate to if there is nothing on
                 # the branch, but I guess this can never happen?                  # the branch, but I guess this can never happen?
                 #  
                 # (the code below gracefully forgets about the branch                  # (the code below gracefully forgets about the branch
                 # if it should happen)                  # if it should happen)
                 #                  #
Line 2134  sub readLog($;$) {
Line 2003  sub readLog($;$) {
                 $branch = $3;                  $branch = $3;
                 $branchrev = $head . ($head ne "" ? "." : "") . $branch;                  $branchrev = $head . ($head ne "" ? "." : "") . $branch;
                 my $regex;                  my $regex;
                 $regex = quotemeta $branchrev;                  ($regex = $branchrev) =~ s/\./\\./g;
                 $rev = $head;                  $rev = $head;
   
                   revision:
                 foreach my $r (@revorder) {                  foreach my $r (@revorder) {
                     if ($r =~ /^${regex}\b/) {                      if ($r =~ /^${regex}\b/) {
                         $rev = $branchrev;                          $rev = $branchrev;
                         last;                          last revision;
                     }                      }
                 }                  }
                 next if ($rev eq "");                  next if ($rev eq "");
Line 2196  sub readLog($;$) {
Line 2066  sub readLog($;$) {
   
 }  }
   
 sub printDiffLinks($$) {  
     my($text, $url) = @_;  
     my @extra;  
   
     local $_;  
     for ($DIFFTYPES{$defaultDiffType}{'colored'} ? qw(u) : qw(h)) {  
         my $f = $_ eq $defaultDiffType ? '' : $_;  
   
         push @extra, &link(lc $DIFFTYPES{$_}{'descr'}, "$url&f=$f");  
     }  
   
     print &link($text, $url), ' (', join(', ', @extra), ')';  
 }  
   
 sub printLog($;$) {  sub printLog($;$) {
         my ($link, $br, $brp);          my ($link, $br, $brp);
         ($_,$link) = @_;          ($_,$link) = @_;
Line 2334  sub printLog($;$) {
Line 2190  sub printLog($;$) {
                                   $barequery);                                    $barequery);
   
                 print " to previous ";                  print " to previous ";
                 printDiffLinks($prev, $url);                  print &link($prev, $url);
                   if (!$hr_default) { # offer a human readable version if not default
                       print ' (', &link('colored', "$url&f=h"), ')';
                   }
             }              }
             #              #
             # Plus, if it's on a branch, and it's not a vendor branch,              # Plus, if it's on a branch, and it's not a vendor branch,
Line 2347  sub printLog($;$) {
Line 2206  sub printLog($;$) {
                                   $barequery);                                    $barequery);
   
                 print " to branchpoint ";                  print " to branchpoint ";
                 printDiffLinks($brp, $url);                  print &link($brp, $url);
                   if (!$hr_default) { # offer a human readable version if not default
                       print ' (', &link('colored', "$url&f=h"), ')';
                   }
             }              }
             #              #
             # Plus, if it's on a branch, and it's not a vendor branch,              # Plus, if it's on a branch, and it's not a vendor branch,
Line 2380  sub printLog($;$) {
Line 2242  sub printLog($;$) {
                                       $barequery);                                        $barequery);
   
                     print " next main ";                      print " next main ";
                     printDiffLinks($nextmain, $url);                      print &link($nextmain, $url);
                       if (!$hr_default) { # offer a human readable version if not default
                           print ' (', &link('colored', "$url&f=h"), ')';
                       }
                 }                  }
             }              }
             # Plus if user has selected only r1, then present a link              # Plus if user has selected only r1, then present a link
Line 2395  sub printLog($;$) {
Line 2260  sub printLog($;$) {
                                   $barequery);                                    $barequery);
   
                 print " to selected ";                  print " to selected ";
                 printDiffLinks($input{'r1'}, $url);                  print &link($input{'r1'}, $url);
                   if (!$hr_default) { # offer a human readable version if not default
                       print ' (', &link('colored', "$url&f=h"), ')';
                   }
             }              }
         }          }
         print "<PRE>\n";          print "<PRE>\n";
Line 2475  sub doLog($) {
Line 2343  sub doLog($) {
         print "<HR noshade>\n";          print "<HR noshade>\n";
         print "<TABLE>";          print "<TABLE>";
         print "<FORM METHOD=\"GET\" ACTION=\"$scriptwhere\">\n";          print "<FORM METHOD=\"GET\" ACTION=\"$scriptwhere\">\n";
         print "<TR><TD align=right>Preferred Diff type:</TD>";          print "<TR><TD align=right>Preferred Diff type:</TD>";
         print "<TD>";          print "<TD>";
         printDiffSelect($use_java_script);          printDiffSelect($use_java_script);
         print "</TD><TD></TD></TR>\n";          print "</TD><TD></TD></TR>\n";
         if (@branchnames) {          if (@branchnames) {
Line 2511  sub doLog($) {
Line 2379  sub doLog($) {
         print "<TR><TD align=right>";          print "<TR><TD align=right>";
         print "<A name=logsort></A>\n";          print "<A name=logsort></A>\n";
         print "Sort log by:</TD>";          print "Sort log by:</TD>";
         print "<TD>";          print "<TD><SELECT NAME=\"logsort\"";
         printLogSortSelect($use_java_script);          print " onchange=\"submit()\"" if ($use_java_script);
         print "</TD>";          print ">\n";
           print "<OPTION VALUE=cvs",$logsort eq "cvs" ? " SELECTED" : "", ">Not sorted";
           print "<OPTION VALUE=date",$logsort eq "date" ? " SELECTED" : "", ">Commit date";
           print "<OPTION VALUE=rev",$logsort eq "rev" ? " SELECTED" : "", ">Revision";
           print "</SELECT></TD>";
         print "<TD><INPUT TYPE=SUBMIT VALUE=\"  Set  \"></TD>";          print "<TD><INPUT TYPE=SUBMIT VALUE=\"  Set  \"></TD>";
         print "</FORM>\n";          print "</FORM>\n";
         print "</TR></TABLE>";          print "</TR></TABLE>";
Line 2715  sub navigateHeader($$$$$) {
Line 2587  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 qq`<!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 qq`<META name="robots" content="nofollow">\n`;      print '<!-- CVSweb $zRevision: 1.103 $  $Revision$ -->';
     print '<!-- CVSweb $zRevision: 1.104 $  $kRevision: 1.49 $ -->';  
     print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";      print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";
     print  "$body_tag_for_src\n";      print  "$body_tag_for_src\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 2941  sub download_link($$$;$) {
Line 2812  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);
   
     printf '<A HREF="%s"', hrefquote("$fullurl$barequery");      printf '<A HREF="%s"', htmlquote("$fullurl$barequery");
   
     if ($open_extern_window && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) {      if ($open_extern_window && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) {
         print ' target="cvs_checkout"';          print ' target="cvs_checkout"';
Line 2975  sub download_link($$$;$) {
Line 2846  sub download_link($$$;$) {
               if (defined($extern_window_height));                if (defined($extern_window_height));
   
             printf q` onClick="window.open('%s','cvs_checkout','%s');"`,              printf q` onClick="window.open('%s','cvs_checkout','%s');"`,
               hrefquote($fullurl), join(',', @attr);                htmlquote($fullurl), join(',', @attr);
         }          }
     }      }
     print "><b>$textlink</b></A>";      print "><b>$textlink</b></A>";
Line 3015  sub urlencode($) {
Line 2886  sub urlencode($) {
   
     s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;      s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;
   
     $_;  
          $_;
 }  }
   
 sub htmlquote($) {  sub htmlquote($) {
Line 3042  sub htmlunquote($) {
Line 2914  sub htmlunquote($) {
     $_;      $_;
 }  }
   
 sub hrefquote($) {  
     local($_) = @_;  
   
     y/ /+/;  
   
     htmlquote($_)  
 }  
   
 sub http_header(;$) {  sub http_header(;$) {
     my $content_type = shift || "text/html";      my $content_type = shift || "text/html";
     if (defined($moddate)) {      if (defined($moddate)) {
Line 3084  sub http_header(;$) {
Line 2948  sub http_header(;$) {
             }              }
             select(GZIP);              select(GZIP);
             $gzip_open = 1;              $gzip_open = 1;
 #           print "<!-- gzipped -->" if ($content_type =~ m|^text/html\b|);  #           print "<!-- gzipped -->" if ($content_type eq "text/html");
         }          }
         else {          else {
             if ($is_mod_perl) {              if ($is_mod_perl) {
Line 3108  sub http_header(;$) {
Line 2972  sub http_header(;$) {
   
 sub html_header($) {  sub html_header($) {
     my ($title) = @_;      my ($title) = @_;
     my $version = '$zRevision: 1.104 $  $kRevision: 1.49 $'; #'      my $version = '$zRevision: 1.103 $  $Revision$'; #'
     http_header(defined($charset) ? "text/html; charset=$charset" : "text/html");      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"
  "http://www.w3.org/TR/REC-html40/loose.dtd">   "http://www.w3.org/TR/REC-html40/loose.dtd">
 <html>  <html>
 <head>  
 <meta name="robots" content="nofollow">  
 <title>$title</title>  <title>$title</title>
 <!-- CVSweb $version -->  <!-- CVSweb $version -->
 </head>  </head>

Legend:
Removed from v.1.1.1.17  
changed lines
  Added in v.3.36

CVSweb