Some of these are my snippets that I've posted in response to certain problems on the forum, some are others snippets that I thought interesting and worth looking at later. Maybe I'll get around to making these snippets usable somewhere, but then again, maybe not.

Remove Duplicate File Names excluding Extension: This snippet will remove duplicate named files in the same directory (e.g. foo.txt, foo.bar, foo.dat) saving the one with an extension matching the second argument. It also recuses into subdirectories performing the same operation.

my $working_dir = $ARGV[0];     # starting directory
my $extension   = $ARGV[1];     # extension to save

dedup($working_dir);
exit 0;

sub dedup {
    my $path = shift;
    my @files = glob("$path/*");
    print "Checking [$path] ...\n";

    foreach (@files) {
        dedup("$_") if (-d $_ && -x $_);        # recurse into subdire
+ctories
        my ($base, $ext) = m/(.*)\.([^\.]+)$/;

        my @matches = glob("$base*");
        print "\tremoving: $_\n" if scalar @matches > 1 && $ext ne $ex
+tension;
#       unlink $_              if scalar @matches > 1 && $ext ne $exte
+nsion;
    }
}
[download]

Pivoting: Transposing rows and columns in a text file.

my @data;
while (<>) {
   my @fields = split ' ';
   my $col = $. - 1;
   for my $row (0..$#fields) {
      $data[$row][$col] = $fields[$row];
   }
}
foreach my $row (@data) {
        foreach (0 .. $#$row) {
                print $$row[$_];
        }
        print "\n";
}
[download]

Fork Multiple Children and Wait - this is a usual template for having a parent process fork off multiple children and wait for them all to die.

use POSIX ":sys_wait_h";

my %kids = ();

# Signal Handler for SIGCHLD
sub sigchld_handler{
    while (($pid = waitpid(-1, &WNOHANG)) > 0) {
        delete $kids{$pid};
    }
    $SIG{CHLD} = \&sigchld_handler;
}
$SIG{CHLD} = \&sigchld_handler;

# You can repeat this for as many secondary
# processes as you need to merge the old indexes
for (1..3) {
        if (my $pid = fork) {
            # Parent Process keep track of forked children
            $kids{$pid} = 1;
        }
        else {
            # Child process
            # ... do merging of old indexes here
            sleep(3);
            exit 0;   # MUST EXIT HERE
        }
}

while (keys %kids > 0) {
     sleep(1);  # wait for all children to finish
}
exit 0;
[download]

Unique Values from List Playing around with some ways to get a unique set of values from an array.

# Straight forward way (sort keys slows down the larger the list)
my %hash = map { $_ => 1 } @items;
my @uniq = sort keys %hash;

# Using List::MoreUtils::uniq()
use List::MoreUtils qw(uniq);
my @uniq = uniq(@items);

# This is the method under the hood in List::MoreUtils::uniq
my %h;
my @uniq = map { $h{$_}++ == 0 ? $_ : () } @items;
[download]

M4/Autoconf Macro for checking for Perl Modules - I've used this at work with various Perl distributions for some batch systems

# AC_CHECK_PM
#----------------------------------------------------------
AC_DEFUN([AC_CHECK_PM],[
AC_MSG_CHECKING([for module $1])
if `perl -M$1 -e '' >/dev/null 2>&1` ; then
        AC_MSG_RESULT([yes])
else
        AC_MSG_RESULT([no])
        AC_MSG_ERROR([missing perl module $1, not in @INC])
fi;dnl
])
[download]