Web-based two-column diff with color

S

Stefan

I wrote a Perl script that is too simple to create a project for, but
I do want to share it in case anyone might have use. For me, I use it
to upload two Cisco config scripts and quickly see the difference
between the two. Use and modify as you will. It's public domain.

The diff command is:
diff -iwBay -W $W --left-column file1 file2

Where $W is 10 + 2 * maxlen using the output of:
wc -L file1 file2

# cat diff.cgi
#!/usr/bin/perl

use strict;
use warnings;
use CGI;

my $Q = new CGI;
print "Content-type: text/html\n\n";
if ( !$Q->param('old') && !$Q->param('new') ) {
print <<' FORM';
<FORM ENCTYPE="multipart/form-data" ACTION="#" METHOD="POST">
Please select older file:<BR>
<INPUT TYPE="FILE" NAME="old"><p>
Please select newer file:<BR>
<INPUT TYPE="FILE" NAME="new"><p>
<INPUT TYPE="submit">
</FORM>
FORM
} else {
my $oldfile = $Q->param('old');
open OLD, ">/tmp/diff.old.$$";
while ( <$oldfile> ) {
print OLD;
}
close OLD;
my $newfile = $Q->param('new');
open NEW, ">/tmp/diff.new.$$";
while ( <$newfile> ) {
print NEW;
}
close NEW;
print "<html>\n";
print "<head>\n";
print "<style type=\"text/css\">\n\ttd.delete { color: red; }\n
\ttd.add { color: green; }\n\ttd.change { color: blue; }\n\ttd.common
{ color: black; }\n</style>\n";
print "</head>\n";
my $maxlen = 0;
foreach ( qx{wc -L "/tmp/diff.old.$$" "/tmp/diff.new.$$"} ) {
/^\s*(\d+)\s+/;
$maxlen = $1 if $1 > $maxlen;
}
my $W = $maxlen * 2 + 10;
print "<body>\n";
print "<table>\n";
foreach ( qx{diff -iwBay -W $W --left-column "/tmp/diff.old.$$" "/tmp/
diff.new.$$"} ) {
my ($old, $sym, $new);
if ( /^(.*?)\s+([\|\>])\t(.*?)$/ ) {
($old, $sym, $new) = (/^(.*?)\s+([\|\>])\t(.*?)$/);
} elsif ( /^(.*?)\s+([\<\(])$/ ) {
($old, $sym) = (/^(.*?)\s+([\<\(])$/);
}
print "<tr>";
if ( $sym eq '<' ) {
if ( $old && !$new ) {
print "<td class=\"delete\">$old</td><td class=\"delete\">$sym</
td><td>&nbsp;</td>";
} else {
print "ERROR";
}
} elsif ( $sym eq '>' ) {
if ( !$old && $new ) {
print "<td>&nbsp;</td><td class=\"add\">$sym</td><td class=\"add\">
$new</td>";
} else {
print "ERROR";
}
} elsif ( $sym eq '|' ) {
if ( $old && $new ) {
print "<td class=\"change\">$old</td><td class=\"change\">$sym</
td><td class=\"change\">$new</td>";
} else {
print "ERROR";
}
} elsif ( $sym eq '(' ) {
if ( $old && !$new ) {
print "<td class=\"common\">$old</td><td class=\"common\">=</
td><td class=\"common\">$old</td>";
} else {
print "ERROR";
}
}
print "</tr>\n";
}
print "</table>\n";
print "</body>\n";
print "</html>\n";
}
 
S

sln

I wrote a Perl script that is too simple to create a project for, but
I do want to share it in case anyone might have use. For me, I use it
to upload two Cisco config scripts and quickly see the difference
between the two. Use and modify as you will. It's public domain.
Click to expand...
^^^^
I would modify this part. Its less ambigous and more precise.
foreach ( qx{diff -iwBay -W $W --left-column "/tmp/diff.old.$$" "/tmp/
diff.new.$$"} ) {
my ($old, $sym, $new);
if ( /^(.*?)\s+([\|\>])\t(.*?)$/ ) {
($old, $sym, $new) = (/^(.*?)\s+([\|\>])\t(.*?)$/);
} elsif ( /^(.*?)\s+([\<\(])$/ ) {
($old, $sym) = (/^(.*?)\s+([\<\(])$/);
}
print "<tr>";
if ( $sym eq '<' ) {
if ( $old && !$new ) {
print "<td class=\"delete\">$old</td><td class=\"delete\">$sym</
td><td>&nbsp;</td>";
} else {
print "ERROR";
}
} elsif ( $sym eq '>' ) {
if ( !$old && $new ) {
print "<td>&nbsp;</td><td class=\"add\">$sym</td><td class=\"add\">
$new</td>";
} else {
print "ERROR";
}
} elsif ( $sym eq '|' ) {
if ( $old && $new ) {
print "<td class=\"change\">$old</td><td class=\"change\">$sym</
td><td class=\"change\">$new</td>";
} else {
print "ERROR";
}
} elsif ( $sym eq '(' ) {
if ( $old && !$new ) {
print "<td class=\"common\">$old</td><td class=\"common\">=</
td><td class=\"common\">$old</td>";
} else {
print "ERROR";
}
}
print "</tr>\n";
}
Click to expand...

use strict;
use warnings;

my ($old, $sym, $new);

my @ary_o_strings = (
"*old1* <",
" >\t*new2*",
"*old3* |\t*new3*",
"*old4* ("
);

for (@ary_o_strings)
{
print "<tr>";

if (($old, $sym) = /^ (.*?) \s+ ([<(]$ | [|>]) /xgc )
{
(($new) = /\G \t (.+?) $/x) or $new = '';

if ( $sym eq '<' ) {
if ( length $old ) {
print "<td class=\"delete\">$old</td><td class=\"delete\">$sym</td><td>&nbsp;</td>";
} else {
print "ERROR";
}
} elsif ( $sym eq '>' ) {
if ( !length $old && length $new) {
print "<td>&nbsp;</td><td class=\"add\">$sym</td><td class=\"add\">$new</td>";
} else {
print "ERROR";
}
} elsif ( $sym eq '|' ) {
if ( length $old && length $new) {
print "<td class=\"change\">$old</td><td class=\"change\">$sym</td><td class=\"change\">$new</td>";
} else {
print "ERROR";
}
} elsif ( $sym eq '(' ) {
if ( length $old ) {
print "<td class=\"common\">$old</td><td class=\"common\">=</td><td class=\"common\">$old</td>";
} else {
print "ERROR";
}
}
} else {
print "ERROR";
}
print "</tr>\n";
}

__END__


-sln
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help with my responsive home page 2
Help with code 0
Parsing HTML with HTML::Tree 1
Adding 'download' column to existing 'visitors' table (as requested) 18
Once again: CGI help 3
Working on mobile css menu with plenty of frustration! 2
Telnet - How to not displayed something on web page 2
Searching database with perl script 2

Members online

Total: 44 (members: 1, guests: 43)
Robots: 204

Forum statistics

Threads
473,764
Messages
2,569,566
Members
45,041
Latest member
RomeoFarnh

Latest Threads

Top