Browsing TagPerl

Making Persistent Data

This pair of routines will serialize and deserialize any Perl data. Useful when you have a piece of data that you want to pass accross 2 CGI applications since CGI don’t have persistent state.


sub _serialize {
   my ($self, $data) = @_;

   my $filename = "/tmp/TTS_$$.dat";

   sysopen(OUTFILE, $filename, O_RDWR|O_CREAT, 0666)
     or die ("Can't open $filename: $!");

   flock(OUTFILE, LOCK_EX)
     or die ("Can't lock $filename: $!");

   store($data, $filename)
     or die ("Can't store data structure: $!");

   flock( OUTFILE, LOCK_UN )
     or die ("Can't unlock $filename: $!");

   return $filename;
}

sub _deserialize {
   my ($self, $filename) = @_;

   sysopen(OUTFILE, $filename, O_RDWR|O_CREAT, 0666)
     or die ("Can't open $filename: $!");

   flock(OUTFILE, LOCK_EX)
     or die ("Can't lock $filename: $!");

   my $data = retrieve($filename)
     or die ("Can't retrieve $filename: $!");

   flock( OUTFILE, LOCK_UN )
     or die ("Can't unlock $filename: $!");

   return $data;
}

Use eval To Timeout a Section Of Code


eval {
    local $SIG{__DIE__} = "DEFAULT";
    local $SIG{ALRM} = sub { die "timeout" };

    # Tells OS to send alarm signal after 10 secs
    alarm(10);

    # your chunk of code that could time out
    while(1) {
        # do something
    }
};
alarm(0);
if ($@ =~ /timeout/) {
    print "Timed out";
} elsif ($@) {
    # some other error caught
}

# the rest of your code here

Note:

  1. Set the alarm inside the eval.
  2. Can’t use eq on $@ since it will contain something like “timeout at foo.pl line 10”. Have to use pattern.

How To Check If a Perl Module Exists

To quickly check if a certain module is installed in your environment, do this from the command line

perl -MModuleName -e 1

If the prompt comes back with no message, then the module exists. Otherwise, if it comes back with a “Can’t Locate…” message, it’s not available.

Cleanup Leading and Trailing Whitespaces

Here’s a regular expression to remove the leading and trailing whitespaces from a string:


$str =~ s/^s*//;    # remove leading whitespaces
$str =~ s/s*$//;    # remove trailing whitespaces

I have often seen this used to do the same thing:


$str =~ s/s*(.*?)s*$/$1/;

According to the book Mastering Regular Expressions by Jeffrey E.F. Friedl, this is slower. The reason he says is that “with each character, before allowing the dot to match, the ‘*?’ must try to see whether what follows can match. That’s a lot of backtracking, particularly since it’s the kind that goes in and out of the parenthesis.”

Output Logging Routine

This code will allow logging into a file and optionally, to the screen as well. This will create the file if necessary.


sub mlog {
    my ($msg) = @_;
    open (FH, ">> /tmp/logfile.log")
        or croak "error opening logfile: $!n";

    my $timestamp = localtime;
    print FH "$timestamp: $msgn";
    close FH;

    print "$timestamp: $msgn";    # also log to the screen
}

And to use this in your code:


mlog("This is a test log");