Ralph's TechBlog » Perl

Regular Expression for Email Addresses

Ralph — Tue, 02 Jun 2009 14:58:28 +0000

[-A-Z0-9._%+]+@[-A-Z0-9.]+\.[A-Z]{2,4}

Installing Bugzilla

Ralph — Wed, 20 May 2009 17:44:45 +0000

This was weird. I lately tried to install Bugzilla on one of my virtual hosts but it’s testserver.pl script failed with:

Use of uninitialized value in pattern match (m//) at ./testserver.pl line 110.
Use of uninitialized value in pattern match (m//) at ./testserver.pl line 110.
TEST-FAILED Webserver is not executing CGI files.

The Apache error log told nothing more than

Premature end of script headers: testagent.cgi

All Google lookups failed to solve my problem. Although I had the impression that my CGI setup was somehow wrong, I couldn’t find the reason. Then I intensively checked the VirtualHost directive. The server uses a Plesk 8.0 installation for setting up hosts. The default configuration for virtual hosts with CGI there is to include a “SuexecUserGroup” directive. After removing it, the Bugzilla installation succeeded.

So you might wanna give it a try

Scanning directories with Perl

Ralph — Tue, 27 Nov 2007 07:22:18 +0000

I often come across a task to do specific processing for each file at a subdirectory tree. Here is a skeleton code for what you need to get it started.

#!/usr/bin/perl
 
my $ROOTDIR = shift;
processDir($ROOTDIR);
 
exit 0;
 
# This is the main routine. Do not change it unless you know what you do!
sub processDir {
   my $dir = shift;
   my (@FILES, $entry, $path);
 
   if (opendir(DIRIN, $dir)) {
      @FILES = readdir(DIRIN);
      closedir(DIRIN);
 
      # iterate over dir entries
      foreach $entry (@FILES) {
         next if $entry eq '..';
         next if $entry eq '.';
         $path = "$dir/$entry";
 
         if (-f $path) {
            if (fileCheck($path)) {
               processFile($path);
            }
         } elsif (-d $path) {
            if (dirCheck($path)) {
               # recurse into subdir
               processDir($path);
            }
         }
      }
   }
}
 
# Do your file processing in this function only
# $file will have the complete path
sub processFile {
   my $file = shift;
}
 
# This function decides whether a file should be processed or not
# Return 1 when you want a file to be processed
# $file will have the complete path
sub fileCheck {
   my $file = shift;
   return 1;
}
 
# This function decides whether a directory should be searched recursively.
# Return 1 when you want the algorithm to steep into the directory.
# $dir will have the complete path
sub dirCheck {
   my $dir = shift;
   return 1;
}

You only will need to override lines 39-41. In case you don’t want to handle all files and directories, just make appropriate implementations in functions checkFile() and checkDir() respectively. This code works on all platforms.

Perl Message Logging

Ralph — Mon, 19 Nov 2007 10:04:26 +0000

The following code is a quick and dirty, but nevertheless usefull snippet to add logging facility to any perl script. You might want to add additional severities at lines 2-6, change the timestamp format at line 14, or enable logging into a file at lines 42-54.

# Defines severities of messages to log
my %TYPES = (
   ERROR => 1,
   DEBUG => 1,
   INFO  => 1
);
 
# Creates the time string for log messages
# Usage: getTimestring($unixTimeValue)
sub getTimestring {
   my $t = shift;
   $t = time if !$t;
   my @T = localtime($t);
   my $time = sprintf("%02d/%02d/%04d %02d:%02d:%02d",
              $T[3], $T[4]+1, $T[5]+1900, $T[2], $T[1], $T[0]);
   return $time;
}
 
# logs an error message
# Usage: logError($message);
sub logError {
   my $s = shift;
   logEntry($s, 'ERROR');
}
 
# logs an information message
# Usage: logInfo($message);
sub logInfo {
   my $s = shift;
   logEntry($s, 'INFO');
}
 
# logs a debug message
# Usage: logDebug($message);
sub logDebug {
   my $s = shift;
   logEntry($s, 'DEBUG');
}
 
# logs a single entry with given message severity
# Usage: logEntry($message, $severity);
sub logEntry {
   my $s = shift;
   my $type = shift;
   return if !$TYPES{$type};
 
   # build timestamp and string
   $type = rpad($type, 5);
   my $time = getTimestring();
   $s =~ s/\n/\n$time $type - /g;
 
   # print to STDOUT if required
   print "$time $type - $s\n";
}
 
# Right pads a string
# Usage: rpad($string, $maxlen[, $padchar]);
sub rpad {
   my $s = shift;
   my $len = shift;
   my $char = shift;
 
   $char = ' ' if !$char;
   $s .= $char while (length($s) <; $len);
   return $s;
}

URL Parameter Transforming

Ralph — Fri, 16 Nov 2007 13:48:10 +0000

Need to transform URL parameters and decode values such as “Hello%20World!”? Here is how:

Perl:

$s =~ s/%([\da-f][\da-f])/chr( hex($1) )/egi;

Java:

s = java.net.URLEncoder.encode(s, "UTF-8");

PHP:

$s = urldecode($s);