1. accept() an incoming connection
2. do some magic to get another socket
3. start passing bit between the two sockets
4. perform a correct close down sequence

An example use case of this is a proxy implementing the HTTP CONNECT method, but in for some known hostnames it will log a message and mangle the hostname before proceeding. This has been used as a legacy fall back solution while changing a network setup. But my uses are not restricted to HTTP proxies I have done the same for a few legacy protocols where the magic has been of different complexities.

The two final steps are quite general and it would be nice to have a module doing just that. Take two sockets and make it easy (or even automatic) to pass bytes between them.

The naïve non-blocking solution would use a scalar string buffer for each direction and perform a select loop while maintaining the write vector depending on which buffers contain data. I have written this code multiple times. In development this is usually quite successful, in production less so. While Perl might be quite suited for the magic in step 2, the naïve way of passing bytes have quite an overhead for the buffer management.

A less naïve way would use a array of strings for buffers, but I’m not quite sure if this would be a win in all cases. You might be able to get away with some string operations on the read side of the buffer, but it might be more expensive on the write side. I have not benchmarked this.

Most of the time I don’t care about Perl level IO handles. I know that there is a real C level file descriptor beneath. So an even better POSIX compliant solution might be to use XS to have plain C strings and use readv()/writev() and a iovec structure as buffer.

Can we do even better? At least on Linux we can. With the Linux splice() specific system call it is possible to us a pipe as buffer and never to have to copy data from and to user space.

I have not been able to find any off the shelf solution on CPAN. So I think I need to write it myself, but what would the nice and general API be? I guess the basic interface would be something like:

    my $chain = IO::Splice->new($fh1, $fh2);

    $chain->pump(); # read and write from both handles if possible and needed
    $chain->read($fh1);  # read to buffer from one specific handle
    $chain->write($fh2); # write from buffer to one specific handle
    $chain->can_write(); # returns the handles it needs to write to

but it might be simpler to have two callbacks for setting a file handle in write or no-write state:

    my $readset  = IO::Select->new( $fh1, $fh2);
    my $writeset = IO::Select->new();
    my $chain = IO::Splice->new( $fh1, $fh2,
        writable => sub {  $writeset->add( shift ) },
        unwritable => sub { $writeset->remove( shift ) }
    );

    while ( ... select ... ) {
        $chain->pump();
    }

As said, I think I have plenty of implementations of the naïve way but before releasing some code it would be nice to get some input on the API. But the best feedback would be a module that already have a usable API but might not implement the Linux specific way. That would allow me to steal the interface…

One option would be to take the long road and port these apps to use Plack instead of messing around with Apache2::RequestRec. For this to work you might need to review the full code base before seeing any signs of progress.

Another option is to mock your Apache2::RequestRec object using Plack. This is the road explored by Plack::App::WrapApacheReq. With very little work this enables you to run your mod_perl application with any Plack handler you want. You can run your application as a stand alone server or serve it with nginx trough FastCGI.

But the fun doesn’t stop here. Debugging and profiling mod_perl have always been a PITA, but with Plack::App::WrapApacheReq it is easy. Just take the generic.psgi example and it enables you to run the Perl debugger easy or just to use NYTProf on your request handling code.

The initial ideas for writing Plack::App::WrapApacheRec came from my mocking code to test a legacy mod_perl application. Even this gets more fun by using Plack. I havn’t tested it yet, but with Plack::Test and Plack::Test::ExternalServer it should be trivial to run the same set of tests directly in a single process test suite or against your deployed server.

Plack::App::WrapApacheRec is still in it’s infancy. It only mocks as much of Apache2::RequestRec as I need to run a single legacy application and to run Plack::Handler::Apache2 (as an absurd example, but yes we are self hosting). But I think that with very little work we should be able to run most mod_perl applications. Take it out for a ride, if it complains about a missing method please report it with CPAN’s RequestTracker. Patches would be appreciated (or pull requests on github), but just a list of unimplemented method you need would be excellent.

