Feeds:
Posts
Comments

Posts Tagged ‘strawberry perl’

Interesting. Strawberry Perl installed Authen::SASL::Perl without any problem. You’re right. That is not unexpected. Once you get away from POSIX signals and processes, most pure perl is pretty portable.

cd c:/strawberry/cpan/build/Authen-SASL-2.1401-V48Oe3/t
perl digest_md5.t
1..27
ok 1 - new
ok 2 - sasl mechanism
ok 3 - conn mechanism
ok 4 - client_start
ok 5 - we need extra steps
...

Which line is saying we need extra steps?

is($sasl->mechanism, 'DIGEST-MD5', 'sasl mechanism');

my $conn = $sasl->client_new("ldap","localhost", "noplaintext noanonymous");

is($conn->mechanism, 'DIGEST-MD5', 'conn mechanism');

is($conn->client_start, '', 'client_start');
ok  $conn->need_step, "we need extra steps";

Hang on a minute, wasn’t it need_step() that was failing in Arc? Maybe it is fixable after all if I just move from the XS authentication to the pure perl implementation.

Read Full Post »

This is part 4 in my occasional AnyEvent series

When I tried to move my AnyEvent-based code over to Windows today, I got a slightly unpleasant surprise.

$ perl kernel.pl
fcntl is not implemented at c:/strawberry/perl/site/lib/AnyEvent/Util.pm line 362.

(Actually, that path is not accurate – it is from simulating the problem on a different computer. The actual path is a network share.)

Drat I thought, maybe AnyEvent isn’t as portable as I thought. But hang on a minute. When doubting a widely used library ahead of your own code, it is usually your code that is at fault. In my experience anyhow. And besides, Twiggy runs on Windows. What have I done wrong?

So I had a look at the offending line of code.

# Sets the blocking state of the given filehandle (true == nonblocking,
# false == blocking). Uses fcntl on anything sensible and ioctl FIONBIO on
# broken (i.e. windows) platforms.

BEGIN {
   *fh_nonblocking = AnyEvent::WIN32
      ? sub($$) {
          ioctl $_[0], 0x8004667e, pack "L", $_[1]; # FIONBIO
        }
      : sub($$) {
          fcntl $_[0], AnyEvent::F_SETFL, $_[1] ? AnyEvent::O_NONBLOCK : 0;
        }
   ;
}

While I was there, a quick glance down the comments gave me a picture of someone who enjoys working on Windows as much as I do :)

# perl's socketpair emulation fails on many vista machines, because
# vista returns fantasy port numbers.

...

# vista has completely broken peername/sockname that return
# fantasy ports. this combo seems to work, though.

...

# vista example (you can't make this shit up...):

I quickly tracked the root of the problem down to a file called constants.pl. Uh oh, take a look at the WIN32 subroutine.

package AnyEvent;
sub CYGWIN () { 0 }
sub WIN32 () { 0 }
...

That is actually a file generated from a Unix install of AnyEvent. constants.pl is generated at make time from a file called constants.pl.PL that looks like this.

sub i($$) {
   print "sub $_[0] () { ", $_[1]*1, " }\n";
}

print "package AnyEvent;\n";

our $WIN32 = $^O =~ /mswin32/i;

i CYGWIN => $^O =~ /cygwin/i;
i WIN32  => $WIN32;
...

And this is down to my company’s perl policy. A number of pure perl modules are installed on a windows network share which is samba mounted onto the unix servers. We’re primarily a C++/Java shop and Perl is something of a second-class citizen but there are a good number of modules available (including Moose, AnyEvent, POE, etc.)

The downside is that it is hard to get modules installed that aren’t there already, and we are not permitted to download them ourselves. Most of the time, this isn’t a problem.

Anyway, I tried to fix this in my own script using variants on:

package AnyEvent;
use constant WIN32 => 1;
package Kernel;

and

sub AnyEvent::WIN32 () { 1 }

both before and after the use AnyEvent lines. I couldn’t get round it though. This happened when the definitions were after the use lines.

$ perl kernel.pl
Constant subroutine AnyEvent::WIN32 redefined at c:/strawberry/perl/lib/constant.pm line 131.
Constant subroutine AnyEvent::WIN32 redefined at kernel.pl line 23.
fcntl is not implemented at c:/strawberry/perl/site/lib/AnyEvent/Util.pm line 362.

And this is when it was placed before.

