#!/usr/bin/perl

use strict;
use warnings;

use IO::Compress::Gzip qw(gzip);

my ( $f1, $f2 ) = @ARGV[ 0 .. 1 ];
my %comparison;

# Get file contents, and compute gzipped lengths.
for my $file ( $f1, $f2 ) {
    get_content( $file, \%{ $comparison{$file} } );
    computations( \%{ $comparison{$file} } );
}

# Try both orderings of files to determine which produces 
# better results. The content is not needed after lengths 
# have been computed.
$comparison{test1}{content} =
  $comparison{$f1}{content} . $comparison{$f2}{content};
computations( \%{ $comparison{test1} } );
delete $comparison{test1}{content};
$comparison{test2}{content} =
  $comparison{$f2}{content} . $comparison{$f1}{content};
computations( \%{ $comparison{test2} } );
delete $comparison{test2}{content};

# The original content is no longer needed.
foreach my $file ( $f1, $f2 ) {
    delete $comparison{$file}{content};
}

printf qq{Comparison: %5.2f%% similarity\n},
  compute_ratio( \%comparison, ( $f1, $f2 ) );

sub order_pair {
    my ( $i, $j ) = @_;
    my ( $min, $max ) = ( $i, $j );
    ( $min, $max ) = ( $max, $min ) if ( $max < $min );
    return ( $min, $max );
}

sub compute_ratio {
    my ( $hash, @fl ) = @_;

    my ( $min, $min_result, $max, $ratio );

    ( $min_result, undef ) = order_pair(
        $hash->{test1}{gzip_length},
        $hash->{test2}{gzip_length}
    );
    ( $min, $max ) = order_pair(
        $hash->{ $fl[0] }{gzip_length},
        $hash->{ $fl[1] }{gzip_length}
    );

    # Files are 100% if they match exactly. 
    #   (a + b - a) / b = b / b = 1
    # Files are 0% if they do not match exactly.
    #   (a + b - (a+b)) / b = 0 / b = 0
    # Ratio computed as how close to the minimal size

    $ratio = 100.0 * ( $min + $max - $min_result ) / $max;
    return $ratio;
}

sub computations {
    my ($hash) = @_;

    # Compute gzipped length of content
    $hash->{length} = length $hash->{content};
    gzip \$hash->{content}, \$hash->{compressed};
    # Gzipped content not needed 
    #   after length has been computed.
    $hash->{gzip_length} = length $hash->{compressed};
    delete $hash->{compressed};
}

sub get_content {
    my ( $fn, $hash ) = @_;

    # Slurp in file content in bin mode
    open( DF, $fn ) or die $!;
    binmode DF;
    $/ = undef;
    $hash->{content} = <DF>;
    close DF;
}
[download]