The file test operators, all documented under the -X entry in perlfunc, can use the virtual filehandle _, the single underscore, to reuse the results of the previous file lookup. They don’t just look up the single attribute you test, but all of it (through stat) which it filters to give you the answer to the question that you ask. The _ reuses that information to answer the next question instead of looking it up again.

I had a program that was similar to this one, where I used some filetest operators, including the -l to test if it’s a symbolic link.

use v5.14;

my $filename = join ".", $0, $$, time, 'txt';
my $symname  = $filename =~ s/\.txt/-link.txt/r;

open my $fh, '>', $filename
  or die "Could not open [$filename]: $!";
say $fh 'Just another Perl hacker,';
close $fh;

symlink $filename, $symname 
  or die "Could not symlink [$symname]";

# http://perldoc.perl.org/functions/-X.html
foreach( $filename, $symname ) {
  say;
  say "\texists"           if -e;
  say "\thas size " . -s _ if -z _;
  say "\tis a link"        if -l _;
  }

I get this fatal error:

The stat preceding -l _ wasn't an lstat at test_link_test.pl line 19

The entry in perlfunc doesn’t say anything about this, but it hints that -l is a bit special:

If any of the file tests (or either the stat or lstat operator) is given the special filehandle consisting of a solitary underline, then the stat structure of the previous file test (or stat operator) is used, saving a system call. (This doesn’t work with -t , and you need to remember that lstat() and -l leave values in the stat structure for the symbolic link, not the real file.) (Also, if the stat buffer was filled by an lstat call, -T and -B will reset it with the results of stat _ ).

Adding the diagnostics pragma has the answer that isn’t in perlfunc:

The stat preceding -l _ wasn't an lstat at test_link_test.pl line 19 (#1)
    (F) It makes no sense to test the current stat buffer for symbolic
    linkhood if the last stat that wrote to the stat buffer already went
    past the symlink to get to the real file.  Use an actual filename
    instead.

The other file test operators will perform a stat. If the file is a symlink, the stat follows the symlink to get the information from its target. A symlink to a symlink will even keep going until it ultimately gets to a non symlink. With a stat, the -l _ will never be true because it always ends up at the target, even if it doesn’t exist.

The lstat doesn’t follow the link, so it can answer the -l _ question because it might have returned the information for a link and in the case of a non-link, it works just like stat.

As the long version of the warning says, it’s probably better to never use the _ filehandle and use the full filename instead. Sure, it has to redo the work, but you won’t be surprised by a fatal error if you did the wrong type of lookup before.

For example, you should take this structure, where you have A/B/C/D/E in a direct line with no other branches:

and turn it into this one, with a single directory with the files that were at the end:

However, you should only moves files up if the directory above it has only one entry (which must be a subdirectory!). In this example, A/B/C has two subdirectories in it:

so the the files in E should only move up into D. Otherwise, the files from the two branches in C would get mixed up with each other.

<?php // test.php
  $arg = 'T';
  $vehicle = ( ( $arg == 'B' ) ? 'bus' :
               ( $arg == 'A' ) ? 'airplane' :
               ( $arg == 'T' ) ? 'train' :
               ( $arg == 'C' ) ? 'car' :
               ( $arg == 'H' ) ? 'horse' :
               'feet' );
  echo $vehicle;
?>

The result is 'horse', and it will be for almost all values of $arg.

% php test.php
horse

I don’t care so much about the rant, but it told me the answer to this problem. The conditional operator is left associative in PHP, as documented in Operator Precedence. That almost made sense to me, and I know that putting parentheses around these things makes it more clear. I’m almost embarrassed to say that I couldn’t do it right off in this case. Where do I put them? With other operators it’s easy because the operator characters next to each other. I started writing this to figure out the grouping when the operator characters are separated by other things.

Let’s simplify that a bit to we don’t have a big mess. Now there are only two:

