158 lines
3.9 KiB
Perl
Executable file
158 lines
3.9 KiB
Perl
Executable file
#!/usr/bin/env perl
|
|
|
|
use strict;
|
|
use warnings FATAL => 'all';
|
|
|
|
use Tk;
|
|
use IO::File;
|
|
use List::Compare;
|
|
require Tk::ROText;
|
|
|
|
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( -side => 'left' ) ;
|
|
$button_frame->Button( -text => "Quit", -command => sub { $mw->destroy } )->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()
|
|
or return;
|
|
show_results( 'File A only', $lc->get_unique_ref );
|
|
}
|
|
|
|
sub file_B_only {
|
|
my $lc = compare_files()
|
|
or return;
|
|
show_results( 'File B only', $lc->get_complement_ref );
|
|
}
|
|
|
|
sub both_files {
|
|
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 ( $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: $!" );
|
|
return;
|
|
}
|
|
|
|
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 {
|
|
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' );
|
|
}
|