$ perl kernel.pl
Constant subroutine WIN32 redefined at c:/strawberry/perl/site/lib/AnyEvent/constants.pl line 3.
fcntl is not implemented at c:/strawberry/perl/site/lib/AnyEvent/Util.pm line 362.

How frustrating!

Read Full Post »

This is part 2 in my occasional AnyEvent series

As we already discovered, signals don’t work in Strawberry Perl [on Windows]. As they are so useful, we really want a way to emulate them. I can think of a few approaches, but the most obvious is to have a userspace "kernel" sitting on a socket which all processes register with.

The kernel will respond to a few commands

register: [args]
list_processes           # ps :)
signal: [pid] [message]  # similar to kill, but more flexible

A quick disclaimer: for the sake of brevity, I’ve omitted authentication and error handling.

Kernel Code

The server again uses AnyEvent and start_listen(), prepare_handler() and _accept_handler() should look pretty familiar.

Twiggy uses AE::io and checks errno for its conditions. I guess this is done for speed as AnyEvent::Handle is much easier to use.

sub watch_socket
{
    my ($self, $sock) = @_;

    # Closure variables
    my $pid = -1;

    my $handle; $handle = AnyEvent::Handle->new(
        fh  => $sock,
        on_error => sub {
            say "Error: $! (PID $pid)";
            $handle->destroy;
        },
        on_eof => sub {
            say "Disconnected (PID $pid)";
            delete $self->{watchers}{$pid};
            $handle->destroy;
        },
    );

    $handle->push_read(line => sub {
        my ($handle, $command) = @_;

        DEBUG && say "Received [$command]";

        # valid commands are:
        #     register: [args]
        #     list_processes
        #     signal: [pid] [message]

        if ($command =~ /^register:\s+(.+)/) {
            my $args = $1;
            $pid = ++$self->{pid};
            $self->register_watcher($handle, $pid, $args);
            # Don't set on_drain(...)
            return;
        } elsif ($command eq 'list_processes') {
            $self->list_processes($handle);
        } elsif ($command =~ /^signal:\s+(\d+)\s+(.+)/) {
            my ($pid, $message) = ($1, $2);
            $self->send_signal($handle, $pid, $message);
        } else {
            say 'Error: unrecognised command';
            $handle->push_write("Invalid command [$command]" . ${cr});
        }

        # For all commands apart from register, we want to close the
        # socket after sending the response which we do by setting
        # on_drain(...)
        $handle->on_drain(sub { $handle->destroy(); });
    });
}

register_watcher

register_watcher stores the handle and the information about the process in the object. It informs the process which PID has been given to the process. (I am still considering the registering process sending $$ to use as the PID).

sub register_watcher
{
    my ($self, $handle, $pid, $args) = @_;
    DEBUG && say "Registering [$args] (PID $pid)";

    $handle->keepalive(1);
    $self->{watchers}{$pid} = { handle => $handle, args => $args };
    $handle->push_write("Connected.  (PID $pid)" . ${cr});
    # on_read(...) needs to be set, otherwise disconnects from the
    # client side are not always detected
    $handle->on_read(sub { });
}

list_processes

list_processes gives a process list of processes that are registered with the kernel. This is similar, but uglier to ps(1).

sub list_processes
{
    my ($self, $handle) = @_;

    foreach my $pid (sort { $a <=> $b } keys %{$self->{watchers}}) {
        my $args = $self->{watchers}{$pid}{args};
        $handle->push_write("$pid: $args" . ${cr});
    }
}

send_signal

send_signal looks up the handle belonging to the process in $self->{watchers}. If it is registered, it is possible to send any message to the process, otherwise it returns an error message. I’ve added special handling to a disconnect message, allowing

This is the dangerous bit. kill(1) has some protection in that you are only able to send signals to processes you own (unless you are root). The implementation, as presented here, allows anyone who can telnet to the kernel port to send any message to any process that is registered. It would be necessary to add a layer of authentication and process ownership if the goal really was to provide something similar to unix signals.

sub send_signal
{
    my ($self, $handle, $pid, $message) = @_;

    if (! exists($self->{watchers}{$pid})) {
        say "Error: PID $pid does not exist";
        $handle->push_write("PID $pid does not exist" . ${cr});
    } else {
        my $process = $self->{watchers}{$pid}{handle};
        $process->push_write('signal: ' . $message . ${cr});
        if ($message eq 'disconnect') {
            delete $self->{watchers}{$pid};
            $process->on_drain(sub { $process->destroy(); });
        }
    }
}

