Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

Thursday January 26, 2006
02:45 PM

MakeMaker fun

Here at Yahoo! we have a very cool install system, yinst; handwaving all the details, it makes it really easy to manage a zillion servers and development machines.

To use it properly, you need to build packages according to its scheme, which doesn't match a standard CPAN distribution. I found myself repeatedly building the config files for the build, doing the build, transferring to our repository, and yesterday the idea hit me that I shouldn't be doing this; the build process should.

A quick look over the ExtUtils::MakeMaker docs showed me that it was actually trivial to add a section to the Makefile.PL to put my special build targets into the Makefile.

sub MY::postamble {
  return <<'MAKE_FRAG';
yman: *.3
        cd build && pod2man ../<MAIN PM FILE> > "../man/man3/<MAIN MODULE>.3"
 
yinst: *.yicf
        cd build && yinst_create -t release *.yicf
 
ydist: yman yinst *.tgz
        cd build && dist_install *.tgz
 
MAKE_FRAG
}

So now the Makefile has my targets in it. "Wait, wait," I hear you say. "What's all that stuff in the angle brackets?" That stuff is part 2 of my plan. In addition to the MakeMaker change, I put together a Module::Starter::Yahoo module that builds a base distribution modelled on the Module::Starter::PBP one, but with the added build directory and some extra mojo to build the Yahoo! build files.

So now I can do this to start up a new module:

module-starter --module=My::New::Module
And when my module's ready to distribute, I do this:
<ecode>
make
make test
make ydist

and poof, my module is built, tested, and distributed in proper format. And of course, if it's CPAN-able, I can just do a make dist instead and then upload to CPAN.

Since I based it on Module::Starter::PBP, I could also use the Perl -MModule::Starter::Yahoo=setup business to get this installed as my base Module::Starter config.

I did find that Module::Starter::PBP wasn't well set up to be subclassed, which meant I had to cut and paste the create_distro method into my code and modify it (it uses hard-coded path components in its File::Spec calls), but not a big deal.

Also, the templating philosohy used in this module is slanted toward "one module, one file" because it's used to build .pm and .t files. I needed to have all of the modules in the .yicf file, so a little fiddling about was necessary there as well. All in all, though, I'm quite happy with the time spent to save time later.

I still have to edit the prereqs into the .yicf file; possibly I should expand the make yinst target to parse Makefile.PL and pull the prereqs out automatically.

Monday November 21, 2005
05:31 PM

CPANTS Weakness

It does suck when you add another module to CPAN, with everything in place just perfectly except "someone else is using this" ... and this makes your score drop.

Sigh.

Monday August 08, 2005
10:40 AM

*gasp* Surfacing

Okay, so what I've been doing lately at least a couple of people saw at YAPC:

  1. Writing a class that uses Module::Pluggable to allow you to build command plugins for the debugger.
  2. Writing a wrapper class for WWW::Mechanize that allows you to write plugins to add functions to and modify the operation of Mech

The tricky bit here in both cases is doing it without touching the base code at all. If you're interested in the gory details, see Devel::Command and WWW::Mechanize::Pluggable on CPAN.

I'm currently looking at the possibility of extracting all the special-purpose code in WWW::Mechanize::Pluggable into a pair of base classes - Class::Pluggability and Class::Pluggability::Plugbase, so anybody can write a pluggable wrapper for any module whatsoever.

And this is actually part of my actual job - woo! I'm having fun.

Wednesday March 23, 2005
07:16 PM

Today's Mech trick

There's a batch of really gorgeous images released under the Creative Commons license at http://draves.org/pix/kdn/; the following code fetches all of them (slowly) at their maximum resolution.

Max resolution is big - 2 to 8 MB each. These are seriously detailed pictures. I added a 5-minute pause between fetches to be polite.

use strict;
use WWW::Mechanize;
my $mech = new WWW::Mechanize;
my $image_mech = new WWW::Mechanize;
my $base = "http://draves.org/pix/frame3.cgi?dir=kdn&file=acanthametra/big%20two%20spike%20 star%20copy.png&zoom=0";
 
my $current = $base;
$mech->get($current);
 
