Modules that I've written are available on CPAN. http://search.cpan.org/~tobeya/.
GR.pm Perl & MySQL Presentation
I gave a presentation on MySQL and perl at the Grand Rapids Perl Mongers meeting on 07/27/2006. The first link is a PDF of the handout I passed around.
Auto-generating classes:
I like to auto-generate classes. This seems a bit masochistic, since there are a bajillion modules on CPAN to help with this, but it's so easy once you "get it," that I believe it's better to roll your own.
The following example is untested, but if you look at my Nagios::Object module on CPAN or the libraries for PAGE, you'll see this strategy in use.
package Foo::Bar;
my %class = (
member1 => [ 'some', 'meta', 'data' ],
member2 => [ 'more', 'meta', 'data' ]
);
# will get run very early, but after BEGIN
foreach my $member ( keys %class ) {
my $get_method = __PACKAGE__ . '::get_' . $member;
my $set_method = __PACKAGE__ . '::set_' . $member;
# generate a real subroutine with a closure around $member
*{$get_method} = sub {
my $self = shift;
return $self->{$member};
};
*{$set_method} = sub {
my $self = shift;
$self->{$member} = shift;
};
}
sub new {
my( $this, %args ) = @_;
# get the class name, but allow new() to be called on existing objects
my $class = ref($this) || $this;
my $self = bless {}, $class;
$self->{member1} = $args{member1};
$self->{member2} = $args{member2};
return $self;
}
Now, you could use AUTOLOAD to do the same thing, but at run time. AUTOLOAD is nice, but it is only called after searching the entire object heirarchy, and does not allow UNIVERSAL::can() to work. There are workarounds for both problems, but I prefer to just get it all fixed up right at the beginning. That %classes variable also comes in quite handy throughout the module, with it's metadata.
Stupid map trick:
Taking two arrays with the same number of elements and putting them into
a hash in one line with the first array's values as keys and the second's as values.
Don't put this in code somebody else might have to maintain without a comment or you'll get slapped.
#!/usr/bin/perl
my @foo = qw( a b c d e f g );
my @bar = qw( h i j k l m n );
# here is the evil
my %combined = map { $bar[$_] => $foo[$_] } 0..$#foo;
foreach my $key ( keys(%combined) ) {
print "$key => $combined{$key}\n";
}
-------------------------------
tobeya >perl /tmp/test.pl
l => e
n => g
k => d
h => a
m => f
j => c
i => b
This was really useful because I was parsing the output of a unix tool which had known field names (i.e. vmstat(8)). I hard-coded the field names, then mapped the output of the command against the field name array into a hash. Very useful in my line of work.
Matt Diephouse from Grand Rapids Perl Mongers corrected me with something I missed in perldoc perldata. Here is another way to do the same thing, although I still like the map better - call me lazy, but I prefer to declare and assign my variables in one line. For some reason, this version feels less elegant to me, but is probably more intuitive at a glance.
#!/usr/bin/perl
use strict; # this is the rub
my @foo = qw( a b c d e f g );
my @bar = qw( h i j k l m n );
#%combined = map { $bar[$_] => $foo[$_] } 0..$#foo;
my %combined = (); # trying to my @combined will break at compile-time
@combined{@foo} = (@bar);
foreach my $key ( keys(%combined) ) {
print "$key => $combined{$key}\n";
}
Vgetty.pm script to get pins and pass them to another program:
vgetty, part of the mgetty+sendfax package is a daemon that is capable of communicating
with voice modems. Not all voice modems are created equal, so make sure to check the
list of supported modems in the mgetty package. I'm currently using the ZyXEL U-1496E in
production, which works perfectly. I did this all a long time ago, but it appears I pulled
a newer version of Vgetty.pm from CPAN (RCS/CVS v1.4). Set "call_program" in
/etc/mgetty+sendfax/voice.conf to call this script instead of the default dtmf.sh.
Email me if you have any questions and I'll try my best to answer.
#!/usr/local/bin/perl -w
$|++;
use strict;
use lib qw( /etc/mgetty+sendfax/lib );
use Modem::Vgetty;
use Time::HiRes qw( sleep );
use vars qw( $v $dtmf $done $timeout $logfile @tones $client_program );
#######################################################################
$done = 0; # loop control #
$dtmf = ''; # a string to collect tones #
$timeout = CORE::time() + 30; # wait a maximum of 30 seconds #
$logfile = "/var/adm/gettones.log"; # logfile path & filename #
$client_program = "/usr/local/bin/foo" # call program with dtmf tones #
#######################################################################
open( LOG, ">>$logfile" )
|| die "could not open logfile: $!";
$v = new Modem::Vgetty;
$v->add_handler( 'BUSY_TONE', 'finish', \&finish );
$v->add_handler( 'SILENCE_DETECTED', 'finish', \&finish );
$v->add_handler( 'RECEIVED_DTMF', 'dtmf_in', \&dtmf_event_in );
$v->add_handler( 'UNKNOWN_EVENT', 'uevent', \&unknown_event_in );
sub finish {
$_[0]->stop();
$::done = 1;
}
sub unknown_event_in {
print LOG "received UNKNOWN_EVENT: ", $_[1], "\n";
}
sub dtmf_event_in {
my $self = shift;
my $cmd = shift;
my $tone = shift;
if ( $tone eq '#' ) {
$self->stop;
$done = 1;
return;
}
else {
$dtmf .= $tone;
}
push( @tones, $tone );
}
CORE::sleep( 2 );
$v->beep( 2000, 150 );
$v->waitfor('READY');
sleep( 0.010 );
$v->beep( 2000, 150 );
$v->waitfor('READY');
sleep( 0.010 );
$v->beep( 2000, 150 );
$v->waitfor('READY');
$v->stop();
$SIG{ALRM} = sub {
system( "$client_program ERROR" );
die "TIMEOUT";
};
alarm(15);
$v->enable_events;
$v->waitfor('READY');
$v->wait(10);
while ( $done == 0 && time() < $timeout ) {
$v->waitfor('READY');
last if ( $done != 0 );
$v->wait(1);
}
$v->stop;
$v->del_handler( 'RECEIVED_DTMF', 'dtmf_event' );
alarm(0);
$dtmf =~ s/[^0-9]//g; # just in case, remove everything that's not a digit
print LOG join("\n", @tones), "\nTIME: ", time(), "\n";
close( LOG );
# call a script that will fork from this program and proceed to send
# out the alphanumeric page.
system( "$client_program $dtmf" );
exit 0;
Perl Asynchronous Graph Executor
Here are a couple images generated by Graphviz showing a couple graphs that it runs in production every day.
 |
 |