kernel.pl – complete source

#!perl

use 5.010;

use strict;
use warnings;

package Kernel;

use constant DEBUG => $ENV{KERNEL_DEBUG};

my $cr = "\015\012";

use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;

sub new
{
    my $class = shift;
    my $self = { pid => 0, watchers => {} };
    bless $self, $class;
    return $self;
}

sub register_watcher
{
    my ($self, $handle, $pid, $args) = @_;
    DEBUG && say "Registering [$args] (PID $pid)";

    $self->{watchers}{$pid} = { handle => $handle, args => $args };
    $handle->push_write("Connected.  (PID $pid)" . ${cr});
    $handle->on_read(sub { });
}

sub list_processes
{
    my ($self, $handle) = @_;

    foreach my $pid (sort keys %{$self->{watchers}}) {
        my $args = $self->{watchers}{$pid}{args};
        $handle->push_write("$pid: $args" . ${cr});
    }
}

sub send_signal
{
    my ($self, $handle, $pid, $message) = @_;

    if (! exists($self->{watchers}{$pid})) {
        say "Error: PID $pid does not exist";
        $handle->push_write("PID $pid does not exist" . ${cr});
    } else {
        my $process = $self->{watchers}{$pid}{handle};
        $process->push_write('signal: ' . $message . ${cr});
        if ($message eq 'disconnect') {
            delete $self->{watchers}{$pid};
            $process->on_drain(sub { $process->destroy(); });
        }
    }
}

sub watch_socket
{
    my ($self, $sock) = @_;

    # Closure variables
    my $pid = -1;

    my $handle; $handle = AnyEvent::Handle->new(
        fh  => $sock,
        on_error => sub {
            say "Error: $! (PID $pid)";
            $handle->destroy();
        },
        on_eof => sub {
            say "Disconnected (PID $pid)";
            delete $self->{watchers}{$pid};
            $handle->destroy();
        },
    );

    $handle->push_read(line => sub {
        my ($handle, $command) = @_;

        DEBUG && say "Received [$command]";

        if ($command =~ /^register:\s+(.+)/) {
            my $args = $1;
            $pid = ++$self->{pid};
            $handle->keepalive();
            $self->register_watcher($handle, $pid, $args);
            return;
        } elsif ($command eq 'list_processes') {
            $self->list_processes($handle);
        } elsif ($command =~ /^signal:\s+(\d+)\s+(.+)/) {
            my ($pid, $message) = ($1, $2);
            $self->send_signal($handle, $pid, $message);
        } else {
            say 'Error: unrecognised command';
            $handle->push_write("Invalid command [$command]" . ${cr});
        }

        $handle->on_drain(sub { $handle->destroy(); });
    });
}

sub prepare_handler
{
    my ($fh, $host, $port) = @_;
    DEBUG && warn "Listening on $host:$port\n";
}

sub _accept_handler
{
    my $self = shift;

    return sub {
        my ($sock, $peer_host, $peer_port) = @_;

        DEBUG && warn "Accepted connection from $peer_host:$peer_port\n";
        if (! $sock) {
            warn '$sock undefined' . "\n";
            return;
        }

        $self->watch_socket($sock);
    };
}

sub start_listen
{
    my ($self, $host, $port) = @_;

    $self->{server} = tcp_server($host,
                                 $port,
                                 $self->_accept_handler(),
                                 \&prepare_handler);
}

package main;

my $host = undef;
my $port = 12345;

my $kernel = Kernel->new();
$kernel->start_listen($host, $port);

AE::cv->recv();

Read Full Post »

Following my earlier tests, I’ve got good hopes for Plack on Windows. To ramp it up from the hello world example I thought I’d try a simple network cache. HTTP isn’t obviously the best protocol for this purpose, but it’s widely used, presumably due to the existence of many robust servers (also maybe because people [including me of course!] can’t be bothered to check for short tcp reads/writes).

To make the example simple, I have (a) elided the actual call to retrieve the data and (b) put all of the code in one file. Obviously I wouldn’t recommend doing this in production but hopefully it will convey the intent.

# —

Most of my perl starts with a preamble that looks somewhat like this.

use 5.010;

use strict;
use warnings;

use POSIX;

get_data represents a call (to a database for example) that will take a while to complete.

