From RootdevWiki
Contents |
Misc perl snippets
- Perl absolute path validator
- Apache log parser
- Perl calendar test
- Test::More
- Perl search indexer scripts
- Perl search indexer scripts - 2
- Perl siterc parser
- Perl - find installed modules
- Perl - wide character problems
- Perl - test communitybuilders funding search
- Perl - log splitter
- Perl - remove random lines from file
- Perl - sort apache logfile quickly
- Perl - inherent looping - using -n or -p
- Perl - PLEAC
- Perl - procmail include line remover - eek
- Perl - create an index - of files and directorys in pwd
- Perl - search indexing - pdfs docs etc
- Perl - generate thumbnails - contrived stats example
- Perl - generate CAPTCHA-like images
- Perl - generate email address images
- Perl - create little calendars
- Perl - split files at 100 lines each
- Perl - url encode-decode
- Perl Cheatsheet
Find installed Perl modules
perl -ne 'print "$1\n" f /L<(.+)\|/' \ /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/perllocal.pod
Missing separator
When you get "missing separator" as you are installing perl modules, try:
export LANG=C
before continuing.
Find version numbers
>perl -le 'eval "require $ARGV[0]" and print $ARGV[0]->VERSION' CGI::Cache >1.40
or
>perl -MCGI -e 'print CGI->VERSION'
Inplace edit
(see Find for a real-life example).
#no backup perl -pi -e 's/disharmoniousness/pulchritudo/g' <filename> #backup called <filename>.bak perl -pi.bak -e 's/disharmoniousness/pulchritudo/g' <filename>
Invert the logic to remove matching lines from the file:
# -p flag prints in a virtual while loop - so use the -n to not print # and explicitly print when the pattern isn't matched: perl -ne '/^spingle$/?():print;' <filename>
Schwartzian Transform
@final = [
[ '12 Jan 2004', 'field','field','field']
],
[
[ '16 Jun 2005', 'field','field','field']
], etc....
];
my @sorted_fields =
map { $_->[1] } # grab the second item of our anon array
sort { Date::EzDate->new($b->[0]) <=> Date::EzDate->new($a->[0]) }
# reverse sort by date (ezDate)
map { [ $$_[0], $_ ] } # extract the first field (the date)
@final;
my @sorted_fields =
map { $_->[1] }
sort { Date::EzDate->new($b->[0]) <=> Date::EzDate->new($a->[0]) }
map { [ $$_[0], $_ ] }
@final;
Override CGI::SSI.pm
package CGI::SSI_SCO;
use CGI::SSI;
@CGI::SSI_SCO::ISA = qw(CGI::SSI);
sub include {
my($self,$type,$file_or_url) = @_;
#print $type;
my $ssi = CGI::SSI->new();
my $html;
$ssi->if($type eq "file");
$html = $ssi->include(file => $file_or_url);
$ssi->else();
## not sure if this works yet
# $html .= $ssi->include(file => $file_or_url);
$ssi->endif();
$html =~ s/\[an .* directive?\]/Oops - your include didn\'t/g;
return $html;
}
1;
use like...
use CGI::SSI_SCO; $ssi = new CGI::SSI_SCO; my $HTML_HEADER = $ssi->include(file => "$HTML_HEADER");
Modification time of file:
use File::stat;
$sb = stat($filename);
printf "File is %s, size is %s, perm %04o, mtime %s\n",
$filename, $sb->size, $sb->mode & 07777,
scalar localtime $sb->mtime;
Or shorty-shortcut:
find(
{ wanted => \&wanted, no_chdir => 1, },
$base,
);
sub wanted {
-f || return;
/^.*\.html\z/s || return;
for my $comp (@compiled) {
return if $_ =~ /$comp/;
}
my $mtime = (stat)[9];
process_file( $_, $mtime );
}
Dates
my @date = localtime(time);
my $year = $date[5] + 1900;
my $month = $date[4] + 1;
printf("%4d%02d", $year, $month);

