package Tie::StorableHash;

use Storable;

sub TIEHASH {
    my $class = shift;
    my $storage = shift || "autostorage";
    my $instance = shift || {};
    $instance = retrieve $storage if -e $storage;
       return bless {
           value => $instance,
           storage => $storage,
       } => $class;
}

sub FETCH {
    #print "FETCH got $_[1]\n";
    return $_[0]->{value}->{$_[1]};
}

sub STORE {
    #print "STORE got $_[1] = $_[2]\n";
    $_[0]->{value}->{$_[1]} = $_[2];
    store $_[0]->{value}, $_[0]->{storage};
}

sub DESTROY {
    undef $_[0];
}

package main;

tie %karma, Tie::StorableHash, "autostorage", {};

print "karma=%karma\n";

print "$karma{dada}\n";

$karma{dada}++;

print "$karma{dada}\n";

$karma{larsen} = {
    value => 1000,
    comment => "troppo",
} unless exists $karma{larsen};

print "$karma{larsen}->{value}\n";
[download]

use warnings + close(STDERR) causes the angle brackets operator (eg. <FILE>) to fail.

take this little script and save it to a file (we'll call it dree.pl):

use warnings;
close (STDERR);
open(ME, "$0");
while (<ME>) {
    print;
}
close ME;
[download]

use Win32::API 0.20;

my $GetFullPathName = new Win32::API(
    'kernel32',
    'GetFullPathName',
    'PNPP' => 'N',
);

my $GetLongPathName = new Win32::API(
    'kernel32',
    'GetLongPathName',
    'PPN' => 'N',
);

my $file = $ARGV[0] || 'twig.pm';

my $full = "\0" x 2048;
my $name = 0;

my $rc;

$rc = $GetFullPathName->Call( $file, 2048, $full, $name );
if($rc == 0) {
    die "GetFullPathName failed ($^E)\n";
} else {
    $full = unpack('A*', $full);
    print "GetFullPathName returned '$full'\n";

    my $long = "\0" x 2048;

    $rc = $GetLongPathName->Call( $full, $long, 2048 );
    $long = unpack('A*', $long);
    if($rc == 0) {
        die "GetLongPathName failed ($^E)\n";
    } else {
        print "GetLongPathName returned '$long'\n";
    }
}
[download]

for BrowserUk:

#! perl -sw
use strict;
use Inline C => 'DATA';

my $num = '1';

print looks_like_number($num), $/;

__DATA__
__C__

int looks_like_number(SV* var) {
    dTHX;
    return Perl_looks_like_number(aTHX_ var);
}
[download]

for giant:

package Tie::PrintfScalar;

sub TIESCALAR {
    my($class, $printf) = @_;
    return bless {
        value => undef,
        printf => $printf,
    };
}

sub STORE {
    my($self, $value) = @_;
    return $self->{value} = $value;
}

sub FETCH {
    my($self) = @_;
    return sprintf($self->{printf}, $self->{value});
}

sub DESTROY {
    undef ${$_[0]};
}

1;

package main;

my $nr;

tie $nr, Tie::PrintfScalar, '%02d';

$nr = 2;

print "$nr\n";
[download]

callback.c:

#include <stdio.h>
#include <windows.h>

typedef int (__stdcall * mycallback)(int);

int do_callback( mycallback cb, int v) {
    int r = cb(v);
    return r;
}

int CALLBACK callback( int a) {
    printf("callback got %d\n", a);
    return a*2;
}


int main(int argc, char* argv[]) {
    int r;
    r = do_callback(callback, 21);
    printf("main got %d\n", r);
    return 0;
}
[download]