sub get_data
{
    my $key = shift;
    sleep 5;
    return "[$key]";
}

get_cached_data is also very much simplified. Normally I’d expect to use something like the Cache::XXX modules.

sub get_cached_data
{
    my $key = shift;
    state %cache;

    if (! exists($cache{$key})) {
        $cache{$key} = get_data($key);
    }

    return $cache{$key};
}

response wraps the PSGI response to make the example a bit cleaner. It obviously wouldn’t be appropriate if other http response types were returned.

sub response
{
    my $data = shift;

    return [
        200,
        ['Content-Type' => 'text/plain'],
        [$data],
    ];
}

Twiggy doesn’t log the information about the request by default in the same way as plackup does. There may be a flag to enable that (should look at the code) but for now I synthesise it from $env.

sub request_info
{
    my $env = shift;
    my $ts = POSIX::strftime('%d/%b/%Y %H:%M:%S', localtime(time()));

    return qq{$env->{REMOTE_ADDR} - - [$ts] }
         . qq{"$env->{REQUEST_METHOD} $env->{PATH_INFO} $env->{SERVER_PROTOCOL}" }
         . qq{"-" "$env->{HTTP_USER_AGENT}"};
}

And there should be nothing surprising in the main.

# -- main

my $app = sub {
    my $env = shift;

    # foreach my $key (keys %$env) {
    #     print "$key $env->{$key}\n";
    # }

    # Twiggy doesn't give the same request info as vanilla plack
    say request_info($env);

    # Could map METHOD/PATH to subroutine calls using a hash
    my $method = $env->{REQUEST_METHOD};
    my $path_info = $env->{PATH_INFO};

    my $start = time();
    my $response = response(get_cached_data($path_info));
    my $time = time() - $start;
    my $s = ($time == 1) ? '' : 's';
    say "Generating response took $time second$s";

    return $response;
};

Testing with firefox is a bit crufty, but I haven’t got around to adapting my test client yet.

$ twiggy --listen :8080 obj-cache.psgi
127.0.0.1 - - [30/Mar/2010 21:24:47] "GET /someurl/ HTTP/1.1" "-" "Mozilla/5.0 (Windows; U; Windows NT 6.0; en-GB; rv:1.9.2.2) Gecko/20100316 Firefox/3.6.2 (.NET CLR 3.5.30729)"
Generating response took 5 seconds
127.0.0.1 - - [30/Mar/2010 21:25:02] "GET /someurl/ HTTP/1.1" "-" "Mozilla/5.0 (Windows; U; Windows NT 6.0; en-GB; rv:1.9.2.2) Gecko/20100316 Firefox/3.6.2 (.NET CLR 3.5.30729)"
Generating response took 0 seconds # Yes, looks good!

Read Full Post »

Having had a couple of surprising experiences with third-party perl modules using signals on windows, I decided to test them to see how extensive support is. As mst points out, it is good to have confidence in your chosen platform.

Here is my test program.

#!/usr/bin/env perl

use 5.010;

use strict;
use warnings;

say '#', scalar(keys %SIG), ' signals';

my %skip = map { $_, 1 } qw(STOP TSTP TTIN TTOU);

foreach my $sig (sort keys %SIG) {
    next if (exists $skip{$sig});

    my $pid = fork();
    if (! $pid) {
        sleep 1;
        say "$sig failed!";
        exit 0;
    }

    say "Testing $sig (on $pid)";
    kill $sig, $pid;
    my $catch = wait();
    say "($sig) $catch exited...\n";
}

I fork a new process (presumably this is a pseudo-fork piggy-backing on a thread instead of a process in windows, but it is something people might write if they weren’t aiming at portability to windows), and then I try and send it a signal using kill. If the kill fails, then we get a message.

On Linux, this works pretty well as you would expect, signalling both from the parent and from within the child (suiciding?). A few signals unsurprisingly didn’t cause the child to abort: CHLD, CLD, CONT, FPE, NUM32, URG, WINCH and a few needed to be skipped. However, it was consistent from run to run.

The tests on Windows varied from run to run. The first run aborted on the first signal (SIGABRT appropriately enough).

jared@win32 $ ./signal-test.pl
#26 signals
Testing ABRT (on -3628)
Terminating on signal SIGABRT(22)

The next one ran through to SIGFPE.

jared@win32 $ ./tsig2.pl
#26 signals
Testing ABRT (on -268)
ABRT failed!
(ABRT) -268 exited...

