Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

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

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?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
[Corion]: And the second rule that I've learned is, that there is no one-off job, so writing a program for it pays off almost immediately. The third rule is to give all my programs numbers and have them reproduce that number in the name of their output files. :)
[Discipulus]: the true part is that also specification change between years.. but well our job is cheap but dont abuse of us.. ;=)
[LanX]: Choroba: do you miss chaos with ties? apply at the US government.. ;)
[ambrus]: Corion: those are good rules.
[ambrus]: Discipulus: oh sure. the input data has different filenames every time I get them.
[ambrus]: the directory structure may be 1, 2, or 3 deep, it may have spaces in the filename or not, it has dates in various format, different keywords for the same meanings, and the dates and other keywords are assembled in various ways.
[Discipulus]: no ambrus by specification i mean for example license per core instead of per socket, so fields are different

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (14)
As of 2017-03-29 12:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Should Pluto Get Its Planethood Back?



    Results (350 votes). Check out past polls.