while (1) {
  my ($image) = (($mech->content) =~ /img .* src="([^"]+)/s);
  $image=~ s/ /%20/g;
  $image_mech->get("http://draves.org/pix/$image");
  print $image,"\n";
  my ($dir,$name) = ($image =~ m{^(.*/)(.*)$});
  system "mkdir -p $dir";
  open PIX, ">$image" or die "Can't open $image: $!";
  print PIX $image_mech->content;
  close PIX;
  sleep 300;
  $mech->follow_link('text'=>'next');
  last unless $mech->success;
}

Strictly utilitarian, but it gets the job done, and lets me have truly bizarro desktop graphics, thich is nice. I'm realizing that the 'next' link will probably crap out when it gets to the last page, but that's not a big deal since I want to stop at that point anyway.

Wednesday March 02, 2005
11:53 AM

Underpinnings

Well, I've got a basic command-line peal ringer working. It's stolen shamelessly from the Apple example code; I just pass a peal in from the command line and the code "rings" it via the built-in MIDI synth.

Minor nits: no ambience. A little reverb would be very classy. Possible to do, but I have to investigate the shipped-with-the-system AudioUnits a bit more to see if there's a really simple way to handle it.

A few more tweaks and I'll put it together as a .pkg file and let people try it out.

Thursday February 24, 2005
07:03 PM

From both ends to the middle

I've taken a typical Perl programmer approach to the OS X Long Now Chimes program I'm working on: do all the easy stuff first and then do the hard part.

Deep in the gut the application of course has to make noises. Turns out that the synthesis stuff is actually pretty simple: I can use Apple's provided-with-the-OS sample-playing MIDI synthesis AudioUnit to make noises (and since it's a sample player, making up a new soundbank lets me get away from just plain old General MIDI). I got the sample code working with a (fixed) arbitrary permutation of the chimes with no troble at all. Okay, I had a devil of a time trying to spot why my initializer was bad (one missing comma), but otherwise very easy.

Switching over to the other end, the user interface, Xcode makes the interface coding and design remarkably simple. I've gotten a nice interface that's almost complete in just a couple of hours of point-and-click.

Now all I need to do is shake out the interface a bit, hook up a stubbed-out permutation generator to the application, then drive the synthesis with that; we're coming right along.

When it gets to the permutation generator, I think I'm going to package it up as a C library; that way I can build TAP tests to see if it works (and recycle the ones that Sean has for his LongNowChimes CGI).

OS X coding is so much simpler than OS 9 and earlier that it isn't funny. It's actually enjoyable.

Wednesday February 23, 2005
05:50 PM

PerlObjCBridge fun fact

From James Duncan's blog:

As I wrote before, PerlObjCBridge is available in Mac OS X's system perl to provide a calling bridge between Perl, and Objective-C. It ships also with Foundation, which is Apple's fundamental elements of Cocoa library.

However, having access to Foundation doesn't buy you very much, but luckily everything you need to be able to load other frameworks is present.

The trick is using NSBundle to load the frameworks at run time.

  my $frameworkPath = NSString->stringWithCString('/path/to/a/framework');
  my $framework = NSBundle->alloc->init->initWithPath_($frameworkPath);
  $framework->load();

Once this has been done the classes in the framework are available to you, however, you need to perform one last bit of magic to really use them. You need to declare the class in Perl and have it inherit from PerlObjCBridge to have messages passed along.

  package NSWhatever;
 
  use base qw( PerlObjCBridge );

And hey presto! You should have access to the class you want.

I *think* this means I ought to be able to load the necessary Cocoa classes and CoreAudio into Perl, thereby getting a pretty GUI, the synthesis code, and being able to use Sean's chime code without having to change it.

Copied here so I don't have to look at the comment spam, which makes my eyes bleed.

04:51 PM

Descent into weirdness

So I've managed to avoid any real C programming until now. Then TorgoX dangles the carrot of "collaboration with Brian Eno" in front of me. Now I'm working on permutation code in C and busily learning Cocoa so I can put a pretty-pretty face on an app to play the Long Now chimes in OS X.

So far, I've adapted one of Apple's CoreAudio samples to play on particular permutation of the Long Now scale; now I need to translate the permutation algorithm into C.

Sometimes I can't decide if I'm a programmer who's obsessed with music or a musician who's obssessed with computers.