Testing ALRM (on -1440)
ALRM failed!
(ALRM) -1440 exited...

Testing BREAK (on -2596)
BREAK failed!
(BREAK) -2596 exited...

Testing CLD (on -3464)
CLD failed!
(CLD) -3464 exited...

Testing CONT (on -2360)
CONT failed!
(CONT) -2360 exited...

Testing FPE (on -3508)
Terminating on signal SIGFPE(8)

And the third ran through to SIGBREAK.

jared@win32 $ ./tsig2.pl
#26 signals
Testing ABRT
ABRT failed!
(ABRT) -3548 exited...

Testing ALRM
ALRM failed!
(ALRM) -2800 exited...

Testing BREAK
Terminating on signal SIGBREAK(21)

*sigh*. Well, that is pretty disappointing. I had a bunch of other signal related tests I was thinking about doing but there seems little point. I always think of Perl as a fairly platform-agnostic wrapper around the underlying OS, but it looks like I was seriously mistaken.

Read Full Post »

Okay, so down to business. One thing I like about straight cgi vs mod_perl is that any changes are immediately reflected on page refresh. And plackup (and twiggy) both offer an option to auto-restart when files change. Sounds good.

jared@win32 $ plackup -h
...
-r, --reload
        Make plackup to watch updates from your development directory and
        restarts the server whenever a file is updated. This option by
        default watches the "lib" directory and the base directory where
        *.psgi* file is located. Use "-R" if you want to watch other
        directories.
...
jared@win32 $ twiggy -r --listen :8080 hello.psgi
Watching ./lib hello.psgi for file updates.
./lib: No such file or directory at c:/strawberry/perl/site/lib/Filesys/Notify/Simple.pm line 156
Terminating on signal SIGINT(2)

Hmmm… I didn’t ask it to watch ./lib (and it doesn’t acknowledge changes to hello.psgi). Let me change the watched files with -R.

jared@win32 $ plackup -r -R hello.psgi --listen :8080 hello.psgi
HTTP::Server::PSGI: Accepting connections at http://0:8080/
Watching hello.psgi ./lib hello.psgi for file updates.
./lib: No such file or directory at c:/strawberry/perl/site/lib/Filesys/Notify/Simple.pm line 156
Terminating on signal SIGINT(2)

Er, okay, -R only allows you to add paths. So there is not an obvious way of removing the paths that already exist. *sigh*. I submit to the inevitable.

jared@win32 $ mkdir lib
jared@win32 $ twiggy -r --listen :8080 hello.psgi
Watching ./lib hello.psgi for file updates.

So I make a change to hello.psgi and get the following:

-- C:\home\jared\plack-tests\hello.psgi updated.
Killing the existing server (pid:-2872)

Almost! But I’m missing the message that says it was able to restart the server.

waitpid($pid, 0);
warn "Successfully killed! Restarting the new server process.\n";

In actual fact, the process it claims it has killed is still running and I’m still able to connect to it. So I hack Restarter.pm a bit (more on that at the end).

jared@win32 $ twiggy -r --listen :8080 hello.psgi
Watching ./lib hello.psgi for file updates.
-- C:\home\jared\plack-tests\hello.psgi updated.
Killing the existing server (pid:-2156)
Successfully killed! Restarting the new server process.
bind: Unknown error at c:/strawberry/perl/site/lib/Twiggy/Server.pm line 71
    -L, --loader

Using plackup instead of twiggy works.

jared@win32 $ plackup -r --listen :8080 hello.psgi
HTTP::Server::PSGI: Accepting connections at http://0:8080/
Watching ./lib hello.psgi for file updates.
-- C:\home\jared\plack-tests\hello.psgi updated.
Killing the existing server (pid:-3544)
Successfully killed! Restarting the new server process.
HTTP::Server::PSGI: Accepting connections at http://0:8080/

Although having thought about it, maybe the Shotgun loader is what I really want.

jared@win32 $ twiggy --listen :8080 hello.psgi -L Shotgun
Attempt to free unreferenced scalar: SV 0x2c78b04,
Perl interpreter: 0x2400054 at
c:/strawberry/perl/site/lib/Plack/Loader/Shotgun.pm line 48.

Again, plackup works here where twiggy does not.

