#!/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' ); }