Web-based two-column diff with color

Discussion in 'Perl Misc' started by Stefan, Oct 1, 2009.

  1. Stefan

    Stefan Guest

    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";
    }
     
    Stefan, Oct 1, 2009
    #1
    1. Advertising

  2. Stefan

    Guest

    On Thu, 1 Oct 2009 12:25:33 -0700 (PDT), Stefan <> wrote:

    >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.

    ^^^^
    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";
    > }


    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
     
    , Oct 2, 2009
    #2
    1. Advertising

  3. Stefan

    Stefan Guest

    Thanks for the feedback Tad and sln! :)
     
    Stefan, Oct 2, 2009
    #3
    1. Advertising

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

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Cyril Vi?ville

    diff Process under diff users

    Cyril Vi?ville, Jun 29, 2004, in forum: Perl
    Replies:
    1
    Views:
    528
    Joe Smith
    Jun 29, 2004
  2. Berrucho
    Replies:
    2
    Views:
    672
    Infant Newbie
    Dec 5, 2003
  3. A Traveler

    Diff CSS styles for diff INPUT TYPE='s?

    A Traveler, Aug 31, 2004, in forum: ASP .Net
    Replies:
    6
    Views:
    4,974
    Steve Fulton
    Aug 31, 2004
  4. Austin Ziegler

    [ANN] Diff::LCS 1.1.0, Diff::LCS 1.0.4

    Austin Ziegler, Aug 8, 2004, in forum: Ruby
    Replies:
    3
    Views:
    209
    Austin Ziegler
    Aug 9, 2004
  5. Kamaljeet Saini
    Replies:
    0
    Views:
    487
    Kamaljeet Saini
    Feb 13, 2009
Loading...

Share This Page