jared@win32 $ plackup --listen :8080 hello.psgi -L Shotgun
HTTP::Server::PSGI: Accepting connections at http://0:8080/
127.0.0.1 - - [22/Mar/2010 21:21:31] "GET / HTTP/1.1" 200 42 "-" "Mozilla/5.0 (Windows; U; Windows NT 6.0; en-GB; rv:1.9.2) Gecko/20100115 Firefox/3.6 (.NET CLR 3.5.30729)"
127.0.0.1 - - [22/Mar/2010 21:21:35] "GET /favicon.ico HTTP/1.1" 200 42 "-" "Mozilla/5.0 (Windows; U; Windows NT 6.0; en-GB; rv:1.9.2) Gecko/20100115 Firefox/3.6 (.NET CLR 3.5.30729)"
127.0.0.1 - - [22/Mar/2010 21:22:07] "GET / HTTP/1.1" 200 42 "-" "Mozilla/5.0 (Windows; U; Windows NT 6.0; en-GB; rv:1.9.2) Gecko/20100115 Firefox/3.6 (.NET CLR 3.5.30729)"

# –

And at the risk of getting pointed comments for using the KILL signal, here is the hack I made to Restarter.pm. (Hey, what can I do? My OS blows.)

--- Plack.orig/Loader/Restarter.pm      2010-03-22 20:50:16 +0000
+++ Plack/Loader/Restarter.pm   2010-03-22 21:31:06 +0000
@@ -37,6 +37,12 @@
     my $pid = $self->{pid} or return;
     warn "Killing the existing server (pid:$pid)\n";
     kill 'TERM' => $pid;
+
+    if (lc($^O) =~ /mswin32/) {
+        sleep 1;
+        kill 'KILL' => $pid;
+    }
+
     waitpid($pid, 0);
     warn "Successfully killed! Restarting the new server process.\n";
 }

Read Full Post »

Now I have my command prompt set up the way I like it, installing modules into strawberry perl from from cpan is easy. Okay, fine, it was easy before, but now I just need to run my batch file and type cpan.

Okay, so one of the things I’m interested in is running Plack on Windows. And Twiggy looks like the obvious choice for HTTP servers supporting PSGI – the benchmarks I looked at state it is the second most performant pure(ish)-perl option after Starman and Starman clearly states it isn’t supported on Windows. Does the fact that Twiggy doesn’t say that mean that it works?

c:\home\jared>cpan

cpan shell -- CPAN exploration and modules installation (v1.9452)
Enter 'h' for help.


cpan> install Plack::Handler::Twiggy

...

t/02_signals.t .......... skipped: Broken perl detected,
skipping tests.
t/03_child.t ............ skipped: Your perl interpreter
is badly BROKEN. Child watchers will not work, ever. Try
upgrading to a newer perl or a working perl (cygwin's perl
is known to work). If that is not an option, you should be
able to use the remaining functionality of AnyEvent, but
child watchers WILL NOT WORK.

...

Yikes! This was emitted when building AnyEvent (a pretty key part of Twiggy). It doesn’t sound good does it? It comes from the following test:

BEGIN {
   # check for broken perls
   if ($^O =~ /mswin32/i) {
      my $ok;
      local $SIG{CHLD} = sub { $ok = 1 };
      kill 'CHLD', 0;

      unless ($ok) {
         print <<EOF;
1..0 # SKIP Your perl interpreter is badly BROKEN. Child watchers will not work, ever. Try upgrading to a newer perl or a working perl (cygwin's perl is known to work). If that is not an option, you should be able to use the remaining functionality of AnyEvent, but child watchers WILL NOT WORK.
EOF
         exit 0;
      }
   }
}

Okay, so child watchers don’t work (whatever they are). Hopefully Twiggy doesn’t need ‘em. Let’s plough on regardless. This is the standard Hello World app.

my $app = sub {
    my $env = shift;
    return [
        200,
        ['Content-Type' => 'text/plain'],
        [ "Hello stranger from $env->{REMOTE_ADDR}!"],
    ];
};

And firing up twiggy works, at least for this simple example.

jared@win32 $ twiggy --listen :8080 hello.psgi

Read Full Post »

I’ve talked a bit previously about alternative windows shells. However, sometimes they are not available and I have no wish to learn powershell so I use the old dos command prompt.

I set up a batch file to configure the path which will be called from Console2. And I use my usual trick of removing unwanted paths and duplicates by calling perl. As dos doesn’t have the nice backtick syntax from the unix shells how do you capture the output from an external command? It turns out you need the dos for command.

