The following set of examples has been used by me and my trainers in some of our Perl training courses. Many will find their way into the Perl Cookbook that should be out late this spring, so are necessarily copyrighted by me unless otherwise attributed. I post them here as a help, and a teaser. :-) --tom +---------------------------------------------------------+ | TASK: Change all isolated oldvar occurrences to newvar | +---------------------------------------------------------+ perl -i.old -pe 's{\boldvar\b}{newvar}g' *.[chy] +---------------------------------------------------+ | TASK: Increment all numbers found in these files | +---------------------------------------------------+ perl i.tiny -pe 's/(\d+)/ 1 + $1 /ge' file1 file2 .... +------------------------------------------------------------+ | TASK: Binary edit (careful: only on binary-clean systems) | +------------------------------------------------------------+ perl -i.bak -pe 's/Mozilla/Slopoke/g' /usr/local/bin/netscape +--------------------------------------------------+ | TASK: Delete all but lines beween START and END | +--------------------------------------------------+ perl -i.old -ne 'print unless /^START$/ .. /^END$/' foo.txt +------------------------------+ | TASK: Delete first 10 lines | +------------------------------+ perl -i.old -ne 'print unless 1 .. 10' foo.txt +-------------------------------------+ | TASK: Counting with the wc program | +-------------------------------------+ $count = `wc -l < $file`; die "wc failed: $?" if $?; chomp($count); # or simply chomp($count = `wc -l < $file`); +-----------------------------------------------+ | TASK: Counting lines with a counter variable | +-----------------------------------------------+ open(FILE, $file) || die "can't open $file: $!"; $count = 0; $count++ while ; +----------------------------------------------------+ | TASK: Counting paragraphs with a counter variable | +----------------------------------------------------+ $/ = ''; # enable paragraph mode for all reads open(FILE, $file) || die "can't open $file: $!"; $paracount = 0; $paracount++ while ; +-------------------------------+ | TASK: Counting lines with $. | +-------------------------------+ open(FILE, $file) || die "can't open $file: $!"; (undef) = ; # discard all input lines # $. now holds the number of lines read. +------------------------------------+ | TASK: Counting paragraphs with $. | +------------------------------------+ open(FILE, $file) || die "can't open $file: $!"; $/ = ''; (undef) = ; # discard all input lines # $. now holds the number of paragraphs read. +----------------------------------------+ | TASK: Reverse the whole file by lines | +----------------------------------------+ perl -e 'print reverse <>' file1 file2 file3 .... +---------------------------------------------+ | TASK: Reverse the whole file by paragraphs | +---------------------------------------------+ perl -00 -e 'print reverse <>' file1 file2 file3 .... +-----------------------------------------------------+ | TASK: Show each line with its characters backwards | +-----------------------------------------------------+ perl -nle 'print scalar reverse $_' file1 file2 file3 .... +------------------------------------+ | TASK: Reverse all bytes in a file | +------------------------------------+ perl -0777e 'print scalar reverse <>' file1 file2 file3 .... +----------------------------------------------+ | TASK: Print the last 50 lines (expensively) | +----------------------------------------------+ perl -e '@lines = <>; print @lines[$#lines .. $#lines-50]' file1 file2 file3 .... +-------------------------------------------+ | TASK: Print the first 50 lines (cheaply) | +-------------------------------------------+ perl -pe 'exit if $. > 50' file1 file2 file3 .... +--------------------------+ | TASK: Using clearerr() | +--------------------------+ $naptime = 1; use IO::Seekable; # new in 5.004; before then, it's in POSIX open (LOGFILE, "/tmp/logfile") || die "can't open /tmp/logfile: $!"; for (;;) { while () { print } # or appropriate processing sleep $naptime; LOGFILE->clearerr(); # clear stdio error flag } +------------------------------------------+ | TASK: Seeking 0 bytes forward from here | +------------------------------------------+ # if you don't have IO::Seekable, instead of clearerr(), try seek(LOGFILE, 0, 1); +------------------------------------+ | TASK: Seek to where you last read | +------------------------------------+ for (;;) { for ($curpos = tell(LOGFILE); ; $curpos = tell(LOGFILE)) { # process $_ here } sleep $naptime; seek(LOGFILE, $curpos, 0); # seek to where we had been } +----------------------------------+ | TASK: Update a number in a file | +----------------------------------+ use Fcntl qw(:DEFAULT :flock); sysopen(FH, "numfile", O_RDWR|O_CREAT, 0644) || die "can't open numfile: $!"; flock(FH, LOCK_EX) || die "can't write-lock numfile: $!"; $num = || 0; seek(FH, 0, 0) || die "can't rewind numfile : $!"; truncate(FH, 0) || die "can't truncate numfile: $!"; (print FH $num+1, "\n") || die "can't write numfile: $!"; close FH || die "can't close numfile: $!"; +------------------------------------------------+ | TASK: Lock file with warning about contention | +------------------------------------------------+ unless (flock(FH, LOCK_EX|LOCK_NB) ) { warn "can't immediately write-lock numfile ($!), blocking..."; unless (flock(FH, LOCK_EX) ) { die "can't get read-lock on numfile: $!"; } } +-----------------------------------+ | TASK: Replacement for fortune(1) | +-----------------------------------+ $/ = "\n%%\n"; $data = '/usr/share/games/fortunes'; srand; rand($.) < 1 && ($adage = $_) while <>; print $adage; +-----------------------------------------+ | TASK: tailwtmp -- watch for new logins | +-----------------------------------------+ $typedef = 's x2 i A12 A4 l A8 A16 l'; # linux format $sizeof = length pack($typedef, () ); open(WTMP, '/var/log/wtmp') || die "can't open /var/log/wtmp: $!"; use IO::File; seek(WTMP, 0, SEEK_END); for (;;) { while (read(WTMP, $buffer, $sizeof) == $sizeof) { ($type, $pid, $line, $id, $time, $user, $host, $addr) = unpack($typedef, $buffer); next unless $user && ord($user) && $time; printf "%1d %-8s %-12s %2s %-24s %-16s %5d %08x\n", $type,$user,$line,$id,scalar(localtime($time)), $host,$pid,$addr; } for ($size = -s WTMP; $size == -s WTMP; sleep 1) {} WTMP->clearerr(); } +------------------------+ | TASK: Print All Files | +------------------------+ @ARGV = qw(.) unless @ARGV; use File::Find; find sub { print $File::Find::name, -d && '/', "\n" }, @ARGV; +-------------------------------+ | TASK: Find Size of Directory | +-------------------------------+ use File::Find; @ARGV = ('.') unless @ARGV; my $sum = 0; find sub { $sum += -s }, @ARGV; print "@ARGV contains $sum bytes\n"; +--------------------------+ | TASK: Find Largest File | +--------------------------+ use File::Find; @ARGV = ('.') unless @ARGV; my ($saved_size, $saved_name) = (-1, ''); sub biggest { return unless -s > $saved_size; $saved_size = -s _; $saved_name = $File::Find::name; } find(\&biggest, @ARGV); print "Biggest file $saved_name in @ARGV is $saved_size bytes long.\n"; +---------------------------+ | TASK: Find Youngest File | +---------------------------+ use File::Find; @ARGV = ('.') unless @ARGV; my ($age, $name); sub youngest { return if defined $age && $age > -M; $age = (stat(_))[9]; $name = $File::Find::name; } find(\&youngest, @ARGV); print "$name " . scalar(localtime($age)) . "\n"; +-------------------------+ | TASK: List Directories | +-------------------------+ #!/usr/bin/perl -lw @ARGV = qw(.) unless @ARGV; use File::Find (); sub find(&@) { &File::Find::find } *name = \*File::Find::name; find { print $name if -d } @ARGV; +-------------------------------------------------+ | TASK: Lowercase all filename in this directory | +-------------------------------------------------+ opendir(DOT, ".") || die "can't opendir .: $!"; foreach $old (grep /[A-Z]/, readdir(DOT)) { if (($new = lc($old)) ne $old) { rename($old, $new) || die "can't rename $old to $new: $!"; } } closedir(DOT); +--------------------------------------+ | TASK: Rename Many Files Arbitrarily | +--------------------------------------+ # rename program by Larry Wall $op = shift or die "Usage: rename expr [files]\n"; chomp(@ARGV = ) unless @ARGV; for (@ARGV) { $was = $_; eval $op; die $@ if $@; rename($was,$_) unless $was eq $_; } +---------------------------------------------------+ | TASK: Get all files, sorted, and with full paths | +---------------------------------------------------+ @files = map { "$path/$_" } sort readdir(DIR); +----------------------------------+ | TASK: Get just C++ source files | +----------------------------------+ @files = grep { /\.(C|cxx|c\+\+)$/ } readdir(DIR); +----------------------------------+ | TASK: Just one user's dotfiles | +----------------------------------+ use User::pwent; $path = getpwnam($some_user)->dir; opendir(DIR, $path); @files = grep { /^\./ && !/^\.\.?$/ } readdir(DIR); +---------------------------------------+ | TASK: Directories with numeric names | +---------------------------------------+ # just directories (short names) @dirs = grep { -d "$path/$_" } readdir(DIR); # return full paths of directories @dirs = grep { -d } map { "$path/$_" } grep { /^\d+$/ } readdir(DIR); # same, but sorted numerically @dirs = map { $_->[1] } # extract pathnames sort { $a->[0] <=> $b->[0] } # sort names numeric grep { -d $_->[1] } # path is a dir map { [ $_, "$path/$_" ] } # form (name, path) grep { /^\d+$/ } # just numerics readdir(DIR); # all files +----------------------------------+ | TASK: Backdate a file by a week | +----------------------------------+ $SECONDS_PER_DAY = 60 * 60 * 24; ($atime, $mtime) = (stat($file))[8,9]; $atime -= 7 * $SECONDS_PER_DAY; $mtime -= 7 * $SECONDS_PER_DAY; utime($atime, $mtime, $file) || die "couldn't backdate $file by a week w/ utime: $!"; +------------------------------------------+ | TASK: Edit a file without "touching" it | +------------------------------------------+ ($atime, $mtime) = (stat($file))[8,9]; system($ENV{EDITOR} || "vi", $file); utime($atime, $mtime, $file) || die "couldn't restore $file to orig times: $!"; +------------------------------------------+ | TASK: locate non-executable text files | +------------------------------------------+ local *DIR; # new handle, lest we recurse $dir = "/usr/bin"; chdir($dir) || die "can't cd to $dir: $!"; opendir(DIR, ".") || die "can't opendir $path: $!"; while (defined($file = )) { if (-f && ! -x _ && -T) { print "$dir/$path\n"; } } +---------------------------------------------------------+ | TASK: Use Dirhandle to get non-dot plain files, sorted | +---------------------------------------------------------+ use DirHandle; my $dh = DirHandle->new($dir) || die "can't opendir $dir: $!"; @names = sort # sort pathnames grep { -f } # choose only "plain" files map { "$dir/$_" } # create full paths grep { !/^\./ } # filter out dot files $dh->read(); # read all entries -- Tom Christiansen tchrist@jhereg.perl.com "It is easier to port a shell than a shell script." --Larry Wall