File Coverage

blib/lib/File/MultipleDiff.pm

Criterion	Covered	Total	%
statement	24	124	19.3
branch	0	46	0.0
condition	0	18	0.0
subroutine	8	10	80.0
pod	1	1	100.0
total	33	199	16.5

package File::MultipleDiff;

use 5.006;
use strict;
use warnings FATAL => 'all';

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(multiple_file_diff);

use Carp ;
our $VERSION = '0.06';

use Algorithm::Diff "sdiff";
use Tie::File ;
use Term::ANSIColor;
use Cwd;

##---------------------------------------------------------------------------##
##  Compares 2 files and finds out amount of differences between them        ##
##---------------------------------------------------------------------------##
sub _CompareFiles
{
   my ($file_A, $file_B) = @_ ;

   tie my @A, 'Tie::File', "$file_A"  or die "Can't tie $file_A: $!";
   tie my @B, 'Tie::File', "$file_B"  or die "Can't tie $file_B: $!";

#  printf "CompareFiles: %-12s  %-12s : %3d  %3d\n", $file_A, $file_B, ($#A + 1), ($#B + 1) ;
   my @sdiffs = sdiff( \@A, \@B );

   my $diff_counter = 0;
   my $aref ;

   for $aref (@sdiffs)
   {
      if ($aref->[0] ne 'u')
      {
#        printf "%-2s | %-40s | %-40s | %3d\n", $aref->[0], $aref->[1], $aref->[2], $diff_counter ;
         $diff_counter ++ ;
      }
   }
   untie @A;
   untie @B;

   return $diff_counter ;
}  #  end of "sub _CompareFiles"


##---------------------------------------------------------------------------##
sub multiple_file_diff
{
   my ($directory, $file_pattern, $colour, $digits) = @_;
   my $File_A;
   my $File_B;
   my $file         ;
   my %file         ;
   my $count        ;
   my $title        ;
   my $title_length ;
   my $field        ;
   my $header       ;
   my $name_length  ;
   my $max_length =0;

   my $bold_red   = qq() ;
   my $blue       = qq() ;
   my $bold_blue  = qq() ;
   my $bold_green = qq() ;
   my $color_over      = ""     ;
   my $bold_color_over = "" ;

   unless ((defined $file_pattern) && $file_pattern) { $file_pattern = '.'; }

   unless ((defined $colour) && $colour) { $colour = 'b'; }
   if ($colour !~ /^[bc]$/) { croak "ERROR: colour parameter must be either 'c' or 'b' or empty"; }
   if ($colour eq 'b') { $colour = ''; }

   unless ((defined $digits) && $digits) { $digits = 2; }

   my $start_dir = cwd;
   chdir $directory ;
   opendir (my $dh, '.') || croak "ERROR: can't opendir $directory: $!";
   my @files = grep { /$file_pattern/ && -f "./$_" } readdir($dh);
## foreach $file (<*>) { $file{ $file } = 0 ; }
   closedir $dh;
   for (@files)
   {
      $file{$_} = 0;
      $name_length = length ;
      if ($name_length > $max_length) { $max_length = $name_length; }
   }

   #------------------------------------------------------------------------------
   my %count ;  # HoH

   foreach $File_A (sort keys %file)
   {
      foreach $File_B (sort keys %file)
      {
         if ($File_B ge $File_A)
         {
            $count{$File_A}{$File_B} = &_CompareFiles ($File_A, $File_B) ;
            if (($count{$File_A}{$File_B} >   9) && ($digits <= 2)) { $digits = 3; }
            if (($count{$File_A}{$File_B} >  99) && ($digits <= 3)) { $digits = 4; }
            if (($count{$File_A}{$File_B} > 999) && ($digits <= 4)) { $digits = 5; }
         }
      }
   }
   #------------------------------------------------------------------------------

   my %HoA ;
   foreach (sort keys %file) { $HoA{ $_ } = [ split (//) ] ; }

   my $cnt = 0;
   while ($cnt < $max_length)
   {
      $title .= " " x $max_length . " |" ;
      foreach (sort keys %file)
      {
         if ( exists $HoA{ $_ }[$cnt] ) {  $title .= sprintf " %${digits}s ", $HoA{ $_ }[$cnt] ; }
         else                           {  $title .= sprintf " %${digits}s ", " " ; }
      }
      unless ($cnt) { $title_length = length $title ; }
      $title .= "\n" ;
      $cnt ++;
   }

   $header  = sprintf "%s\n", "-" x $title_length ;
   $header .= sprintf "%s",         $title        ;
   $header .= sprintf "%s", "-" x $title_length ;
   if ($colour) { print  colored ['bold blue'], "$header\n" ; }
   else { print "$header\n" ; }

   chdir $start_dir;

   #-----------------------------------------------------------------------------------
   foreach $File_A (sort keys %file)
   {
      $field = sprintf "%-${max_length}s | ", $File_A ;
      if ($colour) { print colored ['bold blue'], $field ; }
      else { print $field ; }
      foreach $File_B (sort keys %file)
      {
         if ($File_B ge $File_A)
         {
            $count = $count{$File_A}{$File_B} ;

            $field = sprintf "%${digits}d  ", $count ;

            if ($count)
            {
               if ($colour) { print colored ['bold red'], $field; }
               else { print $field; }
            }
            else
            {
               if ($colour) { print colored ['bold green'], $field; }
               else { print $field ; }
            }
         }
         else
         {
            printf "%${digits}s  ", "-" ;
         }
      }
      print  "\n";
   }
}  # end of "sub multiple_file_diff"
1;

__END__