Monday January 24, 2005
05:35 PM

open

I love OS X's open command, which FreeBSD doesn't have; it allows me to be lazy on an unprecedented scale.

So I found Scott Lawrence's version, which was okay as far as it went, but I wanted to add Firefox support for .html files. Unfortunately Scott's version assumed that cmd args would work for anything, and firefox blah.html doesn't work as expected.

So the obvious right thing to do was fix his version so it would allow me to do arbitrary callbacks to generate the command string to execute. And since I was in there anyway, I decided to clean up the structure a little.

So here's a Perl version of open:

#!/usr/bin/perl
#
# 'open.pl'  v1.0
#
#   Fri Jan  3 14:36:57 EST 2003
#
#    a simple little script that makes migrating from OS X
#    back to solaris a little easier.
#
#  it checks each argument with the command "file" and then the
#  file extension to see if it knows what to do with it.
#
#  Version 1.1
#
#   Mon Jan 24 14:00:00 PST 2005
#
#    Extension to allow callbacks to return a command string.
#    Tested on FreeBSD. Cleaned up style.
 
# the result from running 'file' on the file
%filehash =
(
    'ascii text'                => ["$ENV{PAGER}"],
    'JPEG file'                 => ['xv'],
    'JPG file'                  => ['xv'],
    'tiff format image'         => ['xv'],
    'PBM ascii file'            => ['xv'],
    'PGM ascii file'            => ['xv'],
    'PPM ascii file'            => ['xv'],
    'PBM raw file'              => ['xv'],
    'PGM raw file'              => ['xv'],
    'PPM raw file'              => ['xv'],
    'TIFF file, big-endian'     => ['xv'],
    'TIFF file, little-endian'  => ['xv'],
    'GIF file, v87'             => ['xv'],
    'GIF file, v89'             => ['xv'],
    'IFF ILBM file'             => ['xv'],
    'PostScript document'       => ['gs'],
    'Adobe Portable Document Format (PDF) v1.0'         => ['acroread'],
    'Adobe Portable Document Format (PDF) v1.1'         => ['acroread'],
    'Adobe Portable Document Format (PDF) v1.2'         => ['acroread'],
    'HTML document text'  =>
       ['firefox',
        sub {
           my ($cmd, $arg) = @_;
           my $do = "$cmd file://".
           ($arg =~ m{^/}
               ? ""
               : `pwd`."/").
             "$arg";
           $do =~ s/\n//;
           $do;
        }
                             ],
);
 
# for "text" or "data":
%exthash =
(
    'txt'       => [$ENV{PAGER}],
    'pl'        => [$ENV{PAGER}],
    'cgi'       => [$ENV{PAGER}],
    'mp3'       => ["mpg123"],
    'pdf'       => ["acroread"],
    'ps'        => ["gs"],
);
 
$arg = "";
while(@ARG    $arg = shift;
 
    next if (!-e $arg);
    next if (-d $arg);
 
    # clean up 'file' type
    $result = `file $arg`;      # name:\ttype\n;
    $type= (split /:/, $result)[-1];
    $type =~ s/^\s+//g;
    $type =~ s/\s+$//g;
 
    # check the file hash
    if (defined $filehash{$type}) {
        call(\%filehash, $type, $arg) or sys(\%filehash, $type, $arg);
        next;
    }
 
    # check the extension hash
    $extension = (split /\./, $arg)[-1];
    if ( defined $exthash{$extension} ) {
        call(\%exthash, $type, $arg) or sys(\%filehash, $type, $arg);
        next;
    }
 
    # lose.
    print "Unknown type: $arg\n";
}
 
sub call {
  my ($hash, $key, $arg) = @_;
  my $callback = $hash->{$key}->[1];
  $callback and (system $callback->($hash->{$key}->[0], $arg) or 1);
}
 
sub sys {
  my ($hash, $type, $arg) = @_;
  system "$hash->{$type}->[0] $arg";
}

Obviously it could be refactored even further, but this is good enough to work with. An external file holding the extension definitions, or using the system MIME types, is an obvious direction.

Monday November 08, 2004
03:51 PM

blosmail.pl

