use Perl

Just sharing some code to extend ExtUtils::MakeMaker.

I wanted two things: 1. apply the PM_FILTER on the EXE_FILES as well, 2. install a file in /etc.

After reading the documentation, looking at EU::MM source and numerous tries-and-errors, I ended up with the following sub which is, I think, generic enough to be reused by others:

sub MY::postamble {
    my ($mm, %args) = @_;
    my $postamble = "";

    # apply the filter to the EXE_FILES as well
    for my $exe (@{ $mm->{EXE_FILES} }) {
        my $old_rule = '$(CP) '.$exe.' $(INST_SCRIPT)/'.$exe;
        my $new_rule = '$(PM_FILTER) <'.$exe.' >$(INST_SCRIPT)/'.$exe;

        for my $makeline (@{ $mm->{RESULT} }) {
            $makeline =~ s/\Q$old_rule/$new_rule/;
        }
    }

    # add testcover target if available
    $postamble .= eval {
        require ExtUtils::MakeMaker::Coverage;
        ExtUtils::MakeMaker::Coverage::testcover();
    } || "";

    # install data files (in /etc, /usr/share, ...)
    # first, we must add a target in install::
    for my $makeline (@{ $mm->{RESULT} }) {
        $makeline =~ s/(install *::.+)\n/$1 priv_data_files\n/;
    }

    # then, declare the target with the files
    $postamble .= "\nINSTALL = install -D -p\n\npriv_data_files:\n";

    for my $file (@{ $args{files} }) {
        $postamble .= "\t\$(INSTALL) $file /$file\n";
    }

    return $postamble
}

The first code chunk is the part that applies the filter on the executables. I was afraid that replacing CP with the filter could have wrong consequences, so I have to read through the already rendered Makefile, stored in RESULT, in order to replace the good rules.

The second chunk manually add the testcover provided by Steve Peters' ExtUtils::MakeMaker::Coverage, as I'm redefining my own postamble().

The last chunk is the one that install generic data files. It expect files to have been passed to WriteMakefile() this way:

WriteMakefile(
    ...
    postamble => { files => [ ... ] },
    ...
);

Unless I've missed something, such features are not directly available in EU::MM or in a CPAN module. Do you people think these could be useful as modules?

sub Dumpbbcs
{
    my $css = $_[0];

    print "Content-Type: text/plain\n\n";

    foreach my $owner ( keys ( %{${${$CSSDUMP{CSSS}}{$css}}{OWNERS}} ) )
    {
        foreach my $content ( keys ( %{${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}} ) )
        {
            my $enable = ${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{ENABL E} if ( exists(${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content} }{ENABLE}) );
            foreach my $service ( keys (  %{${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{SER VICES}} ) )
            {
                my $ip = ${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{S ERVICES}}{$service}}{apSvcIPAddress} if ( exists(${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$cont ent}}{SERVICES}}{$service}}{apSvcIPAddress}) );
                my $state = ${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{S ERVICES}}{$service}}{apSvcState} if ( exists(${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$cont ent}}{SERVICES}}{$service}}{apSvcState}) );
                my $KALType = ${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{S ERVICES}}{$service}}{apSvcKALType} if ( exists(${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$cont ent}}{SERVICES}}{$service}}{apSvcKALType}) );
                my $SvcKALUri = ${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{S ERVICES}}{$service}}{apSvcKALUri} if ( exists(${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$cont ent}}{SERVICES}}{$service}}{apSvcKALUri}) );

                if ( defined($enable) && ($enable eq "enable") && defined($ip) && defined($state) && defined($KALType) && defined($SvcKALUri) )
                {
                    print "$owner $content $enable $service $ip DNS $state $KALType $SvcKALUri\n";
                }
            }
        }
    }
}

becomes:

sub Dumpbbcs {
    my ($css) = @_;
    my $owners = $CSSDUMP{CSSS}{$css}{OWNERS};

    print "Content-Type: text/plain\n\n";

    foreach my $owner (keys %$owners) {
        foreach my $content (keys %{ $owners->{$owner}{CONTENTS} }) {
            my $cont_fields = $owners->{$owner}{CONTENTS}{$content};
            my $enable      = $cont_fields->{ENABLE} || "";

            foreach my $service (keys %{ $cont_fields->{SERVICES} }) {
                my $serv_fields = $cont_fields->{SERVICES}{$service};

                my $ip          = $serv_fields->{apSvcIPAddress};
                my $state       = $serv_fields->{apSvcState};
                my $KALType     = $serv_fields->{apSvcKALType};
                my $SvcKALUri   = $serv_fields->{apSvcKALUri};

                if ($enable eq "enable" and all {defined} $ip, $state, $KALType, $SvcKALUri) {
                    print "$owner $content $enable $service $ip DNS $state $KALType $SvcKALUri\n";
                }
            }
        }
    }
}

(Ok, I cheated, I'm also using List::MoreUtils's all (this module rocks)).

Both functions should do exactly the same thing, except than the corrected form is actually readable and probably a lot faster given the number of opcodes such long dereference chains take (run perl -MO=Terse on these).

OTOH, these ${..} may be a technique obfuscators can use in the future ;-)

I just finished a strange project (provide a JSON/HTTP API to manage serial barcodes printers), and now must start a new one. This time it's about "improving" a CGI program that does network stuff.

What it does isn't as interesting as the current state of the program.

First, it has the classical strange things of old programs made by people learning Perl as they were writing it: it uses CGI.pm with the infamous :standard import, and yet has its own function for parsing CGI parameters. Funny fact: 10% of the program lines are print() with HTML tags.

The really funny thing is the parts of the program that update, store and retrieve data in a big structure. An exerpt looks like this:

%{${$PCSSDUMP{CSSS}}{$css}}=%{${$CSSDUMP{CSSS}}{$css}} if ( eval { $css =~ /$var/i } );
        foreach my $owner ( keys ( %{${${$CSSDUMP{CSSS}}{$css}}{OWNERS}} ) )
        {
            %{${${${$PCSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}=%{${${${$CSSDUMP{CSSS}}{$css}} {OWNERS}}{$owner}} if ( eval { $owner =~ /$var/i } );
            foreach my $content ( keys ( %{${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}} ) )
            {
                my $vip = ${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{IPADD RESS};
                %{${${${${${$PCSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}=%{${ ${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}} if ( eval { $content =~ /$var/i } );
                %{${${${${${$PCSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}=%{${ ${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}} if ( eval { $vip =~ /$var/i } );

(Here you can insert a rant about how the textarea to write journal entries really is too small.)

Well, I don't think I need to comment this, but there's a more than a few chunks like this one, with up to four nested foreach().

Maybe this is just proof that I did something really nasty in a previous life.

Many people don't like this subject, and their sole reaction is to replace each and every installation of old Perl with a recent one. Although I would like to be able to do this where I work, I can't. Therefore I have to deal with old Perl versions: 5.6, 5.005 and even 5.004.

For most of my work, it's not a big deal in fact, but when I have to use CPAN modules, I usually need to tweak them a little so they can work on these old Perls (and send on RT the corresponding patches). Recently, I sent one to Jesse Vincent regarding HTTP::Server::Simple . The main thing that bothered him was the fact that the patch removed the warnings pragma from the code.

Then I wondered once again why nobody had written an emulation module so that one can "use warnings" on Perl before 5.6. It's not that complex by using the $^W variable. Sure, it's not lexical and can't provide all the features the real pragma has, but it can be good enough for 90% of the modules out there.

Therefore I decided to JFDI and uploaded warnings-compat on the CPAN. It works on Perl 5.004_05, but I think it can even work on earlier Perls, probably even down to 5.000.