Plack is fun, now working with mod_perl applications might become fun too.

Instead of getting the RSS feed from a URL, my RSS reader can run a script that prints an RSS feed. So if I could just write a script that does the OAuth dance to convince twitter.com to give me an RSS feed?

Perl to the rescue! Or rather CPAN to the rescue: Net::Twitter::Lite have a nice simple example for setting up OAuth with a desktop application. It also provides access to most of Twitters REST API, but no method for retrieving generic URLs.

Using some Jedi mind tricks and reading the source I found a private and undocumented method _oauth_authenticated_request which does exactly what I need. It is quite simple:

1. Get my script from gist.github.com/585710 and install the dependencies (Net::Twitter:Lite).
2. Register you own app at dev.twitter.com to get a Consumer Key and Consumer Secret.
3. Run the script once to setup access and get an Access Token and Access Token Secret.
4. Run the script with an RSS feed url as parameter to get the RSS feeds.

Most interesting feed to follow is probably http://api.twitter.com/1/statuses/home_timeline.atom, which show the same as the home page on twitter.com would show you, and http://api.twitter.com/1/statuses/mentions.atom, which shows any tweet that mentions you.

How can I refuse. So here it is, Benchmark::Serialize is just uploaded to CPAN. (Might be some time before it appears).

Besides making the script into a module I also added a list of the size of the serialized data to the output. A replacement of the original script is available in the examples directory.

(I planned on naming the module Benchmark::Serialization, but my fingers slipped. Should I rename it?)

To benchmark all three solutions I used a variant of CPANDB::Dependecy::csv():

sub csv {
    my $class = shift;
    for my $edge ( $class->select ) {
        my $foo = $edge->distribution . "\t" . $edge->dependency . "\n";
    }
}

My::Plain->begin;
My::Unsliced->begin;
My::SelfSlice->begin;

cmpthese( -30, {
    plain => sub { csv("My::Plain::Dependency") },
    unsliced => sub { csv("My::Unsliced::Dependency") },
    selfslice => sub { csv("My::SelfSlice::Dependency") },
});

Unfortunately it seems like both having DBI doing the slicing and doing it myself costs roughly the same:

            Rate selfslice     plain  unsliced
selfslice 1.61/s        --       -1%      -41%
plain     1.64/s        2%        --      -40%
unsliced  2.71/s       68%       66%        --

So I probably end up making some sort of ORLite subclass as Adam Kennedy suggested in a comment.

Sorted by inclusive time (ie. including time spent in subroutines) two non-XS functions stood out: selectall_arrayref and fetchall_arrayref. Looking a the code both of these functions had a comment stating that a C implementation existed in Drivers.xst and the comment at selectall_arrayref further said that the Perl version is used as a fallback if a slice is given

So could I get away with the slicing?

Turned out to quite easy. Just use array refs as objects instead of the usual hash refs.

The run time of the select() method provided by ORLite went from 344µs/call to 162µs/call on average. And as my test data makes at roughly 100000 select() calls this is a quite noticeable speedup. All included my running time (under Devel::NYTProf) improved from 400 seconds to 340 seconds.

Unfortunately I have to be able to update the state of my ORLite generated objects. This was easy while the objects was blessed has refs. Array refs are not as easy to update. The easy solution was to make the simple non-fk accessors to be lvalue subroutines.

My colleague needed it to be served from the same Apache server as the rest of his webapplication. Some tiny changes and my stand alone server was transformed into a plain CGI script. When we going to deploy the script I’m guessing we make some tiny changes and have it running as a mod_perl module.

Try it for you next project! Even if you usually just use CGI.pm.

Wouldn’t it be much nicer just to be able to write:

sub foo :Private {
    ...
}

You can, with my brand new Sub::Private module. It is actually quite simple:

use Attribute::Handlers;