My other weblog is Blosxom-based. I find I don't update it as often as I could/should, mostly because it's a pain to update - log in to the remote server, write the entry, save it ... it just loses the immediacy for me. I've tried a couple of the Bloxsom plugins to make it easier, but I haven't been happy with any of them.

I saw blosmail.pl go by on del.icio.us today. It's a little Perl script that parses a mail message and posts it to your Blosxom weblog. Immediately alarms began to go off - the EMUSIC-L weblog isn't exactly BoingBoing in terms of traffic, but I could just see my poor little weblog getting spammed up the wazoo. Okay, so there's a password-protection feature. You put the password in the mail and send it. This didn't strike me as a whole lot better - I wanted something that would be easy to do, but hard enough to crack that it really wouldn't be worth it.

So the following code code does an MD5 hash of the body of the message with a secret string stored on the server. If the hashes match, the post is accepted. At the moment, it still takes a little more work than I'd like: I have to run the message text through an external script and then paste the resultant hash back into the message. What this really wants is a drag-and-drop applet (probably doable with Platypus) or a full-fledged OS X service.

Anyway, here's blosmail-md5.pl.
Update: After seeing this happen to someone, I separated the blosmail config directory from the Blosxom data directory. (Yes, I did drop them a note.)

#!/usr/bin/perl -w
 
# blosmail
# Allows you to post (and modify) blosxom entries via email
# Version 0+1a
# DJ Adams June 2002
 
# See http://www.pipetree.com/testwiki/Blosmail
# Changes
# 0+1b fixed secret mechanism
# 0+1a added -secret parameter
# 0+1  original version
#
# Modified 8-Nov-2004 by Joe McMahon
# - folded in Doug Alcorn's 'category and title from subject' extension
# - added security via MD5 hash of content
 
use strict;
use File::Path;
use File::Temp qw/ tempfile /;
use FileHandle;
use CGI qw/:standard :debug/;
use Digest::MD5;
 
# --- Configurable variables -----
 
# Where are my blog entries kept?
my $datadir = "/Users/joe/blosxomdata";
my $configdir = "/Users/joe/blosmail_config";
 
# --------------------------------
 
$datadir = "$datadir/".param('-blog') if param('-blog');
my $fh = new FileHandle;
 
# Get the list of valid email addresses
my @validEmail = $fh->open("< $configdir/blosmail.dat") ? (<$fh>) : ();
chomp @validEmail;
 
# Read in whole mail and split into headers and body
my ($headers, $body);
{
  local $/ = undef;
  ($headers, $body) = split("\n\n", <STDIN>, 2);
}
 
# Check MD5 sums: combine the local copy of the password and the post text
# and sum them. Should match the sum that appears on the first line.
if (param('-sum')) {
  (my $incoming_sum, $body) = split(/\n/, $body, 2);
  chomp $incoming_sum;
  $fh->open("< $configdir/secret.dat") or die "No local secret\n";
  my $local_secret = <$fh>;
  chomp $local_secret;
  my $ctx = Digest::MD5->new();
  $ctx->add($local_secret.$body);
  my $local_sum = $ctx->hexdigest;
  die "Incorrect checksum" if $local_sum
   ne $incoming_sum;
}
 
# Check it's from a valid email address
my ($from) = $headers =~ /^From:\s.*?<([^>]+)>.*?$/m;
die "Entry from invalid email address" unless grep(/$from/, @validEmail);
 
# Determine filename and write entry
my ($category, $title) =
   ($headers =~ /^Subject:\s+BLOG\/([^\s]*)\s*(.*)$/m)
      ? ($1, $2)
      : "";
die "No title supplied\n" unless ($title);
 
unless (-d "$datadir/$category") {
    mkpath ("$datadir/$category", 0, 02775) or
        die "Can't create '$category' directory, $!\n";
}
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year +=1900;
$mon += 1;
my $filename;
($fh, $filename) = tempfile("${year}${mon}${mday}XXXXXX", SUFFIX => ".txt", DIR => "$datadir/$category", UNLINK => 0);
print $fh $title, "\n";
foreach my $line (split /\n/, $body) {
    last if ($line =~ /^--/);
    print $fh $line, "\n";
}
$fh->close;
 
chmod 0644, "$datadir/$filename";