<?php // simple.php
  $arg = 'C';
  $vehicle = (
               ( $arg == 'C' ) ? 'car' :
               ( $arg == 'H' ) ? 'horse' : 'feet'
             );
  echo "$vehicle\n";
?>

The result is still 'horse' because we haven’t really changed anything:

% php simple.php
horse

Joel Berger gave a hint when he said that changing 'car' to '' yields 'feet':

<?php // null.php
  $arg = 'C';
  $vehicle = (
               ( $arg == 'C' ) ? '' :
               ( $arg == 'H' ) ? 'horse' : 'feet'
             );
  echo "$vehicle\n";
?>

And it does yield 'feet'::

% php null.php
feet

In Perl, the language I do know, the same operator is right associative (Why is the conditional operator right associative? on Stackoverflow explains why). Associativity, documented in perlop, comes into play when the compiler has to figure out which operator to do first when it has the same operator next to each other. In Learning Perl, we show this with the expontentiation operator since many other operators, such as multiplication and addition, don’t really care. The expontentiation is right associative because that’s what Larry decided it was (C doesn’t have this operator). That means it does the operation on the right before it does the operation on the left. You can see this when you use parentheses, the highest precedence operator, to denote the order you want and compare it to the version without the explicit grouping:

my $num = 4**3**2;    # 262144
my $num = 4**(3**2);  # 262144
my $num = (4**3)**2;  # 4096

We can do the same for the conditional operator in Perl. First, we translate the code to PHP, which is mostly changing == to eq:

# perl.pl
use v5.10;

my $arg = 'C';
my $vehicle = (
               ( $arg eq 'C' ) ? 'car' :
               ( $arg eq 'H' ) ? 'horse' : 'feet'
             );
say $vehicle;

<pre class="brush:plain">
% perl.pl
car

In Perl, we get the same behavior if we put parentheses around the second conditional:

# right.pl
use v5.10;

my $arg = 'C';
my $vehicle = (
               ( $arg eq 'C' ) ? 'car' :
               ( ( $arg eq 'H' ) ? 'horse' : 'feet' )
             );
say $vehicle;

We get the same result as perl.pl because we haven’t changed the order of anything:

% perl right.pl
car

To get the PHP behaviour, we have to change the parentheses like this, to surround everything up to the next ?. It took quite a mental leap for me to get this far because it’s so unnatural:

# left.pl
use v5.10;

my $arg = 'C';                                                        
my $vehicle = (
               ( ( $arg eq 'C' ) ? 'car' : ( $arg eq 'H' ) ) 
                 ? 'horse' : 'feet'
             );
say $vehicle;

Now we get different behaviour:

% perl left.pl
horse

That’s really odd, but it’s also a small gotcha we mention in the Learning Perl class. You can have things such as ( $arg == 'H' ) as a branch. This use probably isn’t useful, but it’s a consequence of the syntax. We can do assignments, for instance:

my $result = $value ? ( $n = 5 ) : ( $m = 6 );

It’s easier to see this as a picture for the path through the conditionals. The right associative version branches either to an endpoint or another decision and there’s only one way to get to that endpoint.

Right associative, as in Perl

The left associative version has multiple ways to get to the same endpoint because either branch in the previous conditional can be the value for the next test. This also shows how 'car' isn’t the endpoint that you think it should be:

Left associative, as in PHP

Going back to do the same thing with the original chain of conditionals, we get this diagram that looks more like a corset lacing instruction than something we meant to program.

The full monty

However, we already know the answers in this particular case because some values are literals, so we can remove several paths. Now it’s much more clear that many paths are feeding into a path that must end up at 'horse'.

The full monty

In fact, the only way to get to 'feet' is to be any letter that is not B, A, T, C, or H. Joel figured this out by changing 'car' to the empty string, which has this diagram:

Joel’s change

The only way to get to 'horse' is to be exactly H. The other letters must end up at 'feet' because they all end up at the empty string. Every other string ends up at 'feet' because they are not exactly H.

