Back to home page
Get LXR Cross Referencer at SourceForge.net. Fast, secure and Free Open Source software downloads

LXR self cross-referenced (under SQLite)

 
 

    


File indexing completed on 2017-05-02 17:45:25

0001 #!/usr/bin/perl -T
0002 ######################################################################
0003 #
0004 # diff --   Display diff output with markup.
0005 #
0006 #   Arne Georg Gleditsch <argggh@ifi.uio.no>
0007 #   Per Kristian Gjermshus <pergj@ifi.uio.no>
0008 #
0009 #
0010 # This program is free software; you can redistribute it and/or modify
0011 # it under the terms of the GNU General Public License as published by
0012 # the Free Software Foundation; either version 2 of the License, or
0013 # (at your option) any later version.
0014 #
0015 # This program is distributed in the hope that it will be useful,
0016 # but WITHOUT ANY WARRANTY; without even the implied warranty of
0017 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
0018 # GNU General Public License for more details.
0019 #
0020 # You should have received a copy of the GNU General Public License
0021 # along with this program; if not, write to the Free Software
0022 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
0023 #
0024 ######################################################################
0025 
0026 use strict;
0027 use lib do { $0 =~ m{(.*)/} ? "$1/lib" : "lib" }; # if LXR modules are in ./lib
0028 
0029 =head1 diff script
0030 
0031 This script manages display of code differences between
0032 two versions of a source file.
0033 
0034 =cut
0035 
0036 use LXR::Common;
0037 use LXR::Markup;
0038 use LXR::Template;
0039 use Local;
0040 use FileHandle;
0041 
0042 
0043 =head2 C<fflush ()>
0044 
0045 Function C<fflush> sets STDOUT in autoflush mode.
0046 
0047 B<Note:>
0048 
0049 =over
0050 
0051 =item
0052 
0053 I<The reason for using this function is not clear.
0054 It has been commented out without adverse effect.>
0055 
0056 I<Being very short, it could be inlined (only one usage!)
0057 if it needs to be reenabled.>
0058 
0059 =back
0060 
0061 =cut
0062 
0063 # sub fflush {
0064 #   $| = 1;
0065 #   print('');
0066 # }
0067 
0068 
0069 =head2 C<htmljust ($s, $w)>
0070 
0071 Function C<htmljust> returns an HTML string justified to exactly
0072 a fixed number of screen positions.
0073 
0074 =over
0075 
0076 =item 1
0077 
0078 C<$s>
0079 
0080 a I<string> containing an HTML sequence
0081 
0082 =item 2
0083 
0084 C<$w>
0085 
0086 an I<integer> defining the justification width
0087 
0088 =back
0089 
0090 The string argument is truncated or expanded to show exactly
0091 C<$w> "characters" on screen.
0092 
0093 Atomic units must not be split, otherwise HTML integrity is broken.
0094 HTML tags and entity references are copied without truncation.
0095 
0096 When checking overflow, HTML tags are considered as zero-width "characters"
0097 and HTML entity references as one screen position glyphs
0098 (which is not always the case: combining diacritic marks,
0099 zero-width spacers, ...).
0100 
0101 When the desired width is met, opening tags may not have been matched
0102 by their closing tags. To return a synctactically correct HTML
0103 sequence, HTML tags are still copied but without their content.
0104 This results in a sequence longer than necessary, but it is safe.
0105 
0106 =cut
0107 
0108 sub htmljust {
0109     my ($s, $w) = @_;
0110     my @s = split(/(<.*?>|&[\#\w\d]+;)/, $s);
0111     $s = '';
0112 
0113     while (@s){
0114         my $f = shift(@s);
0115         next if $f eq '';
0116         if ('<' eq substr($f, 0, 1)) {
0117         # HTML tag element: no screen position, copy it
0118             $s .= $f
0119         } elsif ('&' eq substr($f, 0, 1)) {
0120         # HTML entity reference: one screen position usually
0121         # Copy it space permitting
0122             if ($w > 0) {
0123                 $s .= $f;
0124                 $w--;
0125             }
0126         } else {
0127         # Ordinary text, check for truncation
0128             $f = substr($f, 0, $w);
0129             $w -= length($f);
0130             $s .= $f;
0131         }
0132     }
0133     # Add spaces up to the requested width
0134     $s .= ' ' x $w;
0135     return $s;
0136 }
0137 
0138 
0139 =head2 C<printdiff (@dargs)>
0140 
0141 Procedure C<printdiff> is the main driver for difference display
0142 (two passes).
0143 
0144 =over
0145 
0146 =item 1
0147 
0148 C<@dargs>
0149 
0150 an I<array> containing the C<'variables'> values for the reference version
0151 
0152 =back
0153 
0154 When entered for the first time, query arguments only offer current
0155 C<'variables'> values.
0156 This is detected by the absence of any C<~>I<var_name>C<=>... argument.
0157 Current values are then transfered into these so-called I<remembered>
0158 values and user is requested to choose another version.
0159 
0160 On second entry, both current values (I<var_name>C<=>...) and
0161 remembered values (C<~>I<var_name>C<=>...) are present in the
0162 query arguments.
0163 The latter values designate the reference version (in the right pane);
0164 the former values the "new" version (in the left pane).
0165 With these two file descriptions, processing can be done.
0166 
0167 The file name in C<$pathname> has been nominally transformed by the
0168 C<'maps'> rules.
0169 But to get the other name, we must first reverse the effects of these
0170 rules (in the remembered environment) et re-apply them (in the current
0171 environment).
0172 Once this is done, both file names correctly point to the desired
0173 versions.
0174 
0175 Next, physical (real) files are obtained so that I<rcs B<diff>> can
0176 build the patch directives..
0177 
0178 Both files are highlighted by C<markupfile>.
0179 The resulting HTML streams are kept in memory.
0180 I<This could cause a serious strain on memory and degrade performance
0181 (because of swapping for instance).>
0182 
0183 Then it is relatively simple to merge both streams line by line
0184 under control of the patch directives.
0185 
0186 
0187 =cut
0188 
0189 sub printdiff {
0190     my (@dargs) = @_;
0191 
0192     if ($#dargs < 0) {
0193     # First pass through the script
0194     # Request second version
0195         my @vars;
0196         foreach ($config->allvariables) {
0197             if  (!exists($config->{'variables'}{$_}{'when'})
0198                 || eval($config->varexpand($config->{'variables'}{$_}{'when'}))
0199                 ) {
0200                 push(@vars, $config->vardescription($_));
0201             }
0202         }
0203 
0204         $vars[ $#vars - 1 ] .= ' or ' . pop(@vars) if $#vars > 0;
0205 
0206         print   ( "<p align=\"center\">\n"
0207                 , "Please indicate the version of the file you wish to\n"
0208                 , "compare to by clicking on the appropriate\n"
0209                 , join(', ', @vars)
0210                 , " button.\n"
0211                 , "</p>\n"
0212                 );
0213         return;
0214     }
0215 
0216     # Second pass - both versions are known
0217     if ('/' eq substr($pathname, -1)) {
0218         print("<h3 align=\"center\">Diff not yet supported for directories.</h3>\n");
0219         return;
0220     }
0221     my $origname = $pathname;
0222     # Tentatively reverse the effect of mappath on $pathname to get an "early bird"
0223     # skeleton path on which to apply the mapping rules in the current environment.
0224     my $diffname = $config->mappath($config->unmappath($pathname, @dargs));
0225     my ($diffv) = grep(m/v=/, @dargs);
0226     $diffv =~ s/v=//;
0227 
0228     unless ($files->isfile($origname, $diffv)) {
0229         print("<p class='error'>*** $origname does not exist in version $diffv ***</p>\n");
0230         return;
0231     }
0232     unless ($files->isfile($diffname, $releaseid)) {
0233         print("<p class='error'>*** $diffname does not exist in version $releaseid ***</p>\n");
0234         return;
0235     }
0236 
0237 #   fflush;
0238     # realfilename may create a temporary file
0239     # which should be released when no longer needed
0240     my $origtemp = $files->realfilename($origname, $diffv);
0241     my $difftemp = $files->realfilename($diffname, $releaseid);
0242     $ENV{'PATH'} = '/usr/local/bin:/usr/bin:/bin:/usr/sbin';
0243     unless (open(DIFF, '-|')) {
0244         open(STDERR, '>&STDOUT');
0245         exec('diff', '-U0', $difftemp, $origtemp);
0246         die "*** Diff subprocess died unexpectedly: $!\n";
0247     }
0248 
0249     my ($leftstart, $leftlen);      # What is replaced in left file
0250     my ($rightstart, $rightlen);    # What replaces in tight file
0251     my $facing;                     # Number of facing lines
0252     my $rightxcess;                 # Running count of lines in excess at right
0253     my $leftorg;                    # Final real line number at left
0254     my $dir;                        # Change indicator
0255     my %chg;                        # All change indicators
0256     my $blanks;                     # Number of blanks lines to keep abreast
0257     my (%leftblanks, %rightblanks);
0258 
0259     while (<DIFF>) {
0260         if  (($leftstart, $leftlen, $rightstart, $rightlen)
0261                 = m/^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@/
0262             ) {
0263             $leftstart++  if $leftlen eq '0';
0264             $rightstart++ if $rightlen eq '0';
0265             $leftlen  = 1 unless defined($leftlen);
0266             $rightlen = 1 unless defined($rightlen);
0267 
0268             $leftorg = $leftstart + $rightxcess;
0269             if ($leftlen < $rightlen) {
0270                 $rightxcess += $rightlen - $leftlen;
0271 
0272                 $dir    = '&gt;&gt;';
0273                 $blanks = $rightlen - $leftlen;
0274                 $facing = $leftlen;
0275                 $leftblanks{$leftstart + $leftlen} = $blanks;
0276             } else {
0277                 $dir    = '&lt;&lt;';
0278                 $blanks = $leftlen - $rightlen;
0279                 $facing = $rightlen;
0280                 $rightblanks{$rightstart + $rightlen} = $blanks;
0281             }
0282             foreach (0 .. $facing - 1) {
0283                 $chg{ $leftorg + $_ } = '!!';
0284             }
0285             foreach (0 .. $blanks - 1) {
0286                 $chg{ $leftorg + $facing + $_ } = $dir;
0287             }
0288 
0289         }
0290     }
0291     close(DIFF);
0292 
0293     #   Print a descriptive title and tell exactly what versions
0294     #   are compared (dump the variable value sets)
0295     my @linkargs = grep {m/(.*?)=(.*)/; $config->variable($1) ne $2;} @dargs;
0296     map (s/(.*?)=/!$1=/, @linkargs);
0297     print   ( "<h1>Diff markup</h1>\n"
0298             , '<h2>between '
0299             , fileref   ( $diffname
0300                         , 'diff-fref'
0301                         , $diffname
0302                         , undef
0303                         , @linkargs
0304                         )
0305             , ' <small>('
0306             );
0307     my @fctx;
0308     for my $var ($config->allvariables) {
0309         next if exists($config->{'variables'}{$var}{'when'})
0310                 && !eval($config->varexpand($config->{'variables'}{$var}{'when'}));
0311         push (@fctx, $config->vardescription($var).': '.$config->variable($var));
0312     }
0313     print   ( join(', ', @fctx)
0314             , ')</small><br>'
0315             , ' and '
0316             , fileref   ( $origname
0317                         , 'diff-fref'
0318                         , $origname
0319                         )
0320             , ' <small>('
0321             );
0322     @fctx = ();
0323     for my $var ($config->allvariables) {
0324         next if exists($config->{'variables'}{$var}{'when'})
0325                 && !eval($config->varexpand($config->{'variables'}{$var}{'when'}));
0326         my ($varval) = grep(m/$var=/, @dargs);
0327         $varval =~ s/$var=//;
0328         push (@fctx, $config->vardescription($var).': '.$varval);
0329     }
0330     print   ( join(', ', @fctx)
0331             , ")</small></h2><hr>\n"
0332             );
0333 
0334     #   Highlight both files
0335     my $origh = FileHandle->new($origtemp);
0336     #   Save current environment before switching to @dargs environment
0337     my %oldvars;
0338     foreach my $arg (@dargs) {
0339         if ($arg =~ m/(.*?)=(.*)/) {
0340             $oldvars{$1} = $config->variable($1);
0341             $config->variable($1, $2);
0342         }
0343     }
0344     my $rightfile;
0345     markupfile($origh, sub { $rightfile .= shift });
0346     #   Restore original environment
0347     while ((my $var, my $val) = each %oldvars) {
0348         $config->variable($var, $val);
0349     }
0350     %oldvars = {};
0351     $origh->close;
0352     $files->releaserealfilename($origtemp);
0353 
0354     $pathname = $diffname;
0355 
0356     my $diffh = FileHandle->new($difftemp);
0357     my $leftfile;
0358     markupfile($diffh, sub { $leftfile .= shift });
0359     my $len = $. + $rightxcess; # Total lines displayed
0360     $diffh->close;
0361     $files->releaserealfilename($difftemp);
0362 
0363     $pathname = $origname;
0364 
0365     #   Output both versions side by side
0366     my $i;
0367     $i = 0;
0368     $leftfile  =~ s/^/"\n" x ($leftblanks{$i++})/mge;
0369     $i = 0;
0370     $rightfile =~ s/^/"\n" x ($rightblanks{$i++})/mge;
0371 
0372     my @leftlines  = split(/\n/, $leftfile);
0373     my @rightlines = split(/\n/, $rightfile);
0374 
0375     my $leftwidth = $$HTTP{'param'}{'_diffleftwidth'}
0376                     || $config->{'diffleftwidth'}
0377                     || 50;
0378     print("<pre class=\"filecontent\">\n");
0379     foreach $i (1 .. $len) {
0380         my $l = htmljust($leftlines[$i], $leftwidth);
0381         my $r = $rightlines[$i];
0382 
0383         my $diffmark = '  ';
0384         if ($chg{$i}) {
0385             $diffmark = '<span class="diff-mark">' . $chg{$i} . "</span>";
0386             if ('&lt;&lt;' eq $chg{$i}) {
0387                 $l =~ s|</a> |</a> <span class="diff-left">|;
0388             }
0389             if ('&gt;&gt;' eq $chg{$i}) {
0390                 $r =~ s|</a> |</a> <span class="diff-right">|;
0391             }
0392             if ('!!' eq $chg{$i}) {
0393                 $l =~ s|</a> |</a> <span class="diff-both">|;
0394                 $r =~ s|</a> |</a> <span class="diff-both">|;
0395             }
0396             $l .= '</span>';
0397             $r .= '</span>';
0398         }
0399 
0400         print "$l $diffmark $r\n";
0401     }
0402     print("</pre>\n");
0403 
0404 }
0405 
0406 
0407 =head2 Script entry point
0408 
0409 Builds the header and footer and launches C<printdiff>
0410 for the real job.
0411 
0412 =cut
0413 
0414 httpinit();
0415 std_http_headers('diff');
0416 
0417 makeheader('diff');
0418 my @dargs;
0419 foreach my $param (keys %{$HTTP->{'param'}}) {
0420     my $var = $param;
0421     next unless $var =~ s/^~//;
0422     if (exists($config->{'variables'}{$var})) {
0423             push @dargs, "$var=" . $HTTP->{'param'}{$param};
0424     }
0425 }
0426 printdiff(@dargs);
0427 makefooter('diff');
0428 
0429 httpclean;
0430