Archive for April, 2003
VIN Decoder
Posted by: | CommentsVehicle Identification Number (VIN) encodes information about a car, such as the maker, model, where it was made, and as to what number car is it to roll out of the manufacturer’s floor for that year. And here’s the url for it: http://www.analogx.com/contents/vinview.htm
Making Persistent Data
Posted by: | CommentsThis 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
Posted by: | Commentseval { 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 }; alarm(0); if ($@ =~ /timeout/) { print "Timed out"; } elsif ($@) { # some other error caught } # the rest of your code here
Note:
- Set the alarm inside the eval.
- 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
Posted by: | CommentsTo 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
Posted by: | CommentsHere’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
Posted by: | CommentsThis 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: $msg\n"; close FH; print "$timestamp: $msg\n"; # also log to the screen }
And to use this in your code:
mlog("This is a test log");