c:\home\jared>for /?
Runs a specified command for each file in a set of files.

FOR %variable IN (set) DO command [command-parameters]

...

FOR /F ["options"] %variable IN ('command') DO command [command-parameters]

...

As the perl command uses quotes itself, you need to pass the usebackq option which allows you to use backticks to quote the command and has the added advantage of looking slightly more like unix shell :)

The way that for works is it splits the output based on a delimiter and you have to specify a variable for each result. The default delimiter is space and as many windows paths contain spaces we would have to provide a large number of variables to retrieve all the results. The alternative is to set delims to be blank which allows us to capture all the results in one variable.

@echo off

set PERL=c:\strawberry\perl\bin\perl

for /f "usebackq delims=" %%x in (`%PERL% -e "print join(q{;}, grep { lc($_) !~ /strawberry|msys|mingw|cygwin/ } split /;/, $ENV{PATH})"`) do set PATH=%%x

set STRAWBERRY=c:\strawberry\perl\bin;c:\strawberry\c\bin
set PATH=%STRAWBERRY%;c:\msys\1.0\bin;%PATH%
cd %HOME%

@echo on
%COMSPEC% /k

Read Full Post »

I’m (unfortunately) doing more work on Windows on these days so I’ve installed a mini Windows-dev environment at home. It is impressive what the libre software guys have done – between Emacs, Cygwin and Perl (and a rusty MinGW C compiler) I feel almost at home.

On Windows, there is an embarrassment of Perl options. I could choose from ActiveState Perl, Strawberry Perl, CygPerl or try and build it myself. I haven’t tried Strawberry Perl so I thought I’d give it a whirl. The install process was pleasant enough but after that I had some problems. I tried my usual perl -MCPAN -e shell incantation followed by installing (upgrading) the CPAN package but it didn’t work. Woe is me!

I reached for old reliable cygperl but that didn’t work either. Hmmm… fishy, I’m sure I haven’t had problems previously. Thankfully googling the exact error lead to a solution which unfortunately I didn’t make a note of. I do remember that it involved a rebase from the static shell, ash. Following that, Strawberry Perl worked too.

The next thing to do was to install POE. POE allows you to structure your code in an event-driven way. I’ve experienced some strange behaviour with POE on various Windows Perl implementations in the past so I want to test a few things.

My basic POE script.

use strict;
use warnings;

use POE;

POE::Session->create(
    inline_states => {
        _start => sub { $_[KERNEL]->yield('loop'); },
        loop   => sub {
            print "Normal loop\n";
            $_[KERNEL]->delay(loop => 1);
        },
    }
);

$poe_kernel->run();

That was a cumbersome way to implement a while 1 loop eh?

while (1) {
    print "Normal Loop\n";
    sleep 1;
}

The first thing I want to test is timeouts. I actually like the crufty way that timeouts are implemented in perl with eval / sig alarm. I use sleep here to simulate a long running process despite the warning in the documentation.

It is usually a mistake to intermix alarm and sleep calls. (sleep may be internally implemented in your system with alarm)

use strict;
use warnings;

use POE;

sub timeout_test
{
    eval {
        local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
        alarm 3;
        sleep 5; # This simulates a long-running process
        alarm 0;
    };
    if ($@) {
        die unless $@ eq "alarm\n"; # propagate unexpected errors
        print "Timeout\n";
        # timed out
    }
    else {
        # didn't
    }
}

POE sessions are a bit like co-operative threads. If the session doesn’t yield to the kernel, another session can’t run so if the timeout doesn’t work, we won’t see any output after the timeout loop starts.

POE::Session->create(
    inline_states => {
        _start => sub { $_[KERNEL]->yield('loop'); },
        loop   => sub {
            print "Normal Loop\n";
            $_[KERNEL]->delay(loop => 1);
        },
    }
);

POE::Session->create(
    inline_states => {
        _start => sub { $_[KERNEL]->yield('loop'); },
        loop   => sub {
            print "Timeout loop\n";
            timeout_test();
            $_[KERNEL]->delay(loop => 1);
        },
    }
);

$poe_kernel->run();

Fortunately, it works fine.

$ perl basic-poe.pl
Normal Loop
Timeout loop
Timeout
Normal Loop
Timeout loop
Timeout
Normal Loop
Terminating on signal SIGINT(2)

Read Full Post »

Follow

Get every new post delivered to your Inbox.