use namespace::clean     qw();
use B::Hooks::EndOfScope qw(on_scope_end);
use Sub::Identify        qw(get_code_info);

sub UNIVERSAL::Private :ATTR(CODE,BEGIN) {
    my ($package, $symbol, $referent, $attr, $data) = @_;

    on_scope_end {
        namespace::clean->clean_subroutines( get_code_info( $referent ) );
    }
}

Putting the attribute handler in the UNIVERSAL namespace isn’t nice. I have to find a solution for that for the next version.

• Either you could set the screens up as separate entities in xorg.conf, which means separate workspaces but not being able to move windows from one screen to the other
• or you set it up as one big virtual screen with you workspace spanning both screens.

I like workspaces and use them a lot on my primary screen, but on my secondary screen I mostly want my browser and my instant messaging (IRC). Some solves this by making the windows on the secondary screen sticky, so the appears on every workspace. That doesn’t work for me – I still want my worksapces on the secondary screen, I just want the workspaces to behave separately from the workspaces on the primary screen.

For a long time I thought this impossible, so I used the first option with separate entries in my xorg.conf. I havn’t really missed moving windows from screen to screen, but Firefox is a bother. I want to be able to have Firefox windows on both screen without having to keep two profiles in sync.

Awesome3 to the rescue. I finally upgraded my window manager to awesome3 and after using xrandr to configure my screes, awesome works out of the box as I need. X only provides one display, which means that I can move windows freely around and Firefox can open windows on both screens, but Awesome automatically gives me separated workspaces on the two screens.

Of course I had do make some changes in the standard configuration for awesome. Other menus, click to focus (remove the awful.hooks.mouse_enter.register call), enforce floating layout with a proper window placement (some changes in the awful.hooks.manage.register call). View my configuration on GitHub Gists.

Slides are available at http://hacking.dk/talks/yapceu2009/ – There is a pretty regexp validating dates (including February 29th) in it!

