From a42ff01ec161d35776a00f9756fe1de2e23b2880 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Fri, 3 Feb 2012 16:44:03 +0000 Subject: [PATCH 1/3] Initial check-in of Perl/Tk implementation of comm(1) --- tk-comm | 131 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 131 insertions(+) create mode 100644 tk-comm diff --git a/tk-comm b/tk-comm new file mode 100644 index 0000000..937640f --- /dev/null +++ b/tk-comm @@ -0,0 +1,131 @@ +#!/usr/bin/env perl + +use strict; +use warnings FATAL => 'all'; + +use Tk; +use IO::File; +use List::Compare; + +my ( $filename_A, $filename_B ) = ( '', '' ); + +my $mw = MainWindow->new; +$mw->title( 'Compare Files' ); + +add_choose_file_frame( 'File A', \$filename_A ); +add_choose_file_frame( 'File B', \$filename_B ); + +my $button_frame = $mw->Frame->pack; +$button_frame->Button( -text => "File A only", -command => \&file_A_only )->pack( -side => 'left' ); +$button_frame->Button( -text => "File B only", -command => \&file_B_only )->pack( -side => 'left' ); +$button_frame->Button( -text => "Both files", -command => \&both_files)->pack; + +MainLoop; + +sub add_choose_file_frame { + my ( $label, $var_ref ) = @_; + + my $frame = $mw->Frame->pack( -side => 'top', -fill => 'x' ); + $frame->Label( -text => $label )->pack( -side => 'left' ); + $frame->Entry( -width => 30, -textvariable => $var_ref )->pack( -side => 'left' ); + $frame->Button( -text => 'Browse', -command => choose_file( $var_ref ) )->pack; +} + +sub choose_file { + my $var_ref = shift; + + my @types = ( + ['All Files', '*', ], + ['Text Files', ['.txt', '.text']], + ); + + return sub { + ${$var_ref} = $mw->getOpenFile( -filetypes => \@types ); + }; +} + +sub file_A_only { + my $lc = compare_files(); + save_results( $lc->get_unique_ref ); +} + +sub file_B_only { + my $lc = compare_files(); + save_results( $lc->get_complement_ref ); +} + +sub both_files { + my $lc = compare_files(); + save_results( $lc->get_intersection_ref ); +} + +sub save_results { + my $results = shift; + + my $filename = $mw->getSaveFile(); + unless ( defined $filename and length $filename ) { + popup_error( "You must specify a file for the results to be saved" ); + return; + } + + my $fh = IO::File->new( $filename, O_RDWR|O_CREAT|O_TRUNC, 0644 ); + unless ( $fh ) { + popup_error( "Failed to open $filename for writing: $!" ); + return; + } + + for my $r ( @{$results} ) { + $fh->print( "$r\n" ); + } + + $fh->close; +} + +sub compare_files { + my ( $A, $B ) = read_files() + or return; + + return List::Compare->new( $A, $B ); +} + +sub read_files { + + unless ( defined $filename_A and length $filename_A ) { + popup_error( "File A must be specified" ); + return; + } + + unless ( defined $filename_B and length $filename_B ) { + popup_error( "File B must be specified" ); + return; + } + + my $content_A = slurp_lines( $filename_A ) + or return; + + my $content_B = slurp_lines( $filename_B ) + or return; + + return ( $content_A, $content_B ); +} + +sub slurp_lines { + my $filename = shift; + + my $fh = IO::File->new( $filename, O_RDONLY ); + unless ( $fh ) { + popup_error( "Failed to open $filename: $!" ); + return; + } + + local $/ = undef; + + my $content = <$fh>; + + [ split qr/\r\n|\r|\n/, $content ]; +} + +sub popup_error { + my $error = shift; + $mw->messageBox( -title => 'Error', -message => $error, -type => 'ok' ); +} From 1cebf8de3c003ac5cab14ca9f7dd40e1f7a19b05 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Sun, 5 Feb 2012 11:34:54 +0000 Subject: [PATCH 2/3] Add Quit button; display results and make save optional --- tk-comm | 51 +++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 39 insertions(+), 12 deletions(-) mode change 100644 => 100755 tk-comm diff --git a/tk-comm b/tk-comm old mode 100644 new mode 100755 index 937640f..1a1dcd4 --- a/tk-comm +++ b/tk-comm @@ -6,6 +6,7 @@ use warnings FATAL => 'all'; use Tk; use IO::File; use List::Compare; +require Tk::ROText; my ( $filename_A, $filename_B ) = ( '', '' ); @@ -18,7 +19,8 @@ add_choose_file_frame( 'File B', \$filename_B ); my $button_frame = $mw->Frame->pack; $button_frame->Button( -text => "File A only", -command => \&file_A_only )->pack( -side => 'left' ); $button_frame->Button( -text => "File B only", -command => \&file_B_only )->pack( -side => 'left' ); -$button_frame->Button( -text => "Both files", -command => \&both_files)->pack; +$button_frame->Button( -text => "Both files", -command => \&both_files )->pack( -side => 'left' ) ; +$button_frame->Button( -text => "Quit", -command => sub { $mw->destroy } )->pack; MainLoop; @@ -45,29 +47,50 @@ sub choose_file { } sub file_A_only { - my $lc = compare_files(); - save_results( $lc->get_unique_ref ); + my $lc = compare_files() + or return; + show_results( 'File A only', $lc->get_unique_ref ); } sub file_B_only { - my $lc = compare_files(); - save_results( $lc->get_complement_ref ); + my $lc = compare_files() + or return; + show_results( 'File B only', $lc->get_complement_ref ); } sub both_files { - my $lc = compare_files(); - save_results( $lc->get_intersection_ref ); + my $lc = compare_files() + or return; + show_results( 'Both files', $lc->get_intersection_ref ); +} + +sub show_results { + my ( $title, $results ) = @_; + + my $results_window = $mw->Toplevel( -title => $title ); + my $text = $results_window->Scrolled( 'ROText', -wrap => 'none', -scrollbars => 'osoe' )->pack; + $text->insert( 'end', join "\n", @{$results} ); + + $results_window->Button( + -text => 'Close', + -command => sub { $results_window->destroy } + )->pack( -side => 'right' ); + + $results_window->Button( + -text => 'Save', + -command => sub { save_results( $results_window, $results ) && $results_window->destroy } + )->pack( -side => 'right' ); } sub save_results { - my $results = shift; - - my $filename = $mw->getSaveFile(); + my ( $rw, $results ) = @_; + + my $filename = $rw->getSaveFile(); unless ( defined $filename and length $filename ) { popup_error( "You must specify a file for the results to be saved" ); return; } - + my $fh = IO::File->new( $filename, O_RDWR|O_CREAT|O_TRUNC, 0644 ); unless ( $fh ) { popup_error( "Failed to open $filename for writing: $!" ); @@ -77,8 +100,12 @@ sub save_results { for my $r ( @{$results} ) { $fh->print( "$r\n" ); } - + $fh->close; + + $rw->messageBox( -title => 'Saved', -message => "Results saved to $filename", -type => 'ok' ); + + return 1; } sub compare_files { From 1cb71310de7296a1cc40672b8549c782735f0546 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Sun, 5 Feb 2012 11:51:04 +0000 Subject: [PATCH 3/3] Add documentation --- tk-comm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/tk-comm b/tk-comm index 1a1dcd4..62b31f8 100755 --- a/tk-comm +++ b/tk-comm @@ -156,3 +156,30 @@ sub popup_error { my $error = shift; $mw->messageBox( -title => 'Error', -message => $error, -type => 'ok' ); } + +__END__ + +=head1 NAME + +tk-comm + +=head1 DESCRIPTION + +B is a graphical version of the standard Unix L +command. Unlike L, it does not require files to be sorted, +and it handles Unix, Windows, and Mac line endings transparently. + +=head1 SEE ALSO + +L, L + +=head1 AUTHOR + +Ray Miller Eray@1729.org.ukE + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2012 Ray Miller. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself.