Benchmark::Serialize::Library - Library of serialization modules

Benchmark-Serialize documentation Contained in the Benchmark-Serialize distribution.

Index

Code Index:

NAME

Top

Benchmark::Serialize::Library - Library of serialization modules

VERSION

Top

Version 0.08

SYNOPSIS

Top

    use Benchmark::Serialize::Library;

    Benchmark::Serialize::Library->register(
        MyModule => {
            deflate => sub { MyModule::deflate( $_[0] ) },
            inflate => sub { MyModule::inflate( $_[0] ) },
        }
    );

    my %benchmarks = Benchmark::Serialize::Library->load( ":all" );

DESCRIPTION

Top

This module contains a library of serialization routines for use with Benchmark::Serialize

Library methods

This class provides the following methods

register( NAME => SPECIFICATION )

Registers a new benchmarkable form of serialization. A specification is a hashref containing the following fields:

deflate (required)

A coderef taking one argument (a perl structure) and returns the serialized structure

inflate (required)

A coderef taking one argument (a serialized structure) and returns the perl structure

packages (optional)

A array reference containing modules to be loaded. The default value is the name of the benchmark.

args (optional)

A coderef returning a list of aditional arguments for the deflate and inflate routines. Only run once during initialization of benchmark.

All additional fields are interpreted as tags used for selecting benchmarks.

load NAME|TAG|BENCHMARK ...

Loads and initializes a number of benchmarks. Arguments can be either registered names, registered tags, or unregistered benchmarks following the same format as the register method.

Returns a list of benchmarks

list

Returns a list of all available benchmarks. For each benchmark both the name and the version is returned in a array ref.

Benchmark methods

Each benchmark is represented by a object with the following mathods

deflate

Takes a perl structure as argument and returns the serialized form

inflate

Takes a serialized form as argument and returns the perl structure.

name

Returns the name of the benchmark

version

Returns the module version of the benchmark. For benchmark needing multiple loaded modules, the first in the specification list is used.

Known tags

The following tags are usec in the standard library

:all - All modules with premade benchmarks
:default - A default set of serialization modules
:core - Serialization modules included in core
:json - JSON modules
:yaml - YAML modules
:xml - XML formats

AUTHOR

Top

Peter Makholm, <peter at makholm.net>

BUGS

Top

Please report any bugs or feature requests to bug-benchmark-serialize at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Benchmark-Serialize. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

ACKNOWLEDGEMENTS

Top

This module started out as a script written by Christian Hansen, see http://idisk.mac.com/christian.hansen/Public/perl/serialize.pl

COPYRIGHT & LICENSE

Top

Copyright 2009-2010 Peter Makholm.

This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

Benchmark-Serialize documentation Contained in the Benchmark-Serialize distribution. 
package Benchmark::Serialize::Library;

use strict;
use warnings;

use UNIVERSAL::require qw();
use Carp;


our $VERSION = '0.08';