for i in $HOME/.lib.sh/* ; do
    source $i
done

This has at least one obvious downside. Each time I change a function definition I have to reload the function i each and every open shell if I want a consistent work environment. Today I came up with a nifty solution. Each file in ~/.lib.sh which previously contained a function definition isedited to only contain the function body. The I add the following new function called load_functions:

FUNCTIONS=$HOME/.lib.sh

eval $(
    find $FUNCTIONS -type f | \
        while read file ; do echo function $(basename $file)\(\) { source $file\; }\; ; done
)

For each file under ~/.lib.sh a new function is automatically defined which just sources the real file. This means I can edit the files without having to reload the function in every open shell. ~/.lib.sh/load_files itself is just sourced from my .bashrc.

One of my functions wraps the wonderful Perl5 module local::lib. This module makes it easy to manage multiple sandboxes with locally installed Perl modules. It works by setting a couple of environment variables including $PERL5LIB. Instead of using local::lib directly I used a function called perllibs:

# Defaults:
PERL_LOCAL_LIB="home"
DIR=$HOME/.perl

if [ -n "$1" ]; then
    PERL_LOCAL_LIB=$1
fi

export PERL_LOCAL_LIB

case $PERL_LOCAL_LIB in
    alpha)
        DIR=$HOME/projects/alpha/ ;;
    mercury)
        DIR=$HOME/subversion/mercury/perl ;;
    tmp)
        mkdir -p /tmp/makholm/perl
        DIR=/tmp/makholm/perl ;;
esac

eval $( perl -Mlocal::lib=$DIR )

Adding new projects to this list would be a hassle if I had to reload the file in multiple shells each time.

One thing I wanted to play with was debugging from my editor. It is probably posible to write in vim-perl scripts, but having easy access to all the internals without language barriers made the task of writing a debugger plugin much easier and more importantly, much more fun.

So if you have ever thought about nice features you wanted while editing Perl, then please join the Padre project and keep hacking perl while improving you tools.

    $_->store() for @objects;

and quite often it actually works. But suddenly a piece of code doing this in a loop broke with this error message: Can’t call method “store” without a package or object reference. And quite right, sometimes @objects would contain plain integers.

Unfortunately it wouldn’t be quite easy to track down the relevant change, so enter the perl debugger. Declaring a watch on ‘@objects’ isn’t useful as it triggers each time @objects enters or leaves scope. But saving a reference to @objects in $my::objects and the watching $my::objects->[0] worked.

I had reimplemented the store() method using Data::Walk for walking some structure instead of doing it by hand. And Data::Walk sets $_ to the current node. A due to the aliasing implied in the for-modifier each element in my @objects array was garbled.

Two solutions: The store() method can localize $_ by adding local $_; before using Data::Walk – this works in legacy perl interpreters. The routine looping through @objects can make $_ a lexical variable by adding my $_; before the loop – This is a new feature in Perl 5.10.

An even more robust solution would be to have Data::Walk localize $_ itself AND use a lexical $_ in code where $_ is aliased to important data. See RT #47309.

The major update is how the interpreter is called. Now it will actually find the modules you are using, if you add the correct directories to ‘Edit -> Preferences -> Run Paramerters’

But running Devel::NYTProf on my code showed that an awful lot of time was spend in the YAML code. Changing a few lines to use Storable instead showed an improvement in speed going from 1000s to 200s for my test data. This is a significant win even while developing, but of course I shouldn’t have used the old YAML-implementation to begin with.

Mentioning this to the local Perl Mongers group I got referred to a benchmark of different serialization modules by Christian Hansen (I think). I’ve updated the script and the interesting part is that JSON::XS outruns Storable on both tests.

Thank you Devel::NYTProf for showing me that 80% of my run time was spent in old pure perl serialization code.

Try this script:

#!/usr/bin/perl

package Foo;

sub new {
    my $class = shift;
    open my $fh, "-|", "cat /dev/zero";
    return bless { fh => $fh }, $class;
}

sub DESTROY {
    my $self = shift;
    close $self->{fh}
}

package main;

my $foo = Foo->new();
exit 42;

You would expect it to return with status code 42, but when I run it the status code is 13. Localizing $? in the DESTROY() method gives the expected 42 status code.

The most common usage of $? is explained in the perlvar manual page:

The status returned by the last pipe close, backtick (““”) command, successful call to wait() or waitpid(), or from the system() operator.

And the above destructor makes a ‘pipe close’ changing the value of $?. But the perlvar manual also mentions an secondary usage of $?:

Inside an “END” subroutine $? contains the value that is going to be given to “exit()”. You can modify $? in an “END” subroutine to change the exit status of your program.

But this doesn’t just holds for END block, it is true for any code run after the exit() invokation – including destructors.

And then to a mystery. Given the above Foo package it isn’t very surprising that this script have the status code 13:

use Foo;
my $foo = Foo->new();

But why does the following change make the script have the status code 0?

use Foo;
my $foo = Foo->new();
$? = 42;

Some time ago I had to parse parts of the WebDAV protocol. WebDAV properties are transmitted using XML with namespaces, which is one thing I think XML::Simple is particular bad for. So I turned to XML::LibXML (which is becoming my XML module of choice either way).

So, the WebDAV RFC have examples like this:

     <?xml version="1.0" encoding="utf-8" ?>
     <D:propfind xmlns:D="DAV:">

       <D:prop xmlns:R="http://ns.example.com/boxschema/">
         <R:bigbox/>
         <R:author/>
         <R:DingALing/>
         <R:Random/>
       </D:prop>

     </D:propfind>

Unfortunately XML::LibXML insists on namespace URI’s to conform to the URI specification, which DAV: doesn’t. Due to XML::LibXML’s perfection I’m not able to just use it. Solution:

sub escapeNamespace {
    $_[0] =~ s/(xmlns(?::\w+)?)="(?!urn|http)([^"]+)"/$1="urn:xxx:$2"/g;
    $_[0] =~ s/(xmlns(?::\w+)?)=""/$1="urn:xxx:nonamespace"/g;
}

I’m not quite sure that the second substitution is needed by the standard, but the Litmus webdav test suite needs it…

If I were to publish a paper with such a gaping hole like that, it would never be taken serious. In each test, he’s generating a random number and a random character and storing the result! That’s not part of the test. The $needles should each be generated outside the timing loop. This is adding tons of additional instructions that are not considered part of the test. These results are basically useless and should be redone.

After doing his test, Jason concludes: “Those results are astonishing!”. Yes, it clearly shows that the grep solutions are 25% faster than using first. This is astonishing and surprising — and probably warrants an explanation.

Jason’s methodology consists of generating a single random array and needle for each piece of code he wants to benchmark. Running his benchmark on my machine shows that first is 15 times faster than smart match and about 28 times faster than grep. Of course, my random arrays might have been more biased against ‘first’ and randomly placing the needle at the start.

So Jason’s test are not to be taken seriously either. Even when benchmarking with random data, we have to benchmark all our code pieces against the same data and not just on one data set.

Update: I’ve been running some more benchmarks in the background. It seems that the general pattern is that ‘first’ from List::Util and any from List::MoreUtils is about 25% slower than grep, but with some spikes where ‘first’/'any’ is blazingly fast. Is being a native opcode that much faster than XS-code?

eval {
    do_something()
        or die "Err!";
 };

if ($@) {
    print "Catched exception: $@";
}

Even Damian Conway does it in chapter 16 of Perl Best Practices and ‘perldoc -f die‘ does it too. Unfortunately it doesn’t work all the time. Consider the following situation:

#!/usr/bin/perl

package Foo;

sub new {
    my $class = shift;
    return bless {}, $class;
}

sub DESTROY {
    my $self = shift;
    eval { 1; };
}

package main;
eval {
    my $foo = Foo->new();
    open my $fh, ">", "/"
        or die "Could not open /: $!";
    print "Doing some work\n";
};
if ($@) {
    print STDERR "Something bad happened: $@\n";
} else {
    print "Everything went well\n";
}

As we shouldn’t be able to open ‘/’ for writing, we expect to see an error message. But it turns out that the script claims to succeed even tough it didn’t do any “work”. So what happened? Well, $foo went out of scope, the destructor was called and the embedded eval changed $@.

What can we do to solve the problem. First of all, make sure that the destructor doesn’t chage $@. You can do this by localizing it. Even tough you’re not calling eval directly, some other code might do it. So always start destructors like this:

sub DESTROY {
    my $self = shift;
    local $@;
    ...;
}

By the way, you want to localize $? too, but that is another story.

Another solution is to change you try/catch emulation. If an eval’ed block dies, the resulting value is undef. So make sure that the ordinary case always ends with a true value, and replace catch with a simple or:

eval {
    do_work();
    1;
} or do {
    print "catch: $@";
};

Of course $@might be misleading about the real error, so this doesn’t work as well as fixing the destructors. But when using modules written by others, you might implement defense in depth by using both solutions. I think there is a Perl::Critic policy advocating the above try/catch construction.

But how does the execption modules on CPAN fare against the above destructor? I tried two of them: Error.pm works correctly, because it’s throw implementation stores the exception before dying. The much newer TryCatch.pm doesn’t work (See rt #46294), but is much cooler otherwise.

Update: I’ve managed to write a fix for TryCatch.pm. It includes a throw function, just like Error.pm.

In a larger system we’re using Geo::IP to locate users. Recently we have discovered a few hanging or segv faulting processes. After finding a reproducible case we found out that both cases shared the same backtrace:

[...]
#1  0x55791570 in GeoIPRecord_delete () from /usr/lib/libGeoIP.so.1
#2  0x5577ecd8 in XS_Geo__IP__Record_DESTROY () from /usr/lib/perl5/auto/Geo/IP/IP.so
#3  0x080bdaa1 in Perl_pp_entersub ()
#4  0x080626db in Perl_magicname ()
#5  0x080632ee in Perl_call_sv ()
#6  0x080c9bf4 in Perl_sv_clear ()
#7  0x080ca3e5 in Perl_sv_free ()
#8  0x080c9f07 in Perl_sv_clear ()
#9  0x080ca3e5 in Perl_sv_free ()
#10 0x080bb5da in Perl_av_undef ()
#11 0x080ca0e7 in Perl_sv_clear ()
#12 0x080ca3e5 in Perl_sv_free ()
#13 0x080c9f07 in Perl_sv_clear ()
#14 0x080ca3e5 in Perl_sv_free ()
#15 0x080b6f69 in Perl_hv_free_ent ()
#16 0x080b70e5 in Perl_hv_iterinit ()
#17 0x080b8e69 in Perl_hv_undef ()
#18 0x080ca0cc in Perl_sv_clear ()
#19 0x080ca3e5 in Perl_sv_free ()
#20 0x080e92ef in Perl_leave_scope ()
#21 0x080e93bc in Perl_pop_scope ()
#22 0x080bec4d in Perl_pp_leavesub ()
#23 0x080bc379 in Perl_runops_standard ()
#24 0x08063bfd in perl_run ()
#25 0x0805ffd1 in main ()

GeoIPRecord_delete consists of 3 free(3) calls for members of a struct and 1 to free(3) the struct itself. Running with Gnu libc’s MALLOC_CHECK and using valgrind confirmed that it triet to free invalid pointers. But the ‘leak’ was nowhere to be found. Using the pure perl version of Geo::IP removed any sign of problems.

Almost giving up I suddenly discovered that it happend while a value read from Storable was going out of scope. The it was easy to reproduce:

use Geo::IP;
use Storable;
my $geoip = Geo::IP->open_type(
    GEOIP_CITY_EDITION_REV1,
    GEOIP_MEMORY_CACHE|GEOIP_CHECK_CACHE
);
my $gir = $geoip->record_by_name( "peter.makholm.net" );
my $copy = Storable::dclone( $gir );
$gir = undef;
$copy = undef;
[... crash ...]

What happens is that Geo::IP::Record is just a scalar reference containing the a C pointer as the integer value. Dumping it with Devel::Peek loks like this:

SV = RV(0x2cdd4c8) at 0x2cdd4b8
  REFCNT = 2
  FLAGS = (ROK)
  RV = 0x27a4a50
  SV = PVMG(0x297e610) at 0x27a4a50
    REFCNT = 1
    FLAGS = (OBJECT,IOK,pIOK)
    IV = 47079264
    NV = 0
    PV = 0
    STASH = 0x2ca9520   "Geo::IP::Record"

Almost the same as what we get for my $foo = bless do { \(my $o = 123456); }, "Foo::Bar"

SV = RV(0x2ce82f0) at 0x2ce82e0
  REFCNT = 2
  FLAGS = (ROK)
  RV = 0x2cf7d30
  SV = PVMG(0x297e730) at 0x2cf7d30
    REFCNT = 3
    FLAGS = (OBJECT,IOK,pIOK)
    IV = 123456
    NV = 0
    PV = 0
    STASH = 0x2cbde28   "Foo::Bar"

so Storable can’t really see that the object is a c-pointer and Geo::IP::Record wasn’t meant to be dumped wioth Storable. The only hint is the description in the documentation of Storable:

The Storable package brings persistence to your Perl data structures containing SCALAR, ARRAY, HASH or REF objects, i.e. anything that can be conveniently stored to disk and retrieved at a later time.

But using Geo::IP::Record it looks exactly like you run of the mill HASH-based record objects. Lessons learned? Really no-one, except to watch out for XS objects.