Maddingue's Journal http://use.perl.org/~Maddingue/journal/ Maddingue's use Perl Journal en-us use Perl; is Copyright 1998-2006, Chris Nandor. Stories, comments, journals, and other submissions posted on use Perl; are Copyright their respective owners. 2012-01-25T02:41:32+00:00 pudge pudge@perl.org Technology hourly 1 1970-01-01T00:00+00:00 Maddingue's Journal http://use.perl.org/images/topics/useperl.gif http://use.perl.org/~Maddingue/journal/ Extending ExtUtils::MakeMaker http://use.perl.org/~Maddingue/journal/34682?from=rss <p>Just sharing some code to extend <code>ExtUtils::MakeMaker</code>.</p><p>I wanted two things: 1. apply the <code>PM_FILTER</code> on the <code>EXE_FILES</code> as well, 2. install a file in<nobr> <wbr></nobr>/etc.</p><p>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:</p><blockquote><div><p> <tt>sub MY::postamble {<br>&nbsp; &nbsp; my ($mm, %args) = @_;<br>&nbsp; &nbsp; my $postamble = "";<br> <br>&nbsp; &nbsp; # apply the filter to the EXE_FILES as well<br>&nbsp; &nbsp; for my $exe (@{ $mm-&gt;{EXE_FILES} }) {<br>&nbsp; &nbsp; &nbsp; &nbsp; my $old_rule = '$(CP) '.$exe.' $(INST_SCRIPT)/'.$exe;<br>&nbsp; &nbsp; &nbsp; &nbsp; my $new_rule = '$(PM_FILTER) &lt;'.$exe.' &gt;$(INST_SCRIPT)/'.$exe;<br> <br>&nbsp; &nbsp; &nbsp; &nbsp; for my $makeline (@{ $mm-&gt;{RESULT} }) {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; $makeline =~ s/\Q$old_rule/$new_rule/;<br>&nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; # add testcover target if available<br>&nbsp; &nbsp; $postamble<nobr> <wbr></nobr>.= eval {<br>&nbsp; &nbsp; &nbsp; &nbsp; require ExtUtils::MakeMaker::Coverage;<br>&nbsp; &nbsp; &nbsp; &nbsp; ExtUtils::MakeMaker::Coverage::testcover();<br>&nbsp; &nbsp; } || "";<br> <br>&nbsp; &nbsp; # install data files (in<nobr> <wbr></nobr>/etc,<nobr> <wbr></nobr>/usr/share,<nobr> <wbr></nobr>...)<br>&nbsp; &nbsp; # first, we must add a target in install::<br>&nbsp; &nbsp; for my $makeline (@{ $mm-&gt;{RESULT} }) {<br>&nbsp; &nbsp; &nbsp; &nbsp; $makeline =~ s/(install *::.+)\n/$1 priv_data_files\n/;<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; # then, declare the target with the files<br>&nbsp; &nbsp; $postamble<nobr> <wbr></nobr>.= "\nINSTALL = install -D -p\n\npriv_data_files:\n";<br> <br>&nbsp; &nbsp; for my $file (@{ $args{files} }) {<br>&nbsp; &nbsp; &nbsp; &nbsp; $postamble<nobr> <wbr></nobr>.= "\t\$(INSTALL) $file<nobr> <wbr></nobr>/$file\n";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; return $postamble<br>}</tt></p></div> </blockquote><p>The first code chunk is the part that applies the filter on the executables. I was afraid that replacing <code>CP</code> with the filter could have wrong consequences, so I have to read through the already rendered <code>Makefile</code>, stored in <code>RESULT</code>, in order to replace the good rules.</p><p>The second chunk manually add the <code>testcover</code> provided by Steve Peters' <a href="http://search.cpan.org/dist/ExtUtils-MakeMaker-Coverage/">ExtUtils::MakeMaker::Coverage</a>, as I'm redefining my own <code>postamble()</code>.</p><p>The last chunk is the one that install generic data files. It expect files to have been passed to <code>WriteMakefile()</code> this way:</p><blockquote><div><p> <tt>WriteMakefile(<br>&nbsp; &nbsp;<nobr> <wbr></nobr>...<br>&nbsp; &nbsp; postamble =&gt; { files =&gt; [<nobr> <wbr></nobr>... ] },<br>&nbsp; &nbsp;<nobr> <wbr></nobr>...<br>);</tt></p></div> </blockquote><p>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?</p> Maddingue 2007-10-15T18:06:07+00:00 journal Temporary variables are good http://use.perl.org/~Maddingue/journal/34424?from=rss First step for understanding a complex code with very deep structures: remove useless brackets, add temporary variables.<blockquote><div><p> <tt>sub Dumpbbcs<br>{<br>&nbsp; &nbsp; my $css = $_[0];<br> <br>&nbsp; &nbsp; print "Content-Type: text/plain\n\n";<br> <br>&nbsp; &nbsp; foreach my $owner ( keys ( %{${${$CSSDUMP{CSSS}}{$css}}{OWNERS}} ) )<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; foreach my $content ( keys ( %{${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}} ) )<br>&nbsp; &nbsp; &nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $enable = ${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{ENAB<nobr>L<wbr></nobr> E} if ( exists(${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content<nobr>}<wbr></nobr> }{ENABLE}) );<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; foreach my $service ( keys (&nbsp; %{${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{SE<nobr>R<wbr></nobr> VICES}} ) )<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $ip = ${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{<nobr>S<wbr></nobr> ERVICES}}{$service}}{apSvcIPAddress} if ( exists(${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$con<nobr>t<wbr></nobr> ent}}{SERVICES}}{$service}}{apSvcIPAddress}) );<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $state = ${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{<nobr>S<wbr></nobr> ERVICES}}{$service}}{apSvcState} if ( exists(${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$con<nobr>t<wbr></nobr> ent}}{SERVICES}}{$service}}{apSvcState}) );<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $KALType = ${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{<nobr>S<wbr></nobr> ERVICES}}{$service}}{apSvcKALType} if ( exists(${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$con<nobr>t<wbr></nobr> ent}}{SERVICES}}{$service}}{apSvcKALType}) );<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $SvcKALUri = ${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{<nobr>S<wbr></nobr> ERVICES}}{$service}}{apSvcKALUri} if ( exists(${${${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$con<nobr>t<wbr></nobr> ent}}{SERVICES}}{$service}}{apSvcKALUri}) );<br> <br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; if ( defined($enable) &amp;&amp; ($enable eq "enable") &amp;&amp; defined($ip) &amp;&amp; defined($state) &amp;&amp; defined($KALType) &amp;&amp; defined($SvcKALUri) )<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; print "$owner $content $enable $service $ip DNS $state $KALType $SvcKALUri\n";<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; }<br>}</tt></p></div> </blockquote><p>becomes:</p><blockquote><div><p> <tt>sub Dumpbbcs {<br>&nbsp; &nbsp; my ($css) = @_;<br>&nbsp; &nbsp; my $owners = $CSSDUMP{CSSS}{$css}{OWNERS};<br> <br>&nbsp; &nbsp; print "Content-Type: text/plain\n\n";<br> <br>&nbsp; &nbsp; foreach my $owner (keys %$owners) {<br>&nbsp; &nbsp; &nbsp; &nbsp; foreach my $content (keys %{ $owners-&gt;{$owner}{CONTENTS} }) {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $cont_fields = $owners-&gt;{$owner}{CONTENTS}{$content};<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $enable&nbsp; &nbsp; &nbsp; = $cont_fields-&gt;{ENABLE} || "";<br> <br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; foreach my $service (keys %{ $cont_fields-&gt;{SERVICES} }) {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $serv_fields = $cont_fields-&gt;{SERVICES}{$service};<br> <br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $ip&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = $serv_fields-&gt;{apSvcIPAddress};<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $state&nbsp; &nbsp; &nbsp; &nbsp;= $serv_fields-&gt;{apSvcState};<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $KALType&nbsp; &nbsp; &nbsp;= $serv_fields-&gt;{apSvcKALType};<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $SvcKALUri&nbsp; &nbsp;= $serv_fields-&gt;{apSvcKALUri};<br> <br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; if ($enable eq "enable" and all {defined} $ip, $state, $KALType, $SvcKALUri) {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; print "$owner $content $enable $service $ip DNS $state $KALType $SvcKALUri\n";<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; }<br>}</tt></p></div> </blockquote><p>(Ok, I cheated, I'm also using <code>List::MoreUtils</code>'s <code>all</code> (this module rocks)).</p><p>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 <code>perl -MO=Terse</code> on these).</p><p>OTOH, these <code>${..}</code> may be a technique obfuscators can use in the future<nobr> <wbr></nobr><code>;-)</code> </p> Maddingue 2007-09-12T10:05:29+00:00 journal Perl Code from Hell http://use.perl.org/~Maddingue/journal/34416?from=rss <p>I just finished a strange project (provide a JSON/HTTP API to manage <a href="http://tls2200.com/">serial barcodes printers</a>), and now must start a new one. This time it's about "improving" a CGI program that does network stuff. </p><p>What it does isn't as interesting as the current state of the program. </p><p>First, it has the classical strange things of old programs made by people learning Perl as they were writing it: it uses <code>CGI.pm</code> with the infamous<nobr> <wbr></nobr><code>:standard</code> import, and yet has its own function for parsing CGI parameters. Funny fact: 10% of the program lines are <code>print()</code> with HTML tags. </p><p>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:</p><blockquote><div><p> <tt>%{${$PCSSDUMP{CSSS}}{$css}}=%{${$CSSDUMP{CSSS}}{$css}} if ( eval { $css =~<nobr> <wbr></nobr>/$var/i } );<br>&nbsp; &nbsp; &nbsp; &nbsp; foreach my $owner ( keys ( %{${${$CSSDUMP{CSSS}}{$css}}{OWNERS}} ) )<br>&nbsp; &nbsp; &nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; %{${${${$PCSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}=%{${${${$CSSDUMP{CSSS}}{$css}<nobr>}<wbr></nobr> {OWNERS}}{$owner}} if ( eval { $owner =~<nobr> <wbr></nobr>/$var/i } );<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; foreach my $content ( keys ( %{${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}} ) )<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; my $vip = ${${${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}{IPAD<nobr>D<wbr></nobr> RESS};<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; %{${${${${${$PCSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}=%{$<nobr>{<wbr></nobr> ${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}} if ( eval { $content =~<nobr> <wbr></nobr>/$var/i } );<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; %{${${${${${$PCSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}}=%{$<nobr>{<wbr></nobr> ${${${${$CSSDUMP{CSSS}}{$css}}{OWNERS}}{$owner}}{CONTENTS}}{$content}} if ( eval { $vip =~<nobr> <wbr></nobr>/$var/i } );</tt></p></div> </blockquote><p>(Here you can insert a rant about how the textarea to write journal entries really is too small.)</p><p>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 <code>foreach()</code>.</p><p>Maybe this is just proof that I did something really nasty in a previous life.</p> Maddingue 2007-09-11T13:17:25+00:00 journal Working with old Perls http://use.perl.org/~Maddingue/journal/31353?from=rss <p>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. </p><p>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 <a href="http://xrl.us/smtg">send on RT</a> the corresponding patches). Recently, I <a href="http://rt.cpan.org/Ticket/Display.html?id=21727">sent one</a> to Jesse Vincent regarding <code> <a href="http://search.cpan.org/dist/HTTP-Server-Simple/">HTTP::Server::Simple</a> </code>. The main thing that bothered him was the fact that the patch removed the warnings pragma from the code. </p><p>Then I wondered once again why nobody had written an emulation module so that one can <code>"use warnings"</code> on Perl before 5.6. It's not that complex by using the <code>$^W</code> 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. </p><p>Therefore I decided to JFDI and uploaded <a href="http://search.cpan.org/dist/warnings-compat/">warnings-compat</a> 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. </p> Maddingue 2006-10-18T23:26:15+00:00 journal