Useful little CPAN modules

gistfile1.txt

#----------------- Carp::longmess

use Carp qw( longmess );

sub foo { bar() }
sub bar { baz() }
sub baz { print Carp::longmess }
foo();

#----------------- List::Util / List::MoreUtils

my @email = qw( lord.snow@thewall.com king@westeros.com cersei@casterly.com 
                king@winterfell.com king@dragonstone.com 
            );

# Get the first matching thing out of an array
my $found;
for my $email ( @email ) {
    if ( $email =~ /\bcasterly\b/ ) {
        $found = $email;
        last;
    }
}

use List::Util qw( first );
my $found = first { /\bcasterly\b/ } @email;

# Determine if we know any king's email address
for my $email ( @email ) {
    if ( $email =~ /^king\@/ ) {
        long_live_the_king();
        last;
    }
}

if ( grep { /^king\@/ } @email ) {
    long_live_the_king();
}

use List::MoreUtils qw( any );
if ( any { /^king\@/ } @email ) {
    long_live_the_king();
}

#----------------- Hash::Merge::Simple

my %baratheon = (
    King => "Robert, King of Westeros",
    Lord => {
        Stannis => "Lord of Dragonstone",
        Renly => "Lord of Storm's End",
    },
);
my %lannister = (
    Lord => {
        Tywin => "Lord of Casterly Rock",
    },
    Knight => {
        Jamie => "Knight of the Kingsguard",
    },
    Queen => "Cersei, Queen of Westeros",
);

my %marriage = %baratheon, %lannister;

use Hash::Merge::Simple qw( merge );
my $marriage = merge( \%baratheon, \%lannister );

#----------------- Benchmark
use Set::Object;
package Obj;
sub new { bless {} }
package main;

@els = map { Obj->new } 1..1000;

require Benchmark;

Benchmark::cmpthese( 0, {
    'Hash insert' => sub { my %h; $h{ @els } = @els },
    'Set insert' => sub { my $s = Set::Object->new; $s->insert( @els ) },
} );

$i = 33;
%gh = ();
@gh{ @els } = @els;
$gs = Set::Object->new( @els );
$el = $els[ $i ];

Benchmark::cmpthese( 0, {
    'Hash lookup' => sub { exists $gh{33} },
    'Set lookup' => sub { $gs->includes( $el ) },
} );

#----------------- Memoize

use Memoize qw( memoize );
sub fib {
    return 1 if $_[0] <= 0;
    return fib( $_[0] - 1 ) + fib( $_[0] - 2 );
}
sub fib_memo {
    return 1 if $_[0] <= 0;
    return fib( $_[0] - 1 ) + fib( $_[0] - 2 );
}
memoize( 'fib_memo' );

use Benchmark qw( cmpthese timethese );
my $i = 30;
timethese( 0, {
    fib             => sub { fib( $i ) },
    fib_memo        => sub { fib_memo( $i ) },
} );

#---------------- Tie::IxHash

my %kings = (
    Aegon => 'Targaryen',
    Robert => 'Baratheon',
    Joffrey => 'Baratheon',
    Tommen => 'Baratheon',
);
say '--';
say for keys %kings;
say '--';
say for keys %kings;

tie my %succession, 'Tie::IxHash', (
    Aegon => 'Targaryen',
    Robert => 'Baratheon',
    Joffrey => 'Baratheon',
    Tommen => 'Baratheon',
);

say for keys %succession;
say '--';
say for keys %succession;
say '--';

#---------------- Tie::CPHash

tie my %kings, 'Tie::CPHash', (
    Aegon => 'Targaryen',
    Robert => 'Baratheon',
    Joffrey => 'Baratheon',
    Tommen => 'Baratheon',
);
say '--';
say for keys %kings;
say '--';
say $kings{ TOMMEN };
say $kings{ aegon };