libanyevent-serialize-perl-0.04/0000775000000000000000000000000011533517746015416 5ustar rootrootlibanyevent-serialize-perl-0.04/README0000644000000000000000000000225511524255352016270 0ustar rootrootAnyEvent-Serialize version 0.01 =============================== The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: blah blah blah COPYRIGHT AND LICENCE Put the correct copyright and licence information here. Copyright (C) 2011 by Dmitry E. Oboukhov This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available. libanyevent-serialize-perl-0.04/Makefile.PL0000644000000000000000000000206211527745166017370 0ustar rootrootuse 5.010001; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'AnyEvent::Serialize', VERSION_FROM => 'lib/AnyEvent/Serialize.pm', # finds $VERSION PREREQ_PM => { 'Data::StreamSerializer' => '0.05', 'Data::StreamDeserializer' => 0, 'AnyEvent' => 0, 'AnyEvent::AggressiveIdle' => '0.01', }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/AnyEvent/Serialize.pm', # retrieve abstract from module AUTHOR => 'Dmitry E. Oboukhov ') : ()), LIBS => [''], # e.g., '-lm' DEFINE => '', # e.g., '-DHAVE_SOMETHING' INC => '-I.', # e.g., '-I. -I/usr/include/other' # Un-comment this if you add C files to link with later: # OBJECT => '$(O_FILES)', # link all the C files too ); libanyevent-serialize-perl-0.04/t/0000775000000000000000000000000011527745502015655 5ustar rootrootlibanyevent-serialize-perl-0.04/t/serialize.t0000644000000000000000000000723211527745502020033 0ustar rootrootuse warnings; use strict; use Time::HiRes qw(time); use Data::Dumper; use AnyEvent; local $Data::Dumper::Indent = 0; local $Data::Dumper::Terse = 1; local $Data::Dumper::Useqq = 1; local $Data::Dumper::Deepcopy = 1; use Test::More tests => 54; BEGIN { use_ok 'AnyEvent'; use_ok('AnyEvent::Serialize', ':all', 'block_size' => 10); }; sub rand_array($); sub compare_object($$); sub rand_hash($); my @a; for (0 .. 9) { push @a, (50 < rand 100) ? rand_hash 6 : rand_array 6; # push @a, (50 < rand 100) ? [1,2] : {1,2}; } $_ = { str => Dumper($_), orig => $_ } for @a; { my $counter = 0; my $cv = condvar AnyEvent; my (@res, @sres); for my $i (0 .. $#a) { deserialize $a[$i]{str} => sub { $res[$i] = { obj => \@_, time => time, order => $counter++ }; $cv->send if $counter == @a * 2; }; serialize $a[$i]{orig} => sub { my ($s, $rd) = @_; $sres[$i] = { str => $s, recursion => $rd, time => time, order => $counter++ }; $cv->send if $counter == @a * 2; }; } $cv->recv; for (0 .. $#res) { ok compare_object($res[$_]{obj}[0], $a[$_]{orig}), "$_: object deserialized"; ok !$res[$_]{obj}[1], "$_: no error detected"; ok !$res[$_]{obj}[2], "$_: undeserialized tail is empty"; my $dsr = eval $sres[$_]{str}; ok compare_object($dsr, $a[$_]{orig}), "$_: object serialized"; ok !$sres[$_]{recursion}, "$_: no recursion detected"; } ok grep({$res[$_]{time} < $res[$_+1]{time} } 0 .. $#res - 1) > 0, "Random finish time"; ok grep({$res[$_]{order} < $res[$_+1]{order} } 0 .. $#res - 1) > 0, "Random order"; } sub rand_string() { my $rstr = ''; my @letters = ( qw(й ц у к е н г ш щ з х ъ ф ы в а п р о л д ж э я ч с м и т ь б ю), map { chr $_ } 0x20 .. 0x7e ); $rstr .= $letters[rand @letters] for 0 .. -1 + int rand 20; return $rstr; } sub rand_hash($) { my ($deep) = @_; my %h; return rand_string if $deep <= 0; for ( 0 .. $deep ) { my $key = rand_string; if (3 > rand 10) { $h{$key} = rand_string; } elsif (5 > rand 10) { $h{$key} = rand_hash($deep - 1); } else { $h{$key} = rand_array($deep - 1); } } return \%h; } sub rand_array($) { my @array; my ($count) = @_; return rand_string if $count <= 0; for (0 .. $count) { if (3 > rand 10) { push @array, rand_string; } elsif (5 > rand 10) { push @array, rand_hash($count - 1); } else { push @array, rand_array($count - 1); } } return \@array; } sub compare_object($$) { my ($o1, $o2) = @_; return 0 unless ref($o1) eq ref $o2; return $o1 eq $o2 unless ref $o1; # SCALAR return compare_object $$o1, $$o2 if 'SCALAR' eq ref $o1; # SCALARREF return compare_object $$o1, $$o2 if 'REF' eq ref $o1; # REF if ('ARRAY' eq ref $o1) { return 0 unless @$o1 == @$o2; for (0 .. $#$o1) { return 0 unless compare_object $o1->[$_], $o2->[$_]; } return 1; } if ('HASH' eq ref $o1) { return 0 unless keys(%$o1) == keys %$o2; for (keys %$o1) { return 0 unless exists $o2->{$_}; return 0 unless compare_object $o1->{$_}, $o2->{$_}; } return 1; } die ref $o1; } libanyevent-serialize-perl-0.04/MANIFEST0000664000000000000000000000023011533426040016524 0ustar rootrootChanges debian/changelog debian/compat debian/control debian/copyright debian/rules lib/AnyEvent/Serialize.pm Makefile.PL MANIFEST README t/serialize.t libanyevent-serialize-perl-0.04/Changes0000644000000000000000000000046211533425565016706 0ustar rootrootRevision history for Perl extension AnyEvent::Serialize. 0.01 Tue Feb 8 18:02:02 2011 - original version; created by h2xs 1.23 with options -n AnyEvent::Serialize 0.02 Thu Feb 10 09:08:45 MSK 2011 - add version depend on StreamSerializer 0.04 Wed Mar 2 14:35:04 MSK 2011 - use aggressive_idle libanyevent-serialize-perl-0.04/lib/0000775000000000000000000000000011524255352016154 5ustar rootrootlibanyevent-serialize-perl-0.04/lib/AnyEvent/0000775000000000000000000000000011533425473017710 5ustar rootrootlibanyevent-serialize-perl-0.04/lib/AnyEvent/Serialize.pm0000644000000000000000000001064611533425473022202 0ustar rootrootpackage AnyEvent::Serialize; use 5.010001; use strict; use warnings; use Carp; require Exporter; use AnyEvent::AggressiveIdle qw(aggressive_idle stop_aggressive_idle); our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use AnyEvent::Serialize ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw(serialize deserialize) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw(); our $VERSION = '0.04'; our $block_size = 1024; sub import { my ($class, @arg) = @_; for (reverse 0 .. $#arg - 1) { next unless $arg[$_] eq 'block_size'; my $bs = $arg[$_ + 1]; croak "Usage: use AnyEvent::Serialize block_size => 512 ..." unless $bs > 0; $block_size = $bs; splice @arg, $_, 2; last; } return $class->export_to_level(1, $class, @arg); } sub serialize($&) { require Data::StreamSerializer; no warnings 'redefine'; no strict 'refs'; *{ __PACKAGE__ . '::serialize' } = sub ($&) { my ($obj, $cb) = @_; my $sr = new Data::StreamSerializer $obj; $sr->block_size($block_size); my $str = $sr->next; if ($sr->is_eof()) { $cb->($str, $sr->recursion_detected); return; } aggressive_idle { my $pid = shift; my $part = $sr->next; $str .= $part if defined $part; if ($sr->is_eof) { stop_aggressive_idle $pid; $cb->($str, $sr->recursion_detected); } }; }; goto &serialize; } sub deserialize($&) { require Data::StreamDeserializer; no warnings 'redefine'; no strict 'refs'; *{ __PACKAGE__ . '::deserialize' } = sub ($&) { my ($data, $cb) = @_; my $dsr = new Data::StreamDeserializer data => $data, block_size => $block_size; if ($dsr->next_object) { $cb->($dsr->result, $dsr->error, $dsr->tail); return; } aggressive_idle { my $pid = shift; return unless $dsr->next; stop_aggressive_idle($pid); $cb->($dsr->result('first'), $dsr->error, $dsr->tail); }; }; goto &deserialize; } 1; __END__ =head1 NAME AnyEvent::Serialize - async serialize/deserialize function =head1 SYNOPSIS use AnyEvent::Serialize ':all'; use AnyEvent::Serialize 'serialize'; use AnyEvent::Serialize 'deserialize'; use AnyEvent::Serialize ... block_size => 666; serialize $object, sub { ($str, $recursion_detected) = @_ }; deserialize $string, sub { my ($object, $error, $tail) = @_ } =head1 DESCRIPTION Sometimes You need to serialize/deserialize a lot of data. If You do it using L or B it can take You too much time. This module splits (de)serialization process into fixed-size parts and does this work in non-blocking mode. This module uses L and L to serialize or deserialize Your data. =head1 EXPORT =head2 serialize($object, $result_callback) Serializes Your object. When serialization is done it will call B<$result_callback>. This callback receives two arguments: =over =item result string =item flag if recursion is detected =back =head2 deserialize($str, $result_callback) Deserializes Your string. When deserialization is done or an error is detected it will call B<$result_callback>. This callback receives three arguments: =over =item deserialized object =item error string (if an error was occured) =item undeserialized string tail =back =head1 BREAKING You can break serialization/deserialization process if You save value that is returned by functions L/L. They return guards if they are called in non-void context. =head1 SEE ALSO L, L. =head1 AUTHOR Dmitry E. Oboukhov, Eunera@debian.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2011 by Dmitry E. Oboukhov This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available. =cut