Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?

tuxz0r's scratchpad

by tuxz0r (Pilgrim)
on Oct 26, 2007 at 17:26 UTC ( #647441=scratchpad: print w/replies, xml ) Need Help??

Snippets worth re-working

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.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; } }

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"; }

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;

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;

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 ])
echo S 1 [ Y V U | perl -ane 'print reverse map { $_ = chr(ord($_)-1) } @F;'
Warning: Any code posted by tuxz0r is untested, unless otherwise stated, and is used at your own risk.

Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others cooling their heels in the Monastery: (8)
As of 2023-12-07 15:52 GMT
Find Nodes?
    Voting Booth?
    What's your preferred 'use VERSION' for new CPAN modules in 2023?

    Results (32 votes). Check out past polls.