Maybe the complicated stuff makes sense to PHP programmers. I don’t know. It’s more likely that they don’t do these sorts of things, at least if they’ve read the advice in the PHP manual. Some people blame Perl since PHP inherited from Perl, but it seems like a yacc error that they can’t fix for backward compatibility. It’s not like that’s never happened to Perl

You setup the history feature by telling your shell to track the history. You want to remember 3,000 previous commands:

HISTFILE=/Users/brian/.bash_history
HISTFILESIZE=3000
HISTSIZE=1500

There’s much you can do with your command history, but that’s not what I’m covering here. The bash history cheat sheet explains most of it.

There are two ways you can get at the history. You can run the history command and pipe it to your Perl program as standard input, or you can read the history file (perhaps also piping it at standard input). The shell only writes to the file at the end of the session, so the file doesn’t know about recent commands. Also, each session merely appends to the file. Each session’s history is contiguous, so the file is not necessarily chronological. This doesn’t matter much to the challenge to find the overall popular commands.

Once you get the input, you have to figure out which part is the command. There are several issues there too. The first part of the line might be the command, a path to the command, or some sort of modifier for the command. A command line might have a pipeline of multiple commands or a series of separate commands. Some of the commands might be shell built-ins while others are external programs. Some commands might be user-defined aliases:

tail -f /var/log/system.log
/usr/bin/tail/ -f /var/log/system.log
sudo vi /etc/groups
history | perl -pe 's/\A\s*\d+\s*//'
grep ^_x /etc/passwd | cut -d : -f 1,5 | perl -C -Mutf8 -pe 's/:/ → /g'
(cd /git/dumbbench; git pull origin master)
perldoc -l SQL::Parser | xargs bbedit
export HISTFILESIZE=3000
l

This breaks the challenge into three parts, the last of which is basic accumulator stuff that we show Learning Perl for many tasks.

1. Get the history
2. Extract the commands
3. Count and report the results

I’ll cover each of those parts separately as I go through the answers.

Get the history

Most people opened a filehandle on the history file. Some people hard-coded the path while others made it relative to the home directory:

open( FILE, "/Users/me/.bash_history" );     # rm

my $hist_file = "$ENV{HOME}/.bash_history";  # jose
open my $hf, "<", $hist_file;

my $path    = $ENV{HOME};                    # Dave M
my $history = $path . '/' . '.bash_history';
open( my $f, '<', $history );

open HISTORY, $ENV{'HOME'}.'/.bash_history'  # ulric
  or die "Cannot open .bash_history: $!";

Daniel Keane was the only person to use zsh, which has a history format with timestamps (one of the issues I noted with the bash history):

my $history_path = "$ENV{'HOME'}/.zhistory";
die "Cannot locate file: $history_path" unless -e $history_path;
open(my $history_fh, '<', $history_path);

Neil Bowers used File::Slurp to get it all at once:

read_file($ENV{'HOME'}.'/.bash_history', chomp => 1);

Anonymous Coward set a default value for the history file but also allows people to override it with a command-line option:

my $histfile = "$ENV{HOME}/.bash_history";
my $position = 0;
my $number = 10;
GetOptions (
  'histfile=s' => \$histfile,
  'position=i' => \$position,
  'number=i'   => \$number,
);

A couple of people shelled out to run the history command. WK used history -r to add the history from the history file to the current history, then read the history from the command line:

  my @history = qx/$ENV{ SHELL } -i -c "history -r; history"/; # WX