my $benchmarks = {
    'AnyMongo::BSON' => {
        deflate => sub { AnyMongo::BSON::bson_encode( $_[0] )    },
        inflate => sub { AnyMongo::BSON::bson_decode( $_[0] )    },
    },
    'Bencode' => {
        deflate  => sub { Bencode::bencode($_[0])                },
        inflate  => sub { Bencode::bdecode($_[0])                }
    },    
    'Convert::Bencode' => {
        deflate  => sub { Convert::Bencode::bencode($_[0])       },
        inflate  => sub { Convert::Bencode::bdecode($_[0])       }
    },
    'Convert::Bencode_XS' => {
        deflate  => sub { Convert::Bencode_XS::bencode($_[0])    },
        inflate  => sub { Convert::Bencode_XS::bdecode($_[0])    }
    },
    'Data::asXML' => {
        deflate  => sub { Data::asXML->new(pretty=>0)->encode($_[0])->toString },
        inflate  => sub { Data::asXML->new(pretty=>0)->decode($_[0]) },
        xml      => 1,
    },
    'Data::Dumper' => {
        deflate  => sub { Data::Dumper->Dump([ $_[0] ])          },
        inflate  => sub { my $VAR1; eval $_[0]                   },
        default  => 1,
        core     => 1,
    },
    'Data::MessagePack' => {
        deflate  => sub { Data::MessagePack->pack($_[0])         },
        inflate  => sub { Data::MessagePack->unpack($_[0])       },
    },
    'Data::Taxi' => {
        deflate  => sub { Data::Taxi::freeze($_[0])              },
        inflate  => sub { Data::Taxi::thaw($_[0])                },
        xml      => 1,
    },
    'Data::Pond' => {
        deflate  => sub { Data::Pond::pond_write_datum($_[0])    },
        inflate  => sub { Data::Pond::pond_read_datum($_[0])     },
    },
    'Data::Pond,eval' => {
        deflate  => sub { Data::Pond::pond_write_datum($_[0])    },
        inflate  => sub { eval($_[0])                            },
        packages => ['Data::Pond'],
    },
    'FreezeThaw' => {
        deflate  => sub { FreezeThaw::freeze($_[0])              },
        inflate  => sub { FreezeThaw::thaw($_[0])                },
        default  => 1
    },
    'JSON::PP' => {
        deflate  => sub { JSON::PP::encode_json($_[0])           },
        inflate  => sub { JSON::PP::decode_json($_[0])           },
        default  => 1,
        json     => 1
    },
    'JSON::XS' => {
        deflate  => sub { JSON::XS::encode_json($_[0])           },
        inflate  => sub { JSON::XS::decode_json($_[0])           },
        default  => 1,
        json     => 1
    },
    'JSON::XS,pretty' => {
        deflate  => sub { $_[1]->encode( $_[0] ) },
        inflate  => sub { $_[1]->decode( $_[0] ) },
        args     => sub { JSON::XS->new->pretty(1)->allow_blessed(1)->convert_blessed(1)->canonical(1) },
        json     => 1,
        packages => ['JSON::XS'],
    },
    'JSON::DWIW' => {
        deflate  => sub { JSON::DWIW->to_json($_[0])             },
        inflate  => sub { JSON::DWIW::deserialize($_[0])         },
        json     => 1,
    },
    'JSYNC' => {
        deflate  => sub { JSYNC::dump($_[0])                     },
        inflate  => sub { JSYNC::load($_[0])                     },
    },
    'Storable' => {
        deflate  => sub { Storable::nfreeze($_[0])               },
        inflate  => sub { Storable::thaw($_[0])                  },
        default  => 1,
        core     => 1,
    },
    'PHP::Serialization' => {
        deflate  => sub { PHP::Serialization::serialize($_[0])   },
        inflate  => sub { PHP::Serialization::unserialize($_[0]) }
    },
    'PHP::Serialization::XS' => {
        deflate  => sub { PHP::Serialization::XS::serialize($_[0])   },
        inflate  => sub { PHP::Serialization::XS::unserialize($_[0]) }
    },
    'RPC::XML' => {
        deflate  => sub { RPC::XML::response->new($_[0])->as_string         },
        inflate  => sub { RPC::XML::ParserFactory->new->parse($_[0])->value },
        packages => ['RPC::XML', 'RPC::XML::ParserFactory'],
        xml      => 1,
    },
    'YAML::Old' => {
        deflate  => sub { YAML::Old::Dump($_[0])                 },
        inflate  => sub { YAML::Old::Load($_[0])                 },
        default  => 1,
        yaml     => 1
    },
    'YAML::XS' => {
        deflate  => sub { YAML::XS::Dump($_[0])                  },
        inflate  => sub { YAML::XS::Load($_[0])                  },
        default  => 1,
        yaml     => 1
    },
    'YAML::Tiny' => {
        deflate  => sub { YAML::Tiny::Dump($_[0])                },
        inflate  => sub { YAML::Tiny::Load($_[0])                },
        default  => 1,
        yaml     => 1
    },
    'XML::Simple' => {
        deflate  => sub { XML::Simple::XMLout($_[0])             },
        inflate  => sub { XML::Simple::XMLin($_[0])              },
        default  => 1,
        xml      => 1,
    },
    'XML::TreePP' => {
        deflate => sub { XML::TreePP->new()->write( $_[0] )      },
        inflate => sub { XML::TreePP->new()->parse( $_[0] )      },
        xml     => 1,
    },
};


sub register {
    my $class     = shift;
    my $name      = shift;
    my $benchmark = shift;

    croak "Missing deflate and/or inflate field"
        unless exists $benchmark->{deflate} && $benchmark->{inflate};

    croak "Existing benchmark"
	if exists $benchmarks->{$name};

    $benchmarks->{$name} = $benchmark;
    return 1;
}   


sub load {
    my $class = shift;

    my %benchmark;
    for my $spec (@_) {
        if ( ref $spec eq "HASH" ) {
            $benchmark{ $spec->{name} } = $spec; 

        } elsif ( $spec eq "all" or $spec eq ":all" ) {
            $benchmark { $_ } = $benchmarks->{ $_ } for keys %{ $benchmarks };
        
        } elsif ( $spec eq "default" ) {
            $benchmark{ $_ } = $benchmarks->{ $_ } for grep { $benchmarks->{ $_ }->{default} } keys %{ $benchmarks };
        
        } elsif ( $spec =~ /^:(.*)/ ) {
            $benchmark{ $_ } = $benchmarks->{ $_ } for grep { $benchmarks->{ $_ }->{$1} } keys %{ $benchmarks };
        
        } elsif ( exists $benchmarks->{ $spec } ) {
            $benchmark{ $spec } = $benchmarks->{ $spec }
        
        } else {
            warn "Unknown benchmark '$spec'.";
        }
    }

    my @list;
    BENCHMARK:
    foreach my $name ( keys %benchmark ) {

        my $benchmark = $benchmark{$name};
        my @packages  = ( exists($benchmark->{packages}) ? @{ $benchmark->{packages} } : $name );
        
        $_->require or next BENCHMARK for @packages;

        $benchmark->{args} = [ $benchmark->{args}->() ] if exists $benchmark->{args}
                                                        && ref $benchmark->{args} eq "CODE";

	$benchmark->{name}    = $name;
        $benchmark->{version} = $packages[0]->VERSION;

	push @list, bless $benchmark, "Benchmark::Serialize::Benchmark";
    }

    return @list;
}


sub list {
    return map { [ $_->name, $_->version ] } Benchmark::Serialize::Library->load(":all");
} 


package Benchmark::Serialize::Benchmark;


sub deflate {
    $_[0]->{deflate}->($_[1], @{ $_[0]->{args} } );
}


sub inflate {
    $_[0]->{inflate}->($_[1], @{ $_[0]->{args} } );
}


sub name {
    my $self = shift;

    return $self->{name};
}


sub version {
    my $self = shift;

    return $self->{version};
}


1;