Aprendiendo Perl, el reto: Encontrar duplicados

[Dmitriy Ryajov]

Aquí esta mi versión. No hago uso de File::Find si no, utilizo opendir y 
readdir directamente, esto para propósitos ilustrativos.

Esta versión, recorre (recursivamente) una lista de directorios que se 
pasa como argumento o utiliza el directorio actual, desde donde se 
ejecuto el script.

<==============================================================>

#!/usr/bin/env perl
use strict;
use warnings;

use Digest::MD5;
use Cwd;

my @directories = (); # list of scanned directories

my @dirs = @ARGV;
@dirs = ( getcwd ) unless scalar @dirs;

for my $dir ( @dirs ) {
     scan_dir( $dir );
}

for my $dir_struct ( @directories ) {
      print "Found duplicates in directory $dir_struct->{name}\n";
      print "File: $_\n" for @{$dir_struct->{files}};
}

sub scan_dir {
     my $directory = shift;

     $directory =~ s|/?$||g; # remove trailing /

     # open dir for scanning
     opendir my $dh, $directory or
         print "Error opening dir: $directory\n$!" &&
         return; # don't die, we just want to skip this dir

     my $dir_struct = {
                         name    => $directory,  # name of the scanned dir
                         files   => [],          # list of scanned files
                     };

     my %dup_files = ();
     for my $file ( readdir( $dh ) ) {

         next if $file =~ /^\.{1,2}$/; # skip current and parrent dir

         $file = "$directory/$file"; # fix up file name to full path
         if( -d $file ) {            # recurse if it's a directory
             scan_dir($file);
             next;
         }

         next if !-r $file; # skip non readble files

         my $checksum = chekcsum( $file );
         if ( !$dup_files{$checksum} ) {
             $dup_files{$checksum} = $file;
             next;
         }

         push @{$dir_struct->{files}}, $file;
     }

     # store it for later use
     push @directories, $dir_struct if scalar @{$dir_struct->{files}};
}

sub chekcsum {
     open( my $fh, '<', shift ) or die $!;
     binmode($fh);
     return Digest::MD5->new->addfile($fh)->hexdigest;
}

<==============================================================>

Saludos,
Dmitriy Ryajov.

On 03/27/2012 09:15 AM, Marcelo wrote:
> Hola,
>
> brian d foy[0] comenzó a publicar en http://www.learning-perl.com/ una
> serie de retos para la gente aprendiendo Perl.  Pensé que para alguna
> gente podría ser útil tener el reto disponible en Español y no en
> Inglés, además de poder conversar sobre las soluciones también en
> Español.  Hasta que no monte otra cosa, les propongo hacerlo mediante
> esta lista, si alguno tiene interés.
>
> A continuación la traducción del post que brian publicó en
> http://www.learning-perl.com/?p=286
>
> ------------------------------ 8<  ------------------------------
>
> Este es el segundo reto para novatos.  Voy a darles un problema que
> deberían poder resolver solo con las cosas presentes en "Learning
> Perl" (incluyendo el uso de módulos, es decir, la mayoría de Perl).
> Más o menos una semana después publicaré una solución (NdT: me
> comprometo a traducir las soluciones también).
>
> Para este reto, dado un único directorio conteniendo archivos
> posiblemente duplicados, encuentre los archivos que pueden ser
> duplicados.  Solo debe imprimir los archivos duplicados e imprimir sus
> nombres.  Si desea remover los duplicados, ¡asegúrese de tener un
> backup!
>
> Existen algunos módulos que pueden resultar útiles:
>
>      Digest::MD5
>      Digest::SHA1
>
> Si se encuentra especialmente motivado, busque también en los
> subdirectorios que encuentre.
>
> ------------------------------>8 ------------------------------
>
> Saludos y que se diviertan,
>
> Marcelo
>
> PS: Como pueden ver en el blog de Learning Perl, la gente que quiere
> recibir retroalimentación publica sus soluciones allí.  Sería
> buenísimo si la gente por acá hiciese lo mismo y los demás les den
> opiniones.
>
> [0] brian es coautor de "Learning Perl" en su última edición.  Él
> prefiere escribir su nombre así como aparece acá, no estoy siendo
> perezoso con las mayúsculas :-)
> __
> Costarica-pm at pm.org
> http://mail.pm.org/mailman/listinfo/costarica-pm