Javier’s answer did much of the work in the shell and awk:

    my $get_cmds =
        qq/$ENV{'SHELL'} -i -c "history -r; history"/
        . q/ | awk '{for (i=2; i>NF; i++) printf $i " "; print $NF}'/;

    chomp(my @cmds = qx# $get_cmds #);

The two winners for getting the data, however, are the two people who provided one-liners. They used standard input, which means they could handle either a file in @ARGV or a pipe from history:

VINIAN might get a “Useless use of cat Award”, something Perl’s Randal Schwartz used to hand out. The -a switch (see perlrun splits on whitespace and puts the list in @F:

% cat ~/.bash_history | perl  -lane 'if ($F[0] eq "sudo"){$hash{$F[1]}++ } else { $hash{$F[0]}++ }; $count ++; END { @top = map {  [ $_, $hash{$_} ] } sort { $hash{$b}  <=> $hash{$a} } keys %hash; @max=@top[0..9]; printf("%10s%10d%10.2f%%\n", $_->[0], $_->[1], $_->[1]/$count*100) for @max}'

But, VINIAN’s program would work with a file argument, As Chris Fedde uses:

% perl -lanE '$sum{$F[0]}++; END{ say "$_ $sum{$_}" for (reverse sort {$sum{$a}  <=> $sum{$b}} keys %sum)}' ~/.bash_history | less

I would think that a better answer to this part would examine the environment variable for HISTFILE, but jose notes that it doesn’t work on cygwin. I did not investigate that.

Extract the commands

Extracting the commands is the tough part of the problem, but many people skipped most of that problem. They assumed the first group of non-whitespace was the command, possibly turning an absolute path to its basename.

jose used basename is the command started with a /:

$cmd = basename $cmd if $cmd and $cmd =~ /\//;

You don’t really need to check that though. You could just take the basename though, as Dave M did unconditionally:

my $basename = basename( $args[0] );

This ignores something that would be harder to solve; what if two different commands have the same name? For instance, the system perl and a user-installed one might have the same name. Either might be specified as just perl depending on the PATH, and the user-installed one might be a relative path. Most people counted the basename only.

Some people took the commands and checked that they were in the PATH:

    for my $p (@paths) {
        if ( -e "$p/$basename" ) {
            $words{$basename}++;
        }
    }

No one checked for symbolic links.

WK is the only person who translated aliases:

my %alias = get_aliases_hash();

sub get_aliases_hash {
  my @alias = qx/$ENV{'SHELL'} -i -c "alias"/;
  return map { m/\Aalias\s+(.+)='(.+)'\s*$/; $1 => $2 } @alias;
}

ulric and WK are the only people who didn’t count sudo by skipping it. Here’s how ulric did it:

  if ($commandline[0] =~ 'sudo') {
    shift @commandline;
  } # sudo is ignored as a metacommand

I think most people get fair marks for this part, but if I had to choose a winner, I’d go with WK.

Count and report the results

Once you have the commands, most people used the command as a hash key and adding one to the value. There’s not too much interesting there.

My Answer

My answer differs substantially only in the way that I examine the command line. I know about the Text::ParseWords module that can break up a line like the shell would. This is, it can break up a line while preserving quoting. I want to handle the shell special separators ; and | except when they are parts of quoted strings. The parse_lines can handle that:

;
my $delims = '(?:\s+|\||;)';
parse_line( $delims, 'delimiters', $_ );

The first argument is the regular expression I use to recognize a delimiter outside of a quoted string. I can’t rely on whitespace (although at first I tried), but the shell can handle things such as tail -f file|perl -pe '...' where the separator has no whitespace around it.

The second argument, if it is the special value delimiters, returns the delimiter string. I need to use this to recognize the start of new commands on the same line.

My program is long and not very fun, since I limit myself to the material in Learning Perl. Fun things such as splice only show up as “things we didn’t cover”. It’s in the Learning Perl Challenges GitHub repository with my other answers.

As well as keeping track of the commands, I track which ones were modified by other commands that I specify in %modifiers. I didn’t handle aliases or basenames like many other people did:

#!perl
use v5.10;
use strict;
use warnings;

use Text::ParseWords;

my %commands;
my %modifieds;

my $N = 10;

my %modifiers = map { $_, 1 } qw( sudo xargs );
my $delims = '(?:\s+|\||;)';

while( <> ) {
  my @shellwords    = 
    grep { defined && /\S/ }
    parse_line( $delims, 'delimiters', $_ );
  next unless @shellwords;

  my @start_indices = get_starts( @shellwords );

  # go through the shellwords to find the delimiters like ; and |
  # one command line can have multiple commands, so find all of 
  # them.
  I: foreach my $i ( 0 .. $#start_indices ) {
    my( $start, $end ) = ( 
      $start_indices[$i], 
      $i < $#start_indices ? $start_indices[$i+1] - 1 : $#shellwords
      );
    
    # look through a command group to find the the command
    my $modified = 0;
    J: foreach my $j ( $start .. $end ) {
      next if $shellwords[$j] =~ m/\A$delims\Z/;
      if( exists $modifiers{$shellwords[$j]} ) {
        $modified = $shellwords[$j];
        next;
        }
      if( $modified ) {
        $modifieds{"$modified $shellwords[$j]"}++;
        }
      $commands{$shellwords[$j]}++;
      last J;
      }
    }  
  }

say "------ Top commands";
report_top_ten( $N, %commands );

say "------ Top modified commands";
report_top_ten( $N, %modifieds );

sub get_starts {
  my @starts = 0;
  while ( my( $i, $value ) = each @_ ) {
    push @starts, $i if $value =~ /\A$delims\z/;
    }
  return @starts;
  }

sub report_top_ten {
  my( $top_count, %hash ) = @_;
  
  my @top_commands  = sort { $hash{$b} <=> $hash{$a} } keys %hash;
  my $max_width = length $hash{$top_commands[0]};
  while( my( $i, $value ) = each @top_commands ) {
    last if $i >= $top_count;
    printf '%*d %s' . "\n", $max_width, $hash{$top_commands[$i]}, $top_commands[$i];
    }
  }

And, with that, I find my top commands by reading from standard input and using my environment variable to locat the file:

$ perl history.pl $HISTFILE
------ Top commands
843 make
518 perl
364 ls
343 git
244 cd
156 bb
117 open
 68 pwd
 51 rm
 42 ssh
------ Top modified commands
3 xargs rm
2 xargs bbedit
2 xargs bb
1 xargs stripper
1 sudo cp

The bb is an alias for bbedit, the command-line program to do various things with that GUI editor. The stripper is a program I use to remove end-of-line whitespace. I most often use it with find, which is why it shows up after xargs.

That make comes mostly as make test, and the perl as perl Makefile.PL.

This challenge isn’t about counting so much as traversing, remembering, and displaying. How do you know what you need to handle next and which one was largest?

I’m actually writing my own version of this right now because I’m making some benchmarks on opendir versus glob and need some test cases. I could just create some new directories and make a bunch of fake files in them, but that’s no fun.

I don’t care how long your program takes, although you might. Let it run in a window (or screen) on its own. Test it on a small directory first (so, there’s a hint there).

I made a Curses version (but don’t look at it until you’ve tried your own solution!):

You can see a list of all Challenges and my summaries as well as the programs that I created and put in the Learning Perl Challenges GitHub repository.

During OSCON, you can get Randal’s Schwartz’s Learning Perl Video Series for $74.99 (50% off). This is the same class that Stonehenge presents to its corporate clients, based on Learning Perl (or, more correctly, the book is based on the class).

You can also get the Programming Perl ebook for $19.99 (50% the list price) when you buy it through the open source geeks promotion or by using offer code CFOSCON.

In bash, you can set the HISTFILE and HISTFILESIZE to control history‘s behavior. To get the commands to count, you can read the right file or shell out to the history command. From there, you have to decide how to split up each line to figure out what the command is. Can you handle commands with relative paths and absolute paths so you don’t count them separately?

This was an meme for a little while, and I wish I could find my answer to it. If you find my answer, please let me know.

You can see a list of all Challenges and my summaries as well as the programs that I created and put in the Learning Perl Challenges GitHub repository.

This time, I’ll send this book to someone who wants to replace their current Learning Perl or other beginning Perl book. Post a picture of yourself with the book you’d like to replace and link to this blog post, along with a short explanation why you need to replace your Perl book. The picture has to be available to anyone without logging in to any sort of account, and licensed under a share-alike agreement so I can repost my favorite photos. Don’t hide your picture in Facebook!

A photo that Schwern might submit if he wanted a free book

By the end of July, I’ll choose the picture that I like the most and send that person a free Learning Perl signed by me.

I might favor some items in your photo, and give even more favor to photos that combine those elements.

• Famous landmarks
• Bigfoot
• Scenery used in a movie (leaning toward New Zealand here)
• Very large beers
• Military matériel
• Llamas

Before I go through the posted solutions for the challenge, I’ll show you mine. It’s not at all impressive and not that efficient. It’s not even pretty, but this is the program I hacked up a long time ago to do this. I spend five minutes thinking about it, let it run, and moved on:

use File::Find;
use Digest::MD5;

find( \&wanted, grep { -e } @ARGV );

our %digests;
sub wanted {
  return if( -d $File::Find::name or -l $File::Find::name );
  my $fh;
  unless( open $fh, '<', $File::Find::name ) {
    warn "$File::Find::name: $!";
    return;
    }

  my $digest = Digest::MD5->new->addfile($fh)->hexdigest;
  
  $digests{$digest} .= "$File::Find::name\000";
  }

foreach my $digest ( keys %digests ) {
  my @files = split /\000/, $digests{$digest};
  next unless @files > 1;
  print join( "\n\t", @files ), "\n\n";
  }

As some people noted in their solutions, various digests have problems. We want a digest that is a short representation of content and is unlikely to be the same for different content. The chances of a “collision” depend on the algorithm as well as the number of times we try it. If we only digest one file, we never have a collision. If digest ten files, we expect a collision to be extremely rare. When (not if) we get to billions of files, weak algorithms will fail us. Since I don’t care that much, I use MD5. But, I’ve segregated all of those details in a subroutine, so I can easily change that.

Aside from that, this is essentially an exercise in file system traversal and hashes. However I decide to compare files, I need to store earlier results. I limit myself to the concepts in Learning Perl, so I don’t use an array reference as the value in %digests. Instead, I store all filenames in a single string by separating them with a null byte (\000). Later,
I split them again to get the list of files.

Since I’m writing a simple program, I merely report the duplicates as I find them. I want to inspect the files myself before I delete or move them.

My solution has problems. I have to wait for find to do its work before I start seeing a report of the duplicates. That’s rather annoying. However, when I use this, I usually don’t care how fast I get the results. It is a bit of ugly programming, but it works.

The solutions

Although people have their particular coding styles, there are three ways these programs can be conceptually different:

1. Finding the files
2. Digesting the files
3. Reporting the duplicates

Finding files

There are a few ways to find the files. The easiest is File::Find, which does a depth-first search by using a callback. It’s the easiest thing to start with, and many people did. It’s what I used.

Tudor makes his own recursive subroutine to get all the files out of a directory and its subdirectories, effectively reinventing File::Find:

sub _process_folder{
    my $folder_name = shift;

    foreach my $file_name ( glob  "$folder_name/*" ){
        #nothing to do if current, or parent directory
        next if $file_name ~~ [ qw/. ../ ];

        # $file_name might actually be a folder
        if ( -d $file_name ){
            _process_folder($file_name);
            next ;
        };

        my $file_content = read_file( $file_name, binmode => ':raw' );
        if ( defined($duplicate_files->{ md5_hex( $file_content ) }) ){
            push @{ $duplicate_files->{ md5_hex( $file_content ) } }, $file_name;
        } else {
            $duplicate_files->{ md5_hex( $file_content ) } = [ $file_name ];
        };
    }

    return;
}

Mr. Nicholas uses a glob to get all the files in the current working directory:

while (<*>) {
    push @{$data{md5_hex(read_file($_))}},$_ if -f $_;
}

I’d rather use glob if I wanted a list of files so I can save the angle brackets for reading lines. That’s what ulric did:

my @files=glob'*';

Eric used readdir, and gets all the files at once:

opendir DIR, $ARGV[0]
    or die "opendir error: $!";
my @files = readdir DIR;
my %fp;

The other solutions that don’t use File::Find only work with the current directory, which is what I specified for the basic parts of this problem. I’ll have to give no points to those solutions for this part—neither extra points or demerits. They pass, while other solutions did the extra parts to handle subdirectories.

Digesting files

On his first go, Anonymous Coward went for Digest, which handles many types of digests with the same interface. He went with SHA-256. On his first try, he hardcoded the digest and used a variable name tied to that particular digest:

    my $sha256 = Digest->new("SHA-256");
    if (open my $handle, $name) {
      $sha256->addfile($handle);
      my $digest = $sha256->hexdigest;

That hexdigest call is important, and one of the issues that I usually forget. The digest by itself is just a big number. To turn it into what I usually expect, a string of hexadecimal digits, I call the right method. The digest method returns a binary string. I could have used b64digest to get a Base-64 encoded version.

On his next go around, he moved those details higher in the program, making way for an eventual configuration outside the program:

my $algorithm = 'SHA-256';

        my $digest = Digest->new($algorithm);

Most people reached directly for either Digest::MD5 or Digest::SHA1, both which export functions for these:

Jack Maney put his digest details in a subroutine, which compartmentalizes them in a part the rest of the program doesn’t need to know about. If he wants to change the digest, he changes the subroutine:

sub compare_files
{
    my ($file1,$file2)=@_;
 
    if($line_by_line) #using File::Compare::compare
    {
        my $ret_val=eval{compare($file1,$file2)};
 
        die "File::Compare::compare encountered an error: " . $@ if $@;
 
        return 1 if $ret_val==0; #compare() returns 0 if the files are the same...
 
        return undef;
    }
    else #Otherwise, we use Digest::SHA1.
    {
        open(my $fh1,"< ",$file1) or die $!;
        open(my $fh2,"<",$file2) or die $!;
 
        my $sha1=Digest::SHA1->new;
 
        $sha1->addfile($fh1); #Reads file.
        my $hex1=$sha1->hexdigest; #40 byte hex string.
 
        $sha1->reset;
        $sha1->addfile($fh2);
        my $hex2=$sha1->hexdigest;
 
        close($fh1);
        close($fh2);
 
        return $hex1 eq $hex2;
    }
}

Tudor went for Digest::MD5, which exports md5_hex. I don’t particularly like this function because I always think it should take a filename. Tudor uses File::Slurp‘s read_file Instead I have to give it the actual file contents. Tudor has a bit of a problem because he does the computation twice for each file:

        my $file_content = read_file( $file_name, binmode => ':raw' );
        if ( defined($duplicate_files->{ md5_hex( $file_content ) }) ){
            push @{ $duplicate_files->{ md5_hex( $file_content ) } }, $file_name;
        } else {
            $duplicate_files->{ md5_hex( $file_content ) } = [ $file_name ];
        };

Ulrich does the same thing, but does the computation once and stores it in a variable:

  my $digest=md5_hex();
  if (exists $filehashes{$digest}) {
    $dupfree=0;
    push @{$filehashes{$digest}}, $file;
    print "duplicates detected: ";
    foreach $file (@{$filehashes{$digest}}) {
      print "$file  ";
    }

Instead of Digest::MD5, Gustavo used Digest::SHA1, which has a similar interface . He wraps it all up in a single statement:

    push @{$sha2files{sha1_hex(read_file($file))}}, $file;

Mr. Nicholas did the same with Digest::MD5:

    push @{$data{md5_hex(read_file($_))}},$_ if -f $_;

Javier used the object form of Digest::MD5 that takes a filehandle. He has a subroutine that just returns the digest:

sub get_hash($)
{
   open(FILE, $_);
   return Digest::MD5->new->addfile(*FILE)->hexdigest;
}

Eric also used the object form, but used the module directly in the statement:

    $fp{$_} = Digest::MD5->new->addfile(*FILE)->hexdigest;

The winner for this part of the problem would have to be a tie between Anonymous Coward setting up a flexible digest system and Javier for creating a short subroutine. Anonymous Coward comes out slightly ahead I think.

Finding duplicates

Finding the duplicates is the final part of the problem. Most answers did what Anonymous Coward did. When he computed a digest, he used it as the key in a hash, and made the value an array reference. In his first go, he uses the v5.14 feature that automatically dereferences the first argument to push:

      if (exists $duplicates{$digest}) {
        push $duplicates{$digest}, $name;
      } else {
        $duplicates{$digest} = [$name];
      }

Jack Maney used Set::Scalar to keep track of duplicates. He goes through the list of files and compares them with every other file in a double foreach loop, which is a lot of work. If the two files are the same, he looks through all the sets he’s stored so far looking for a set that already contains one of the filenames so he can add the new filename:

foreach my $file1(@files)
{
  foreach my $file2(@files)
  {
    next if $file1 eq $file2; #only comparing distinct pairs of files!

    if(compare_files($file1,$file2)) #If they're the same...
    {
      #first, see if $file1 is in any element of @duplicates.
      my $found=0; #flag to see if we found $file1 or $file2

      foreach my $set (@duplicates)
      {
        if($set->has($file1))
        {
          $set->insert($file2);
          $found=1;
          last;
        }
        elsif($set->has($file2))
        {
          $set->insert($file1);
          $found=1;
          last;
        }
      }

      unless($found) #If we didn't find $file1 or $file2 in @duplicates, add a new set!
      {
        push @duplicates,Set::Scalar->new($file1,$file2);
      }
    }
  }
}

There are some good ideas there, but I’d have to revert to references to improve it by keeping the sets as values in a hash where the key is the digest. However, I’m limiting myself to whatever we have in Learning Perl for my official solution. For my unofficial solution, I would have made a single pass over @files to digest it and another pass over %digests to report them:

foreach my $file ( @files ) {
  my $digest = get_digest( $file );
  $digests{$digest} = Set::Scalar->new 
    unless defined $digests{$digest};
  $digests{$digest}->insert( $file );
  }
  
foreach my $digest ( keys %digests ) {
  next unless $digests{$digest}->size > 1;
  my $dupes = $digests{$digest}->members;
  }

Most everyone did the same thing, so points go to Anonymous Coward for getting their first.

The results

I’m not assigning a winner to first part that involved finding files. Anonymous Coward wins the second part by setting up his digest to be flexible through Digest‘s interface. Anonymous Coward narrowly pips the other solutions for reporting the duplicates because he was first, since most people used a hash with array references for values.

Write a program that monitors a directory to find any file changes. Programs such as tripwire do this by recording meta information about a file on its first run then checking that the same information matches later. For instance, the size and SHA1 digest should stay the same. You could also just store the original content, but that’s not very convenient.

Since you’re at the Learning Perl level, we can’t ask too much here or judge you too harshly. A lot of the problem is storing the data and reading it later. Here’s a hint: create a flat file to store the “good” data on the first run, then read this file on the second run:

#name:size:SHA1
file.txt:1023:53a0935982ae11a4784d51aa696733c947c0614f

How are you going to handle the security on this file after you create it? As an example, you might look at CPAN::Checksums, which handles the same task for the modules on CPAN.

There are many ways that you can employ use this. You can run it periodically from cron, for instance, but you might also make a daemon that runs continually and is always checking. Once you find a change, you can report it in many ways, but we’ll only ask you to print a line to the terminal, that might look something like:

file.txt changed.

Was:
Size: 1023 bytes
SHA1: 53a0935982ae11a4784d51aa696733c947c0614f

Is now:
Size: 2001 bytes
SHA1: 730c6983bb9f942ef5cf6c174d76ad0c1594c1a7

You can see a list of all Challenges and my summaries as well as the programs that I created and put in the Learning Perl Challenges GitHub repository.