The Beast Remade: Deep magic with Storable::dclone

The cat/head/rm/ok commands posed some difficulties. My naive "ls" implementation refreshed its view of the quarantine section every time you ran it, as a normal "ls" would.

The underlying web interface happened to add any new spam that arrived in the meantime to the top of the numbered list. So a certain spam might be renumbered every time my hack looked at the index page. I certainly did not want the numbering to refresh between calls to "ls"; that could cause a quick "ls; cat 1; rm 1" sequence to delete the wrong mail!

Both the deletion form and the "view mail" links, thankfully, used mail queue id as identifier, not the 1-20 numbered list. Keeping a cached copy of the deletion form seemed wise, for later use in the "rm" command. But I also wanted to make further use of the WWW::Mechanize object, in order to get a look at the suspected spam, and avoid any issues with multiple logins kicking each other out or similar.

Storable::dclone is deep Perl magic, cloning an instantiated object and all its references, including internal state, functions and all. As such, it is not exactly lightweight or easy to wrap your head around. But it does exactly what I want in this case; it gives me a separate copy of the $mech WWW::Mechanize object to play around with that does not disturb the original:

unless (defined ($Storable::Deparse))
{ $Storable::Deparse = 1; }
unless (defined ($Storable::Eval ))
{ $Storable::Eval = 1; }
my $localmech = dclone($main::mech);

... and then $localmech is mine to do with as I like. Below is a complete example of use. It extracts the spam from its detail page, pretty-prints it to a string and returns.

# clone a $mech for viewing, keep
# the old around for the index page
sub grabmsg
{
my $spamindex = $_[0];

unless (defined ($Storable::Deparse))
  { $Storable::Deparse = 1; }
unless (defined ($Storable::Eval   ))
  { $Storable::Eval    = 1; }
my $localmech = dclone($main::mech);

$localmech->get($spam_viewurl[$spamindex]);
my $content = decode("utf-8",$localmech->content);

my $extractor = new HTML::TableExtract(
                 depth => 1, count => 1);
$extractor->parse($decoded);

my $spam = "";
my $table = $extractor->first_table_found();
my @headerlist = qw(Received: Return-Path: Date:
                    From: Reply-To: To: CC:
                    Subject: Attachments);

for (my $count = 0; $count<@headerlist; $count++)
{
  if (defined (my $cell = $table->cell($count,1)))
  {
    $spam .= color ('BOLD') . $headerlist[$count]
           . color ('RESET') . "\n" ;
    $spam .= "$cell\n" ;
  }
}
$spam .= color ('BOLD') . "Mail body:"
       . color ('RESET') . "\n" ;
$spam .= $table->cell(10,0) . "\n" ;

return $spam;
}