@@ -36,6 +36,9 @@ my $build = Module::Build->new
'JSON::Syck' => 0,
'XML::Simple' => 0,
'XML::Dumper' => 0,
+ 'Bencode' => 0,
+ 'Convert::Bencode' => 0,
+ 'Convert::Bencode_XS' => 0,
'Compress::Zlib' => 0,
'Compress::PPMd' => 0,
'MIME::Base64' => 0,
@@ -1,5 +1,26 @@
Revision history for Perl extension Data::Serializer
+0.56 Fri Jan 14 2011
+ - Moved store/retrieve internals to Data::Serializer::Persistent (internals only)
+ This defers the inclusion of IO::File to happen only if store or retrieve is called
+ - Added store/retireve to Data::Serializer::Raw
+
+0.55 Fri Jan 14 2011
+ - Added support for Bencode, Convert::Bencode, and Convert::Bencode_XS
+ - Documentation updates
+
+0.54 Thu Jan 13 2011
+ - Added Data::Serializer::Raw as a lightweight means of providing a unified raw access to the underlying serializers
+ also improved caching of serializer object inside of Data::Serializer
+ Thanks to Peter Makholm <peter@makholm.net> for the profiling done by Benchmark::Serialize
+
+0.53 Mon Jan 10 2011
+ - Modified tests for XML::Simple - it has sub-dependencies on either XML::Parser or XML::SAX
+ the test harness was posting a failure if neither of these were present. Now it will treat XML::Simple
+ as if it weren't installed if it is missing it's own depenencies. This version only modifies the test harness
+ no modification to module code.
+ Thanks to the cpantesters automated reporting for finding this.
+
0.52 Mon Jan 3 2011
- Simplfied object by removing %_internal references, base $serializer object is much simpler now.
This eliminated the need for an overridden DESTROY method, and should truly fix the memory leak
@@ -7,6 +7,8 @@ INSTALL
Build.PL
Makefile.PL
lib/Data/Serializer.pm
+lib/Data/Serializer/Raw.pm
+lib/Data/Serializer/Persistent.pm
lib/Data/Serializer/Storable.pm
lib/Data/Serializer/FreezeThaw.pm
lib/Data/Serializer/Data/Dumper.pm
@@ -20,6 +22,9 @@ lib/Data/Serializer/XML/Dumper.pm
lib/Data/Serializer/XML/Simple.pm
lib/Data/Serializer/Cookbook.pm
lib/Data/Serializer/JSON.pm
+lib/Data/Serializer/Bencode.pm
+lib/Data/Serializer/Convert/Bencode.pm
+lib/Data/Serializer/Convert/Bencode_XS.pm
lib/Data/Serializer/JSON/Syck.pm
t/ExtUtils/TBone.pm
t/00-01-Signature.t
@@ -37,7 +42,11 @@ t/01-10-Data-Taxi.t
t/01-11-YAML-Syck.t
t/01-12-JSON.t
t/01-13-JSON-Syck.t
-t/02-Raw.t
+t/01-14-Bencode.t
+t/01-15-Convert-Bencode.t
+t/01-16-Convert-Bencode_XS.t
+t/02-01-Orig-Raw.t
+t/02-02-Fast-Raw.t
t/03-Non-Portable.t
t/04-01-Compress-Zlib.t
t/04-02-Compress-PPMd.t
@@ -17,13 +17,22 @@ name: Data-Serializer
provides:
Data::Serializer:
file: lib/Data/Serializer.pm
- version: 0.52
+ version: 0.56
+ Data::Serializer::Bencode:
+ file: lib/Data/Serializer/Bencode.pm
+ version: 0.03
Data::Serializer::Config::General:
file: lib/Data/Serializer/Config/General.pm
version: 0.02
+ Data::Serializer::Convert::Bencode:
+ file: lib/Data/Serializer/Convert/Bencode.pm
+ version: 0.03
+ Data::Serializer::Convert::Bencode_XS:
+ file: lib/Data/Serializer/Convert/Bencode_XS.pm
+ version: 0.03
Data::Serializer::Cookbook:
file: lib/Data/Serializer/Cookbook.pm
- version: 0.04
+ version: 0.05
Data::Serializer::Data::Denter:
file: lib/Data/Serializer/Data/Denter.pm
version: 0.02
@@ -45,6 +54,12 @@ provides:
Data::Serializer::PHP::Serialization:
file: lib/Data/Serializer/PHP/Serialization.pm
version: 0.02
+ Data::Serializer::Persistent:
+ file: lib/Data/Serializer/Persistent.pm
+ version: 0.01
+ Data::Serializer::Raw:
+ file: lib/Data/Serializer/Raw.pm
+ version: 0.02
Data::Serializer::Storable:
file: lib/Data/Serializer/Storable.pm
version: 0.03
@@ -61,9 +76,12 @@ provides:
file: lib/Data/Serializer/YAML/Syck.pm
version: 0.02
recommends:
+ Bencode: 0
Compress::PPMd: 0
Compress::Zlib: 0
Config::General: 0
+ Convert::Bencode: 0
+ Convert::Bencode_XS: 0
Crypt::Blowfish: 0
Crypt::CBC: 0
Data::Denter: 0
@@ -87,4 +105,4 @@ requires:
IO::File: 0
resources:
license: http://dev.perl.org/licenses/
-version: 0.52
+version: 0.56
@@ -23,6 +23,12 @@ DESCRIPTION
currently available. Adds the functionality of both compression and
encryption.
+ By default Data::Serializer(3) adds minor metadata and encodes
+ serialized data structures in it's own format. If you are looking for a
+ simple unified pass through interface to the underlying serializers then
+ look into Data::Serializer::Raw(3) that comes bundled with
+ Data::Serializer(3).
+
EXAMPLES
Please see Data::Serializer::Cookbook(3)
@@ -41,7 +47,7 @@ METHODS
options => {},
);
- new is the constructor object for Data::Serializer objects.
+ new is the constructor object for Data::Serializer(3) objects.
* The default *serializer* is "Data::Dumper"
@@ -90,18 +96,24 @@ METHODS
This is a straight pass through to the underlying serializer,
nothing else is done. (no encoding, encryption, compression, etc)
+ If you desire this functionality you should look at
+ Data::Serializer::Raw(3) instead, it is faster and leaner.
+
raw_deserialize - deserialize reference in raw form
$deserialized = $obj->raw_deserialize($serialized);
This is a straight pass through to the underlying serializer,
nothing else is done. (no encoding, encryption, compression, etc)
+ If you desire this functionality you should look at
+ Data::Serializer::Raw(3) instead, it is faster and leaner.
+
secret - specify secret for use with encryption
$obj->secret('mysecret');
- Changes setting of secret for the Data::Serializer object. Can also
- be set in the constructor. If specified than the object will utilize
- encryption.
+ Changes setting of secret for the Data::Serializer(3) object. Can
+ also be set in the constructor. If specified than the object will
+ utilize encryption.
portable - encodes/decodes serialized data
Uses encoding method to ascii armor serialized data
@@ -118,10 +130,28 @@ METHODS
to work in raw mode (see raw_serializer and raw_deserializer). The
default is for this to be off.
+ If you desire this functionality you should look at
+ Data::Serializer::Raw(3) instead, it is faster and leaner.
+
serializer - change the serializer
- Currently have 8 supported serializers: Storable, FreezeThaw,
- Data::Denter, Config::General, YAML, PHP::Serialization,
- XML::Dumper, and Data::Dumper.
+ Currently supports the following serializers:
+
+ Bencode(3)
+ Convert::Bencode(3)
+ Convert::Bencode_XS(3)
+ Config::General(3)
+ Data::Denter(3)
+ Data::Dumper(3)
+ Data::Taxi(3)
+ FreezeThaw(3)
+ JSON(3)
+ JSON::Syck(3)
+ PHP::Serialization(3)
+ Storable(3)
+ XML::Dumper(3)
+ XML::Simple(3)
+ YAML(3)
+ YAML::Syck(3)
Default is to use Data::Dumper.
@@ -131,32 +161,34 @@ METHODS
information.
cipher - change the cipher method
- Utilizes Crypt::CBC and can support any cipher method that it
+ Utilizes Crypt::CBC(3) and can support any cipher method that it
supports.
digester - change digesting method
- Uses Digest so can support any digesting method that it supports.
+ Uses Digest(3) so can support any digesting method that it supports.
Digesting function is used internally by the encryption routine as
part of data verification.
compressor - changes compresing module
- Currently Compress::Zlib and Compress::PPMd are the only options
+ Currently Compress::Zlib(3) and Compress::PPMd(3) are the only
+ options
encoding - change encoding method
Encodes data structure in ascii friendly manner. Currently the only
valid options are hex, or b64.
- The b64 option uses Base64 encoding provided by MIME::Base64, but
+ The b64 option uses Base64 encoding provided by MIME::Base64(3), but
strips out newlines.
serializer_token - add usage hint to data
- Data::Serializer prepends a token that identifies what was used to
- process its data. This is used internally to allow runtime
- determination of how to extract Serialized data. Disabling this
- feature is not recommended.
+ Data::Serializer(3) prepends a token that identifies what was used
+ to process its data. This is used internally to allow runtime
+ determination of how to extract serialized data. Disabling this
+ feature is not recommended. (Use Data::Serializer::Raw(3) instead).
options - pass options through to underlying serializer
- Currently is only supported by Config::General, and XML::Dumper.
+ Currently is only supported by Config::General(3), and
+ XML::Dumper(3).
my $obj = Data::Serializer->new(serializer => 'Config::General',
options => {
@@ -210,7 +242,7 @@ AUTHOR
BUGS
Please report all bugs here:
- http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Serializer
+ http://rt.cpan.org/Public/Dist/Display.html?Name=Data-Serializer
TODO
Extend the persistent framework. Perhaps Persistent::Base(3) framework
@@ -218,7 +250,7 @@ TODO
would be welcome.
COPYRIGHT AND LICENSE
- Copyright (c) 2001-2008 Neil Neely. All rights reserved.
+ Copyright (c) 2001-2011 Neil Neely. All rights reserved.
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself, either Perl version 5.8.2 or, at
@@ -227,8 +259,8 @@ COPYRIGHT AND LICENSE
See http://www.perl.com/language/misc/Artistic.html
ACKNOWLEDGEMENTS
- Gurusamy Sarathy and Raphael Manfredi for writing MLDBM, the module
- which inspired the creation of Data::Serializer.
+ Gurusamy Sarathy and Raphael Manfredi for writing MLDBM(3), the module
+ which inspired the creation of Data::Serializer(3).
And thanks to all of you who have provided the feedback that has
improved this module over the years.
@@ -240,23 +272,28 @@ DEDICATION
This module is dedicated to my beautiful wife Erica.
SEE ALSO
- Data::Dumper(3)
+ Bencode(3)
+ Convert::Bencode(3)
+ Convert::Bencode_XS(3)
+ Config::General(3)
Data::Denter(3)
+ Data::Dumper(3)
Data::Taxi(3)
- Storable(3)
FreezeThaw(3)
- Config::General(3)
- YAML(3)
- YAML::Syck(3)
- PHP::Serialization(3)
- XML::Dumper(3)
JSON(3)
JSON::Syck(3)
+ PHP::Serialization(3)
+ Storable(3)
+ XML::Dumper(3)
+ XML::Simple(3)
+ YAML(3)
+ YAML::Syck(3)
Compress::Zlib(3)
Compress::PPMd(3)
Digest(3)
Digest::SHA(3)
- Crypt(3)
+ Crypt::CBC(3)
MIME::Base64(3)
IO::File(3)
+ Data::Serializer::Config::Wrest(3) - adds supports for Config::Wrest(3)
@@ -15,6 +15,17 @@ CONVENTIONS
Some examples will show different arguments to the new method, where
specified simply use that line instead of the simple form above.
+CONVENTIONS for Raw Access
+ Fort hose who want a straight pass through to the underlying serializer,
+ where nothing else is done (no encoding, encryption, compression, etc)
+ there is Data::Serializer::Raw(3).
+
+ These begin like this:
+
+ use Data::Serializer::Raw;
+
+ my $raw_serializer = Data::Serializer::Raw->new();
+
Encrypting your data
You wish to encrypt your data structure, so that it can only be decoded
by someone who shares the same key.
@@ -56,12 +67,11 @@ You want to read in data serialized outside of Data::Serializer
to process data serialized by XML::Dumper.
Solution
- my $xml_serializer = Data::Serializer->(serializer => 'XML::Dumper', raw => 1);
+ use Data::Serializer::Raw;
- my $hash_ref = $serializer->deserialize($xml_data);
+ my $xml_raw_serializer = Data::Serializer::Raw->(serializer => 'XML::Dumper');
- Note: the raw_deserialize method can be used as well, but the above
- approach is preferred.
+ my $hash_ref = $xml_raw_serializer->deserialize($xml_data);
You want to write serialized data in a form understood outside of Data::Serializer
You need to write a program that can write out data in a format other
@@ -70,25 +80,26 @@ You want to write serialized data in a form understood outside of Data::Serializ
we will be exporting data using XML::Dumper format.
Solution
- my $xml_serializer = Data::Serializer->(serializer => 'XML::Dumper', raw => 1);
+ ues Data::Serializer::Raw;
- my $xml_data = $serializer->serialize($hash_ref);
+ my $xml_raw_serializer = Data::Serializer::Raw->(serializer => 'XML::Dumper');
- Note: the raw_serialize method can be used as well, but the above
- approach is preferred.
+ my $xml_data = $xml_raw_serializer->serialize($hash_ref);
You want to convert data between two different serializers native formats
You have data serialized by php that you want to convert to xml for use
by other programs.
Solution
- my $xml_serializer = Data::Serializer->(serializer => 'XML::Dumper', raw => 1);
+ use Data::Serializer::Raw;
+
+ my $xml_raw_serializer = Data::Serializer::Raw->(serializer => 'XML::Dumper');
- my $php_serializer = Data::Serializer->(serializer => 'PHP::Serialization', raw => 1);
+ my $php_raw_serializer = Data::Serializer::Raw->(serializer => 'PHP::Serialization');
- my $hash_ref = $php_serializer->deserialize($php_data);
+ my $hash_ref = $php_raw_serializer->deserialize($php_data);
- my $xml_data = $xml_serializer->serialize($hash_ref);
+ my $xml_data = $xml_raw_serializer->serialize($hash_ref);
Keeping data persistent between executions of a program.
You have a program that you run every 10 minutes, it uses SNMP to pull
@@ -116,11 +127,12 @@ AUTHOR
Neil Neely <neil@neely.cx>.
COPYRIGHT
- Copyright (c) 2001-2008 Neil Neely. All rights reserved.
+ Copyright (c) 2001-2011 Neil Neely. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
SEE ALSO
Data::Serializer(3)
+ Data::Serializer::Raw(3)
@@ -0,0 +1,71 @@
+package Data::Serializer::Bencode;
+BEGIN { @Data::Serializer::Bencode::ISA = qw(Data::Serializer) }
+
+use warnings;
+use strict;
+use Bencode;
+use vars qw($VERSION @ISA);
+
+$VERSION = '0.03';
+
+sub serialize {
+ return Bencode::bencode($_[1]);
+}
+
+sub deserialize {
+ return Bencode::bdecode($_[1]);
+}
+
+1;
+__END__
+
+
+
+=head1 NAME
+
+Data::Serializer::Bencode - Creates bridge between Data::Serializer and Bencode
+
+=head1 SYNOPSIS
+
+ use Data::Serializer::Bencode;
+
+=head1 DESCRIPTION
+
+Module is used internally to Data::Serializer
+
+=over 4
+
+=item B<serialize> - Wrapper to normalize serializer method name
+
+=item B<deserialize> - Wrapper to normalize deserializer method name
+
+
+=back
+
+=head1 AUTHOR
+
+Neil Neely <F<neil@neely.cx>>.
+
+http://neil-neely.blogspot.com/
+
+=head1 BUGS
+
+Please report all bugs here:
+
+http://rt.cpan.org/Public/Dist/Display.html?Name=Data-Serializer
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2011 Neil Neely. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+=head1 SEE ALSO
+
+perl(1), Data::Serializer(3), Bencode(3).
+
+=cut
+
@@ -0,0 +1,71 @@
+package Data::Serializer::Convert::Bencode;
+BEGIN { @Data::Serializer::Convert::Bencode::ISA = qw(Data::Serializer) }
+
+use warnings;
+use strict;
+use Convert::Bencode;
+use vars qw($VERSION @ISA);
+
+$VERSION = '0.03';
+
+sub serialize {
+ return Convert::Bencode::bencode($_[1]);
+}
+
+sub deserialize {
+ return Convert::Bencode::bdecode($_[1]);
+}
+
+1;
+__END__
+
+
+
+=head1 NAME
+
+Data::Serializer::Convert::Bencode - Creates bridge between Data::Serializer and Convert::Bencode
+
+=head1 SYNOPSIS
+
+ use Data::Serializer::Convert::Bencode;
+
+=head1 DESCRIPTION
+
+Module is used internally to Data::Serializer
+
+=over 4
+
+=item B<serialize> - Wrapper to normalize serializer method name
+
+=item B<deserialize> - Wrapper to normalize deserializer method name
+
+
+=back
+
+=head1 AUTHOR
+
+Neil Neely <F<neil@neely.cx>>.
+
+http://neil-neely.blogspot.com/
+
+=head1 BUGS
+
+Please report all bugs here:
+
+http://rt.cpan.org/Public/Dist/Display.html?Name=Data-Serializer
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2011 Neil Neely. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+=head1 SEE ALSO
+
+perl(1), Data::Serializer(3), Convert::Bencode(3).
+
+=cut
+
@@ -0,0 +1,71 @@
+package Data::Serializer::Convert::Bencode_XS;
+BEGIN { @Data::Serializer::Convert::Bencode_XS::ISA = qw(Data::Serializer) }
+
+use warnings;
+use strict;
+use Convert::Bencode_XS;
+use vars qw($VERSION @ISA);
+
+$VERSION = '0.03';
+
+sub serialize {
+ return Convert::Bencode_XS::bencode($_[1]);
+}
+
+sub deserialize {
+ return Convert::Bencode_XS::bdecode($_[1]);
+}
+
+1;
+__END__
+
+
+
+=head1 NAME
+
+Data::Serializer::Convert::Bencode_XS - Creates bridge between Data::Serializer and Convert::Bencode_XS
+
+=head1 SYNOPSIS
+
+ use Data::Serializer::Convert::Bencode_XS;
+
+=head1 DESCRIPTION
+
+Module is used internally to Data::Serializer
+
+=over 4
+
+=item B<serialize> - Wrapper to normalize serializer method name
+
+=item B<deserialize> - Wrapper to normalize deserializer method name
+
+
+=back
+
+=head1 AUTHOR
+
+Neil Neely <F<neil@neely.cx>>.
+
+http://neil-neely.blogspot.com/
+
+=head1 BUGS
+
+Please report all bugs here:
+
+http://rt.cpan.org/Public/Dist/Display.html?Name=Data-Serializer
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2011 Neil Neely. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+=head1 SEE ALSO
+
+perl(1), Data::Serializer(3), Convert::Bencode_XS(3).
+
+=cut
+
@@ -5,7 +5,7 @@ use warnings;
use strict;
use vars ('$VERSION');
-$VERSION = '0.04';
+$VERSION = '0.05';
1;
@@ -35,6 +35,18 @@ begin with:
Some examples will show different arguments to the B<new> method,
where specified simply use that line instead of the simple form above.
+=head1 CONVENTIONS for Raw Access
+
+Fort hose who want a straight pass through to the underlying serializer, where
+nothing else is done (no encoding, encryption, compression, etc) there is L<Data::Serializer::Raw(3)>.
+
+These begin like this:
+
+ use Data::Serializer::Raw;
+
+ my $raw_serializer = Data::Serializer::Raw->new();
+
+
=head1 Encrypting your data
You wish to encrypt your data structure, so that it can only be decoded
@@ -82,11 +94,11 @@ to be able to process data serialized by XML::Dumper.
=head2 Solution
- my $xml_serializer = Data::Serializer->(serializer => 'XML::Dumper', raw => 1);
+ use Data::Serializer::Raw;
- my $hash_ref = $serializer->deserialize($xml_data);
+ my $xml_raw_serializer = Data::Serializer::Raw->(serializer => 'XML::Dumper');
-Note: the raw_deserialize method can be used as well, but the above approach is preferred.
+ my $hash_ref = $xml_raw_serializer->deserialize($xml_data);
=head1 You want to write serialized data in a form understood outside of Data::Serializer
@@ -97,11 +109,12 @@ For our example we will be exporting data using XML::Dumper format.
=head2 Solution
- my $xml_serializer = Data::Serializer->(serializer => 'XML::Dumper', raw => 1);
+ ues Data::Serializer::Raw;
+
+ my $xml_raw_serializer = Data::Serializer::Raw->(serializer => 'XML::Dumper');
- my $xml_data = $serializer->serialize($hash_ref);
+ my $xml_data = $xml_raw_serializer->serialize($hash_ref);
-Note: the raw_serialize method can be used as well, but the above approach is preferred.
=head1 You want to convert data between two different serializers native formats
@@ -110,13 +123,15 @@ programs.
=head2 Solution
- my $xml_serializer = Data::Serializer->(serializer => 'XML::Dumper', raw => 1);
+ use Data::Serializer::Raw;
- my $php_serializer = Data::Serializer->(serializer => 'PHP::Serialization', raw => 1);
+ my $xml_raw_serializer = Data::Serializer::Raw->(serializer => 'XML::Dumper');
- my $hash_ref = $php_serializer->deserialize($php_data);
+ my $php_raw_serializer = Data::Serializer::Raw->(serializer => 'PHP::Serialization');
- my $xml_data = $xml_serializer->serialize($hash_ref);
+ my $hash_ref = $php_raw_serializer->deserialize($php_data);
+
+ my $xml_data = $xml_raw_serializer->serialize($hash_ref);
=head1 Keeping data persistent between executions of a program.
@@ -148,7 +163,7 @@ Neil Neely <F<neil@neely.cx>>.
=head1 COPYRIGHT
-Copyright (c) 2001-2008 Neil Neely. All rights reserved.
+Copyright (c) 2001-2011 Neil Neely. All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
@@ -160,6 +175,8 @@ and/or modify it under the same terms as Perl itself.
=item L<Data::Serializer(3)>
+=item L<Data::Serializer::Raw(3)>
+
=back
=cut
@@ -0,0 +1,115 @@
+package Data::Serializer::Persistent;
+
+use warnings;
+use strict;
+use vars qw($VERSION @ISA);
+use IO::File;
+
+use Carp;
+
+$VERSION = '0.01';
+
+sub _store {
+ my $self = (shift);
+ my $data = (shift);
+ my $file_or_fh = (shift);
+
+
+ if (ref($file_or_fh)) {
+ #it is a file handle so print straight to it
+ print $file_or_fh $self->{parent}->serialize($data), "\n";
+ #We didn't open the filehandle, so we shouldn't close it.
+ } else {
+ #it is a file, so open it
+ my ($mode,$perm) = @_;
+ unless (defined $mode) {
+ $mode = O_CREAT|O_WRONLY;
+ }
+ unless (defined $perm) {
+ $perm = 0600;
+ }
+ my $fh = new IO::File;
+ $fh->open($file_or_fh, $mode,$perm) || croak "Cannot write to $file_or_fh: $!";
+ print $fh $self->{parent}->serialize($data), "\n";
+ $fh->close();
+ }
+}
+
+sub _retrieve {
+ my $self = (shift);
+ my $file_or_fh = (shift);
+ if (ref($file_or_fh)) {
+ #it is a file handle so read straight from it
+ my $input = join('', <$file_or_fh>);
+ chomp($input);
+ return $self->{parent}->deserialize($input);
+ #We didn't open the filehandle, so we shouldn't close it.
+ } else {
+ my $fh = new IO::File;
+ $fh->open($file_or_fh, O_RDONLY) || croak "Cannot read from $file_or_fh: $!";
+ my $input = join('', <$fh>);
+ chomp($input);
+ $fh->close;
+ return $self->{parent}->deserialize($input);
+ }
+}
+
+
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+Data::Serializer::Persistent - Provide means of persistently storing serialized data in a file
+
+=head1 SYNOPSIS
+
+ use Data::Serializer::Persistent
+
+=head1 DESCRIPTION
+
+Used internally to L<Data::Serializer(3)>, does not currently have any public methods
+
+=head1 EXAMPLES
+
+=over 4
+
+=item Please see L<Data::Serializer::Cookbook(3)>
+
+=back
+
+=head1 METHODS
+
+=head1 AUTHOR
+
+Neil Neely <F<neil@neely.cx>>.
+
+http://neil-neely.blogspot.com/
+
+=head1 BUGS
+
+Please report all bugs here:
+
+http://rt.cpan.org/Public/Dist/Display.html?Name=Data-Serializer
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2011 Neil Neely. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+See http://www.perl.com/language/misc/Artistic.html
+
+=head1 SEE ALSO
+
+perl(1), Data::Serializer(3), IO::File(3).
+
+=cut
+
@@ -0,0 +1,340 @@
+package Data::Serializer::Raw;
+
+use warnings;
+use strict;
+use vars qw($VERSION);
+use Carp;
+
+$VERSION = '0.02';
+
+#Global cache of modules we've loaded
+my %_MODULES;
+
+my %_fields = (
+ serializer => 'Data::Dumper',
+ options => {},
+ );
+sub new {
+ my ($class, %args) = @_;
+ my $dataref = {%_fields};
+ foreach my $field (keys %_fields) {
+ $dataref->{$field} = $args{$field} if exists $args{$field};
+ }
+ my $self = $dataref;
+ bless $self, $class;
+
+ #initialize serializer
+ $self->_serializer_obj();
+
+ return $self;
+}
+
+sub serializer {
+ my $self = (shift);
+ my $return = $self->{serializer};
+ if (@_) {
+ $self->{serializer} = (shift);
+ #reinitialize serializer object
+ $self->_serializer_obj(1);
+ }
+ return $return;
+}
+
+sub options {
+ my $self = (shift);
+ my $return = $self->{options};
+ if (@_) {
+ $self->{options} = (shift);
+ #reinitialize serializer object
+ $self->_serializer_obj(1);
+ }
+ return $return;
+}
+
+sub _persistent_obj {
+ my $self = (shift);
+ return $self->{persistent_obj} if (exists $self->{persistent_obj});
+ $self->_module_loader('Data::Serializer::Persistent');
+ my $persistent_obj = { parent => $self };
+ bless $persistent_obj, "Data::Serializer::Persistent";
+ $self->{persistent_obj} = $persistent_obj;
+ return $persistent_obj;
+
+}
+
+sub store {
+ my $self = (shift);
+ my $persistent = $self->_persistent_obj();
+ $persistent->_store(@_);
+}
+
+sub retrieve {
+ my $self = (shift);
+ my $persistent = $self->_persistent_obj();
+ $persistent->_retrieve(@_);
+}
+
+
+sub _module_loader {
+ my $self = (shift);
+ my $module_name = (shift);
+ return if (exists $_MODULES{$module_name});
+ if (@_) {
+ $module_name = (shift) . "::$module_name";
+ }
+ my $package = $module_name;
+ $package =~ s|::|/|g;
+ $package .= ".pm";
+ eval { require $package };
+ if ($@) {
+ carp "Data::Serializer error: " .
+ "Please make sure $package is a properly installed package.\n";
+ return undef;
+ }
+ $_MODULES{$module_name} = 1;
+}
+
+sub _serializer_obj {
+ my $self = (shift);
+ #if anything is passed in remove previous obj so we will regenerate it
+ if (@_) {
+ delete $self->{serializer_obj};
+ }
+ #Return cached serializer object if it exists
+ return $self->{serializer_obj} if (exists $self->{serializer_obj});
+
+ my $method = $self->{serializer};
+ $self->_module_loader($method,"Data::Serializer"); #load in serializer module if necessary
+
+ $self->{serializer_obj}->{options} = $self->{options};
+ bless $self->{serializer_obj}, "Data::Serializer::$method";
+}
+
+sub serialize {
+ my $self = (shift);
+ my @input = @_;
+
+ return $self->_serializer_obj->serialize(@input);
+}
+
+
+sub deserialize {
+ my $self = (shift);
+ my $input = (shift);
+
+ return $self->_serializer_obj->deserialize($input);
+}
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+Data::Serializer::Raw - Provides unified raw interface to perl serializers
+
+=head1 SYNOPSIS
+
+ use Data::Serializer::Raw;
+
+ $obj = Data::Serializer::Raw->new();
+
+ $obj = Data::Serializer::Raw->new(serializer => 'Storable');
+
+ $serialized = $obj->serialize({a => [1,2,3],b => 5});
+ $deserialized = $obj->deserialize($serialized);
+
+ print "$deserialized->{b}\n";
+
+=head1 DESCRIPTION
+
+Provides a unified interface to the various serializing modules
+currently available.
+
+This is a straight pass through to the underlying serializer,
+nothing else is done. (no encoding, encryption, compression, etc)
+
+=head1 EXAMPLES
+
+=over 4
+
+=item Please see L<Data::Serializer::Cookbook(3)>
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item B<new> - constructor
+
+ $obj = Data::Serializer::Raw->new();
+
+
+ $obj = Data::Serializer::Raw->new(
+ serializer => 'Data::Dumper',
+ options => {},
+ );
+
+
+B<new> is the constructor object for Data::Serializer::Raw objects.
+
+=over 4
+
+=item
+
+The default I<serializer> is C<Data::Dumper>
+
+=item
+
+The default I<options> is C<{}> (pass nothing on to serializer)
+
+=back
+
+=item B<serialize> - serialize reference
+
+ $serialized = $obj->serialize({a => [1,2,3],b => 5});
+
+This is a straight pass through to the underlying serializer,
+nothing else is done. (no encoding, encryption, compression, etc)
+
+=item B<deserialize> - deserialize reference
+
+ $deserialized = $obj->deserialize($serialized);
+
+This is a straight pass through to the underlying serializer,
+nothing else is done. (no encoding, encryption, compression, etc)
+
+=item B<serializer> - change the serializer
+
+Currently supports the following serializers:
+
+=over 4
+
+=item L<Bencode(3)>
+
+=item L<Convert::Bencode(3)>
+
+=item L<Convert::Bencode_XS(3)>
+
+=item L<Config::General(3)>
+
+=item L<Data::Denter(3)>
+
+=item L<Data::Dumper(3)>
+
+=item L<Data::Taxi(3)>
+
+=item L<FreezeThaw(3)>
+
+=item L<JSON(3)>
+
+=item L<JSON::Syck(3)>
+
+=item L<PHP::Serialization(3)>
+
+=item L<Storable(3)>
+
+=item L<XML::Dumper(3)>
+
+=item L<XML::Simple(3)>
+
+=item L<YAML(3)>
+
+=item L<YAML::Syck(3)>
+
+=back
+
+Default is to use Data::Dumper.
+
+Each serializer has its own caveat's about usage especially when dealing with
+cyclical data structures or CODE references. Please see the appropriate
+documentation in those modules for further information.
+
+
+=item B<options> - pass options through to underlying serializer
+
+Currently is only supported by L<Config::General(3)>, and L<XML::Dumper(3)>.
+
+ my $obj = Data::Serializer::Raw->new(serializer => 'Config::General',
+ options => {
+ -LowerCaseNames => 1,
+ -UseApacheInclude => 1,
+ -MergeDuplicateBlocks => 1,
+ -AutoTrue => 1,
+ -InterPolateVars => 1
+ },
+ ) or die "$!\n";
+
+ or
+
+ my $obj = Data::Serializer::Raw->new(serializer => 'XML::Dumper',
+ options => { dtd => 1, }
+ ) or die "$!\n";
+
+=item B<store> - serialize data and write it to a file (or file handle)
+
+ $obj->store({a => [1,2,3],b => 5},$file, [$mode, $perm]);
+
+ or
+
+ $obj->store({a => [1,2,3],b => 5},$fh);
+
+
+Serializes the reference specified using the B<serialize> method
+and writes it out to the specified file or filehandle.
+
+If a file path is specified you may specify an optional mode and permission as the
+next two arguments. See L<IO::File> for examples.
+
+Trips an exception if it is unable to write to the specified file.
+
+=item B<retrieve> - read data from file (or file handle) and return it after deserialization
+
+ my $ref = $obj->retrieve($file);
+
+ or
+
+ my $ref = $obj->retrieve($fh);
+
+Reads first line of supplied file or filehandle and returns it deserialized.
+
+
+=back
+
+=head1 AUTHOR
+
+Neil Neely <F<neil@neely.cx>>.
+
+http://neil-neely.blogspot.com/
+
+=head1 BUGS
+
+Please report all bugs here:
+
+http://rt.cpan.org/Public/Dist/Display.html?Name=Data-Serializer
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2011 Neil Neely. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+See http://www.perl.com/language/misc/Artistic.html
+
+=head1 ACKNOWLEDGEMENTS
+
+Peter Makholm took the time to profile L<Data::Serializer(3)> and pointed out the value
+of having a very lean implementation that minimized overhead and just used the raw underlying serializers.
+
+=head1 SEE ALSO
+
+perl(1), Data::Serializer(3).
+
+=cut
+
@@ -2,24 +2,12 @@ package Data::Serializer;
use warnings;
use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use vars qw($VERSION);
use Carp;
-use IO::File;
require 5.004 ;
-require Exporter;
-#require AutoLoader;
-#@ISA = qw(Exporter AutoLoader);
-@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.
-
-@EXPORT = qw( );
-@EXPORT_OK = qw( );
-
-$VERSION = '0.52';
+$VERSION = '0.56';
#Global cache of modules we've loaded
my %_MODULES;
@@ -45,27 +33,68 @@ sub new {
}
my $self = $dataref;
bless $self, $class;
+
+ #preintitialize serializer object
+ $self->_serializer_obj();
return $self;
}
sub _serializer_obj {
- my $self = (shift);
- my $serializer;
- if (@_) {
- #if argument, then use it for serializing.
- $serializer = (shift);
+ my $self = (shift);
+ my $method = (shift);
+ my $reset = (shift);
+
+ my $serializer = $self->{serializer};
+
+ #remove cache if asked to
+ if ($reset) {
+ delete $self->{serializer_obj};
+ }
+
+ #If we're given the same method that we are already using, nothing to change
+ if (defined $method && $method ne $serializer) {
+ $serializer = $method;
} else {
- $serializer = $self->{serializer};
+ #safe to return our cached object if we have it
+ return $self->{serializer_obj} if (exists $self->{serializer_obj});
+ }
+
+ $self->_module_loader($serializer,"Data::Serializer"); #load in serializer module if necessary
+ my $serializer_obj = {};
+ $serializer_obj->{options} = $self->{options};
+ bless $serializer_obj, "Data::Serializer::$serializer";
+
+ #Cache it for later retrieval only if this is the default serializer for the object
+ #ugly logic to support legacy token method that would allow the base to have a different serializer
+ #than what it is reading
+
+ if ($serializer eq $self->{serializer}) {
+ $self->{serializer_obj} = $serializer_obj;
}
- $self->{serializer_obj}->{options} = $self->options();
- bless $self->{serializer_obj}, "Data::Serializer::$serializer";
+ return $serializer_obj;
+
+}
+
+sub _persistent_obj {
+ my $self = (shift);
+ return $self->{persistent_obj} if (exists $self->{persistent_obj});
+ $self->_module_loader('Data::Serializer::Persistent');
+ my $persistent_obj = { parent => $self };
+ bless $persistent_obj, "Data::Serializer::Persistent";
+ $self->{persistent_obj} = $persistent_obj;
+ return $persistent_obj;
+
}
+
+
sub serializer {
my $self = (shift);
my $return = $self->{serializer};
if (@_) {
$self->{serializer} = (shift);
+ #Reinitialize object
+ $self->_serializer_obj($self->{serializer}, 1);
}
return $return;
}
@@ -130,6 +159,8 @@ sub options {
my $return = $self->{options};
if (@_) {
$self->{options} = (shift);
+ #Reinitialize object
+ $self->_serializer_obj($self->{serializer}, 1);
}
return $return;
}
@@ -164,6 +195,9 @@ sub serializer_token {
sub _module_loader {
my $self = (shift);
my $module_name = (shift);
+ unless (defined $module_name) {
+ confess "Something wrong - module not defined! $! $@\n";
+ }
return if (exists $_MODULES{$module_name});
if (@_) {
$module_name = (shift) . "::$module_name";
@@ -183,74 +217,355 @@ sub _module_loader {
-#Documentation follows
-
-=pod
-
-=head1 NAME
-
-Data::Serializer:: - Modules that serialize data structures
-
-=head1 SYNOPSIS
-
- use Data::Serializer;
-
- $obj = Data::Serializer->new();
-
- $obj = Data::Serializer->new(
- serializer => 'Storable',
- digester => 'MD5',
- cipher => 'DES',
- secret => 'my secret',
- compress => 1,
- );
- $serialized = $obj->serialize({a => [1,2,3],b => 5});
- $deserialized = $obj->deserialize($serialized);
- print "$deserialized->{b}\n";
+sub _serialize {
+ my $self = (shift);
+ my @input = @{(shift)};#original @_
+ my $method = (shift);
+ $self->_module_loader($method,"Data::Serializer"); #load in serializer module if necessary
+ my $serializer_obj = $self->_serializer_obj($method);
+ return $serializer_obj->serialize(@input);
+}
-=head1 DESCRIPTION
+sub _compress {
+ my $self = (shift);
+ $self->_module_loader($self->compressor);
+ if ($self->compressor eq 'Compress::Zlib') {
+ return Compress::Zlib::compress((shift));
+ } elsif ($self->compressor eq 'Compress::PPMd') {
+ my $compressor = Compress::PPMd::Encoder->new();
+ return $compressor->encode((shift));
+ }
+}
+sub _decompress {
+ my $self = (shift);
+ $self->_module_loader($self->compressor);
+ if ($self->compressor eq 'Compress::Zlib') {
+ return Compress::Zlib::uncompress((shift));
+ } elsif ($self->compressor eq 'Compress::PPMd') {
+ my $compressor = Compress::PPMd::Decoder->new();
+ return $compressor->decode((shift));
+ }
+}
-Provides a unified interface to the various serializing modules
-currently available. Adds the functionality of both compression
-and encryption.
+sub _create_token {
+ my $self = (shift);
+ return '^' . join('|', @_) . '^';
+}
+sub _get_token {
+ my $self = (shift);
+ my $line = (shift);
+ #Should be anchored to beginning
+ #my ($token) = $line =~ /\^([^\^]+?)\^/;
+ my ($token) = $line =~ /^\^([^\^]{1,120}?)\^/;
+ return $token;
+}
+sub _extract_token {
+ my $self = (shift);
+ my $token = (shift);
+ return split('\|',$token);
+}
+sub _remove_token {
+ my $self = (shift);
+ my $line = (shift);
+ $line =~ s/^\^[^\^]{1,120}?\^//;
+ return $line;
+}
+sub _deserialize {
+ my $self = (shift);
+ my $input = (shift);
+ my $method = (shift);
+ $self->_module_loader($method,"Data::Serializer"); #load in serializer module if necessary
+ my $serializer_obj = $self->_serializer_obj($method);
+ $serializer_obj->deserialize($input);
+}
-=head1 EXAMPLES
+sub _encrypt {
+ my $self = (shift);
+ my $value = (shift);
+ my $cipher = (shift);
+ my $digester = (shift);
+ my $secret = $self->secret;
+ croak "Cannot encrypt: No secret provided!" unless defined $secret;
+ $self->_module_loader('Crypt::CBC');
+ my $digest = $self->_endigest($value,$digester);
+ my $cipher_obj = Crypt::CBC->new($secret,$cipher);
+ return $cipher_obj->encrypt($digest);
+}
+sub _decrypt {
+ my $self = (shift);
+ my $input = (shift);
+ my $cipher = (shift);
+ my $digester = (shift);
+ my $secret = $self->secret;
+ croak "Cannot encrypt: No secret provided!" unless defined $secret;
+ $self->_module_loader('Crypt::CBC');
+ my $cipher_obj = Crypt::CBC->new($secret,$cipher);
+ my $digest = $cipher_obj->decrypt($input);
+ return $self->_dedigest($digest,$digester);
+}
+sub _endigest {
+ my $self = (shift);
+ my $input = (shift);
+ my $digester = (shift);
+ $self->_module_loader('Digest');
+ my $digest = $self->_get_digest($input,$digester);
+ return "$digest=$input";
+}
+sub _dedigest {
+ my $self = (shift);
+ my $input = (shift);
+ my $digester = (shift);
+ $self->_module_loader('Digest');
+ #my ($old_digest) = $input =~ /^([^=]+?)=/;
+ $input =~ s/^([^=]+?)=//;
+ my $old_digest = $1;
+ return undef unless (defined $old_digest);
+ my $new_digest = $self->_get_digest($input,$digester);
+ return undef unless ($new_digest eq $old_digest);
+ return $input;
+}
+sub _get_digest {
+ my $self = (shift);
+ my $input = (shift);
+ my $digester = (shift);
+ my $ctx = Digest->new($digester);
+ $ctx->add($input);
+ return $ctx->hexdigest;
+}
+sub _enhex {
+ my $self = (shift);
+ return join('',unpack 'H*',(shift));
+}
+sub _dehex {
+ my $self = (shift);
+ return (pack'H*',(shift));
+}
-=over 4
+sub _enb64 {
+ my $self = (shift);
+ $self->_module_loader('MIME::Base64');
+ my $b64 = MIME::Base64::encode_base64( (shift), '' );
+ return $b64;
+}
-=item Please see L<Data::Serializer::Cookbook(3)>
-=back
+sub _deb64 {
+ my $self = (shift);
+ $self->_module_loader('MIME::Base64');
+ return MIME::Base64::decode_base64( (shift) );
+}
-=head1 METHODS
+# do all 3 stages
+sub freeze { (shift)->serialize(@_); }
+sub thaw { (shift)->deserialize(@_); }
-=over 4
+sub serialize {
+ my $self = (shift);
+ my ($serializer,$cipher,$digester,$encoding,$compressor) = ('','','','','');
-=item B<new> - constructor
+ if ($self->raw) {
+ return $self->raw_serialize(@_);
+ }
- $obj = Data::Serializer->new();
+ #we always serialize no matter what.
+ #define serializer for token
+ $serializer = $self->serializer;
+ my $value = $self->_serialize(\@_,$serializer);
- $obj = Data::Serializer->new(
- serializer => 'Data::Dumper',
- digester => 'SHA-256',
- cipher => 'Blowfish',
- secret => undef,
- portable => '1',
- compress => '0',
- serializer_token => '1',
- options => {},
- );
+ if ($self->compress) {
+ $compressor = $self->compressor;
+ $value = $self->_compress($value);
+ }
+ if (defined $self->secret) {
+ #define digester for token
+ $digester = $self->digester;
+ #define cipher for token
+ $cipher = $self->cipher;
+ $value = $self->_encrypt($value,$cipher,$digester);
+ }
+ if ($self->portable) {
+ $encoding = $self->encoding;
+ $value = $self->_encode($value);
+ }
+ if ($self->serializer_token) {
+ my $token = $self->_create_token($serializer,$cipher, $digester,$encoding,$compressor);
+ $value = $token . $value;
+ }
+ return $value;
+}
-B<new> is the constructor object for Data::Serializer objects.
+sub store {
+ my $self = (shift);
+ my $persistent = $self->_persistent_obj();
+ $persistent->_store(@_);
+}
-=over 4
+sub retrieve {
+ my $self = (shift);
+ my $persistent = $self->_persistent_obj();
+ $persistent->_retrieve(@_);
+}
-=item
+sub raw_serialize {
+ my $self = (shift);
+ my $serializer = $self->serializer;
+ return $self->_serialize(\@_,$serializer);
+}
-The default I<serializer> is C<Data::Dumper>
+sub _encode {
+ my $self = (shift);
+ my $value = (shift);
+ my $encoding = $self->encoding;
+ if ($encoding eq 'hex') {
+ return $self->_enhex($value);
+ } elsif ($encoding eq 'b64') {
+ return $self->_enb64($value);
+ } else {
+ croak "Unknown encoding method $encoding\n";
+ }
+}
+
+sub _decode {
+ my $self = (shift);
+ my $value = (shift);
+ my $encoding = (shift);
+ if ($encoding eq 'hex') {
+ return $self->_dehex($value);
+ } elsif ($encoding eq 'b64') {
+ return $self->_deb64($value);
+ } elsif ($encoding !~ /\S/) {
+ #quietly ignore empty encoding
+ return $value;
+ } else {
+ croak "Unknown encoding method $encoding\n";
+ }
+}
+
+sub raw_deserialize {
+ my $self = (shift);
+ my $serializer = $self->serializer;
+ return $self->_deserialize((shift),$serializer);
+}
+
+sub deserialize {
+ my $self = (shift);
+
+ if ($self->raw) {
+ return $self->raw_deserialize(@_);
+ }
+
+ my $value = (shift);
+ my $token = $self->_get_token($value);
+ my ($serializer,$cipher, $digester,$encoding, $compressor);
+ my $compress = $self->compress;
+ if (defined $token) {
+ ($serializer,$cipher, $digester,$encoding, $compressor) = $self->_extract_token($token);
+
+ #if compressor is defined and has a value then we must decompress it
+ $compress = 1 if ($compressor);
+ $value = $self->_remove_token($value);
+ } else {
+ $serializer = $self->serializer;
+ $cipher = $self->cipher;
+ $digester = $self->digester;
+ $compressor = $self->compressor;
+ if ($self->portable) {
+ $encoding = $self->encoding;
+ }
+ }
+ if (defined $encoding) {
+ $value = $self->_decode($value,$encoding);
+ }
+ if (defined $self->secret) {
+ $value = $self->_decrypt($value,$cipher,$digester);
+ }
+ if ($compress) {
+ $value = $self->_decompress($value);
+ }
+ #we always deserialize no matter what.
+ my @return = $self->_deserialize($value,$serializer);
+ return wantarray ? @return : $return[0];
+}
+
+1;
+__END__
+
+#Documentation follows
+
+=pod
+
+=head1 NAME
+
+Data::Serializer:: - Modules that serialize data structures
+
+=head1 SYNOPSIS
+
+ use Data::Serializer;
+
+ $obj = Data::Serializer->new();
+
+ $obj = Data::Serializer->new(
+ serializer => 'Storable',
+ digester => 'MD5',
+ cipher => 'DES',
+ secret => 'my secret',
+ compress => 1,
+ );
+
+ $serialized = $obj->serialize({a => [1,2,3],b => 5});
+ $deserialized = $obj->deserialize($serialized);
+ print "$deserialized->{b}\n";
+
+=head1 DESCRIPTION
+
+Provides a unified interface to the various serializing modules
+currently available. Adds the functionality of both compression
+and encryption.
+
+By default L<Data::Serializer(3)> adds minor metadata and encodes serialized data
+structures in it's own format. If you are looking for a simple unified
+pass through interface to the underlying serializers then look into L<Data::Serializer::Raw(3)>
+that comes bundled with L<Data::Serializer(3)>.
+
+=head1 EXAMPLES
+
+=over 4
+
+=item Please see L<Data::Serializer::Cookbook(3)>
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item B<new> - constructor
+
+ $obj = Data::Serializer->new();
+
+
+ $obj = Data::Serializer->new(
+ serializer => 'Data::Dumper',
+ digester => 'SHA-256',
+ cipher => 'Blowfish',
+ secret => undef,
+ portable => '1',
+ compress => '0',
+ serializer_token => '1',
+ options => {},
+ );
+
+
+B<new> is the constructor object for L<Data::Serializer(3)> objects.
+
+=over 4
+
+=item
+
+The default I<serializer> is C<Data::Dumper>
=item
@@ -322,6 +637,9 @@ of the original serialized reference.
This is a straight pass through to the underlying serializer,
nothing else is done. (no encoding, encryption, compression, etc)
+If you desire this functionality you should look at L<Data::Serializer::Raw(3)> instead, it is
+faster and leaner.
+
=item B<raw_deserialize> - deserialize reference in raw form
$deserialized = $obj->raw_deserialize($serialized);
@@ -329,11 +647,14 @@ nothing else is done. (no encoding, encryption, compression, etc)
This is a straight pass through to the underlying serializer,
nothing else is done. (no encoding, encryption, compression, etc)
+If you desire this functionality you should look at L<Data::Serializer::Raw(3)> instead, it is
+faster and leaner.
+
=item B<secret> - specify secret for use with encryption
$obj->secret('mysecret');
-Changes setting of secret for the Data::Serializer object. Can also be set
+Changes setting of secret for the L<Data::Serializer(3)> object. Can also be set
in the constructor. If specified than the object will utilize encryption.
=item B<portable> - encodes/decodes serialized data
@@ -352,46 +673,86 @@ Compresses serialized data. Default is not to use it. Will compress if set to
Setting this to a true value will force serializer and deserializer to work in raw mode
(see raw_serializer and raw_deserializer). The default is for this to be off.
+If you desire this functionality you should look at L<Data::Serializer::Raw(3)> instead, it is
+faster and leaner.
+
=item B<serializer> - change the serializer
-Currently have 8 supported serializers: Storable, FreezeThaw, Data::Denter, Config::General, YAML,
-PHP::Serialization, XML::Dumper, and Data::Dumper.
+Currently supports the following serializers:
+
+=over 4
+
+=item L<Bencode(3)>
+
+=item L<Convert::Bencode(3)>
+
+=item L<Convert::Bencode_XS(3)>
+
+=item L<Config::General(3)>
+
+=item L<Data::Denter(3)>
+
+=item L<Data::Dumper(3)>
+
+=item L<Data::Taxi(3)>
+
+=item L<FreezeThaw(3)>
+
+=item L<JSON(3)>
+
+=item L<JSON::Syck(3)>
+
+=item L<PHP::Serialization(3)>
+
+=item L<Storable(3)>
+
+=item L<XML::Dumper(3)>
+
+=item L<XML::Simple(3)>
+
+=item L<YAML(3)>
+
+=item L<YAML::Syck(3)>
+
+=back
Default is to use Data::Dumper.
+
+
Each serializer has its own caveat's about usage especially when dealing with
cyclical data structures or CODE references. Please see the appropriate
documentation in those modules for further information.
=item B<cipher> - change the cipher method
-Utilizes Crypt::CBC and can support any cipher method that it supports.
+Utilizes L<Crypt::CBC(3)> and can support any cipher method that it supports.
=item B<digester> - change digesting method
-Uses Digest so can support any digesting method that it supports. Digesting
+Uses L<Digest(3)> so can support any digesting method that it supports. Digesting
function is used internally by the encryption routine as part of data verification.
=item B<compressor> - changes compresing module
-Currently Compress::Zlib and Compress::PPMd are the only options
+Currently L<Compress::Zlib(3)> and L<Compress::PPMd(3)> are the only options
=item B<encoding> - change encoding method
Encodes data structure in ascii friendly manner. Currently the only valid options
are hex, or b64.
-The b64 option uses Base64 encoding provided by MIME::Base64, but strips out newlines.
+The b64 option uses Base64 encoding provided by L<MIME::Base64(3)>, but strips out newlines.
=item B<serializer_token> - add usage hint to data
-Data::Serializer prepends a token that identifies what was used to process its data.
-This is used internally to allow runtime determination of how to extract Serialized
-data. Disabling this feature is not recommended.
+L<Data::Serializer(3)> prepends a token that identifies what was used to process its data.
+This is used internally to allow runtime determination of how to extract serialized
+data. Disabling this feature is not recommended. (Use L<Data::Serializer::Raw(3)> instead).
=item B<options> - pass options through to underlying serializer
-Currently is only supported by Config::General, and XML::Dumper.
+Currently is only supported by L<Config::General(3)>, and L<XML::Dumper(3)>.
my $obj = Data::Serializer->new(serializer => 'Config::General',
options => {
@@ -436,11 +797,6 @@ Trips an exception if it is unable to write to the specified file.
Reads first line of supplied file or filehandle and returns it deserialized.
-=item B<DESTROY> - force the destruction of the serilaizer object
-
- $obj->DESTROY();
-
-
=back
=head1 AUTHOR
@@ -455,7 +811,7 @@ http://neil-neely.blogspot.com/
Please report all bugs here:
-http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Serializer
+http://rt.cpan.org/Public/Dist/Display.html?Name=Data-Serializer
=head1 TODO
@@ -467,7 +823,7 @@ would be welcome.
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2001-2008 Neil Neely. All rights reserved.
+Copyright (c) 2001-2011 Neil Neely. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
@@ -478,8 +834,8 @@ See http://www.perl.com/language/misc/Artistic.html
=head1 ACKNOWLEDGEMENTS
-Gurusamy Sarathy and Raphael Manfredi for writing MLDBM,
-the module which inspired the creation of Data::Serializer.
+Gurusamy Sarathy and Raphael Manfredi for writing L<MLDBM(3)>,
+the module which inspired the creation of L<Data::Serializer(3)>.
And thanks to all of you who have provided the feedback
that has improved this module over the years.
@@ -495,29 +851,37 @@ This module is dedicated to my beautiful wife Erica.
=over 4
-=item L<Data::Dumper(3)>
+=item L<Bencode(3)>
-=item L<Data::Denter(3)>
+=item L<Convert::Bencode(3)>
-=item L<Data::Taxi(3)>
+=item L<Convert::Bencode_XS(3)>
-=item L<Storable(3)>
+=item L<Config::General(3)>
-=item L<FreezeThaw(3)>
+=item L<Data::Denter(3)>
-=item L<Config::General(3)>
+=item L<Data::Dumper(3)>
-=item L<YAML(3)>
+=item L<Data::Taxi(3)>
-=item L<YAML::Syck(3)>
+=item L<FreezeThaw(3)>
+
+=item L<JSON(3)>
+
+=item L<JSON::Syck(3)>
=item L<PHP::Serialization(3)>
+=item L<Storable(3)>
+
=item L<XML::Dumper(3)>
-=item L<JSON(3)>
+=item L<XML::Simple(3)>
-=item L<JSON::Syck(3)>
+=item L<YAML(3)>
+
+=item L<YAML::Syck(3)>
=item L<Compress::Zlib(3)>
@@ -527,325 +891,14 @@ This module is dedicated to my beautiful wife Erica.
=item L<Digest::SHA(3)>
-=item L<Crypt(3)>
+=item L<Crypt::CBC(3)>
=item L<MIME::Base64(3)>
=item L<IO::File(3)>
+=item L<Data::Serializer::Config::Wrest(3)> - adds supports for L<Config::Wrest(3)>
+
=back
=cut
-
-sub _serialize {
- my $self = (shift);
- my @input = @{(shift)};#original @_
- my $method = (shift);
- $self->_module_loader($method,"Data::Serializer"); #load in serializer module if necessary
- my $serializer_obj = $self->_serializer_obj($method);
- return $serializer_obj->serialize(@input);
-}
-
-sub _compress {
- my $self = (shift);
- $self->_module_loader($self->compressor);
- if ($self->compressor eq 'Compress::Zlib') {
- return Compress::Zlib::compress((shift));
- } elsif ($self->compressor eq 'Compress::PPMd') {
- my $compressor = Compress::PPMd::Encoder->new();
- return $compressor->encode((shift));
- }
-}
-sub _decompress {
- my $self = (shift);
- $self->_module_loader($self->compressor);
- if ($self->compressor eq 'Compress::Zlib') {
- return Compress::Zlib::uncompress((shift));
- } elsif ($self->compressor eq 'Compress::PPMd') {
- my $compressor = Compress::PPMd::Decoder->new();
- return $compressor->decode((shift));
- }
-}
-
-sub _create_token {
- my $self = (shift);
- return '^' . join('|', @_) . '^';
-}
-sub _get_token {
- my $self = (shift);
- my $line = (shift);
- #Should be anchored to beginning
- #my ($token) = $line =~ /\^([^\^]+?)\^/;
- my ($token) = $line =~ /^\^([^\^]{1,120}?)\^/;
- return $token;
-}
-sub _extract_token {
- my $self = (shift);
- my $token = (shift);
- return split('\|',$token);
-}
-sub _remove_token {
- my $self = (shift);
- my $line = (shift);
- $line =~ s/^\^[^\^]{1,120}?\^//;
- return $line;
-}
-sub _deserialize {
- my $self = (shift);
- my $input = (shift);
- my $method = (shift);
- $self->_module_loader($method,"Data::Serializer"); #load in serializer module if necessary
- my $serializer_obj = $self->_serializer_obj($method);
- $serializer_obj->deserialize($input);
-}
-
-sub _encrypt {
- my $self = (shift);
- my $value = (shift);
- my $cipher = (shift);
- my $digester = (shift);
- my $secret = $self->secret;
- croak "Cannot encrypt: No secret provided!" unless defined $secret;
- $self->_module_loader('Crypt::CBC');
- my $digest = $self->_endigest($value,$digester);
- my $cipher_obj = Crypt::CBC->new($secret,$cipher);
- return $cipher_obj->encrypt($digest);
-}
-sub _decrypt {
- my $self = (shift);
- my $input = (shift);
- my $cipher = (shift);
- my $digester = (shift);
- my $secret = $self->secret;
- croak "Cannot encrypt: No secret provided!" unless defined $secret;
- $self->_module_loader('Crypt::CBC');
- my $cipher_obj = Crypt::CBC->new($secret,$cipher);
- my $digest = $cipher_obj->decrypt($input);
- return $self->_dedigest($digest,$digester);
-}
-sub _endigest {
- my $self = (shift);
- my $input = (shift);
- my $digester = (shift);
- $self->_module_loader('Digest');
- my $digest = $self->_get_digest($input,$digester);
- return "$digest=$input";
-}
-sub _dedigest {
- my $self = (shift);
- my $input = (shift);
- my $digester = (shift);
- $self->_module_loader('Digest');
- #my ($old_digest) = $input =~ /^([^=]+?)=/;
- $input =~ s/^([^=]+?)=//;
- my $old_digest = $1;
- return undef unless (defined $old_digest);
- my $new_digest = $self->_get_digest($input,$digester);
- return undef unless ($new_digest eq $old_digest);
- return $input;
-}
-sub _get_digest {
- my $self = (shift);
- my $input = (shift);
- my $digester = (shift);
- my $ctx = Digest->new($digester);
- $ctx->add($input);
- return $ctx->hexdigest;
-}
-sub _enhex {
- my $self = (shift);
- return join('',unpack 'H*',(shift));
-}
-sub _dehex {
- my $self = (shift);
- return (pack'H*',(shift));
-}
-
-sub _enb64 {
- my $self = (shift);
- $self->_module_loader('MIME::Base64');
- my $b64 = MIME::Base64::encode_base64( (shift), '' );
- return $b64;
-}
-
-
-sub _deb64 {
- my $self = (shift);
- $self->_module_loader('MIME::Base64');
- return MIME::Base64::decode_base64( (shift) );
-}
-
-# do all 3 stages
-sub freeze { (shift)->serialize(@_); }
-sub thaw { (shift)->deserialize(@_); }
-
-sub serialize {
- my $self = (shift);
- my ($serializer,$cipher,$digester,$encoding,$compressor) = ('','','','','');
-
- if ($self->raw) {
- return $self->raw_serialize(@_);
- }
-
- #we always serialize no matter what.
-
- #define serializer for token
- $serializer = $self->serializer;
- my $value = $self->_serialize(\@_,$serializer);
-
- if ($self->compress) {
- $compressor = $self->compressor;
- $value = $self->_compress($value);
- }
-
- if (defined $self->secret) {
- #define digester for token
- $digester = $self->digester;
- #define cipher for token
- $cipher = $self->cipher;
- $value = $self->_encrypt($value,$cipher,$digester);
- }
- if ($self->portable) {
- $encoding = $self->encoding;
- $value = $self->_encode($value);
- }
- if ($self->serializer_token) {
- my $token = $self->_create_token($serializer,$cipher, $digester,$encoding,$compressor);
- $value = $token . $value;
- }
- return $value;
-}
-
-sub store {
- my $self = (shift);
- my $data = (shift);
- my $file_or_fh = (shift);
-
- if (ref($file_or_fh)) {
- #it is a file handle so print straight to it
- print $file_or_fh $self->serialize($data), "\n";
- #We didn't open the filehandle, so we shouldn't close it.
- } else {
- #it is a file, so open it
- my ($mode,$perm) = @_;
- unless (defined $mode) {
- $mode = O_CREAT|O_WRONLY;
- }
- unless (defined $perm) {
- $perm = 0600;
- }
- my $fh = new IO::File;
- $fh->open($file_or_fh, $mode,$perm) || croak "Cannot write to $file_or_fh: $!";
- print $fh $self->serialize($data), "\n";
- $fh->close();
- }
-}
-
-sub retrieve {
- my $self = (shift);
- my $file_or_fh = (shift);
- if (ref($file_or_fh)) {
- #Read in whole file at once
- #local $/;
- #it is a file handle so read straight from it
- my $input = join('', <$file_or_fh>);
- chomp($input);
- return $self->deserialize($input);
- #We didn't open the filehandle, so we shouldn't close it.
- } else {
- my $fh = new IO::File;
- $fh->open($file_or_fh, O_RDONLY) || croak "Cannot read from $file_or_fh: $!";
- #Read in whole file at once
- #local $/;
- my $input = join('', <$fh>);
- chomp($input);
- $fh->close;
- return $self->deserialize($input);
- }
-}
-
-sub raw_serialize {
- my $self = (shift);
- my $serializer = $self->serializer;
- return $self->_serialize(\@_,$serializer);
-}
-
-sub _encode {
- my $self = (shift);
- my $value = (shift);
- my $encoding = $self->encoding;
- if ($encoding eq 'hex') {
- return $self->_enhex($value);
- } elsif ($encoding eq 'b64') {
- return $self->_enb64($value);
- } else {
- croak "Unknown encoding method $encoding\n";
- }
-}
-
-sub _decode {
- my $self = (shift);
- my $value = (shift);
- my $encoding = (shift);
- if ($encoding eq 'hex') {
- return $self->_dehex($value);
- } elsif ($encoding eq 'b64') {
- return $self->_deb64($value);
- } elsif ($encoding !~ /\S/) {
- #quietly ignore empty encoding
- return $value;
- } else {
- croak "Unknown encoding method $encoding\n";
- }
-}
-
-sub raw_deserialize {
- my $self = (shift);
- my $serializer = $self->serializer;
- return $self->_deserialize((shift),$serializer);
-}
-
-sub deserialize {
- my $self = (shift);
-
- if ($self->raw) {
- return $self->raw_deserialize(@_);
- }
-
- my $value = (shift);
- my $token = $self->_get_token($value);
- my ($serializer,$cipher, $digester,$encoding, $compressor);
- my $compress = $self->compress;
- if (defined $token) {
- ($serializer,$cipher, $digester,$encoding, $compressor) = $self->_extract_token($token);
-
- #if compressor is defined and has a value then we must decompress it
- $compress = 1 if ($compressor);
- $value = $self->_remove_token($value);
- } else {
- $serializer = $self->serializer;
- $cipher = $self->cipher;
- $digester = $self->digester;
- $compressor = $self->compressor;
- if ($self->portable) {
- $encoding = $self->encoding;
- }
- }
- if (defined $encoding) {
- $value = $self->_decode($value,$encoding);
- }
- if (defined $self->secret) {
- $value = $self->_decrypt($value,$cipher,$digester);
- }
- if ($compress) {
- $value = $self->_decompress($value);
- }
- #we always deserialize no matter what.
- my @return = $self->_deserialize($value,$serializer);
- return wantarray ? @return : $return[0];
-}
-
-
-1;
-__END__
-
@@ -22,6 +22,21 @@ foreach my $serializer (qw(XML::Simple)) {
}
}
+#
+# XML::Simple has an internal dependency of either XML::SAX or XML::Parser, so we need to test for those
+# too, and if we don't find them, act like XML::Simple is not installed
+#
+if (grep {/^XML::Simple$/} @serializers) {
+ if (eval "require XML::SAX") {
+ $T->msg("Found XML::SAX to support XML::Simple");
+ } elsif (eval "require XML::Parser") {
+ $T->msg("Found XML::Parser to support XML::Simple");
+ } else {
+ $T->msg("Could not find XML::Parser or XML::SAX, removing XML::Simple") unless (@serializers);
+ @serializers = grep {!/^XML::Simple$/} @serializers;
+ }
+}
+
unless (@serializers) {
$T->begin('0 # Skipped: XML::Simple not installed');
exit;
@@ -0,0 +1,61 @@
+use lib "./t"; # to pick up a ExtUtils::TBone
+
+
+require "./t/serializer-testlib";
+
+use Data::Serializer;
+
+use ExtUtils::TBone;
+
+my $T = typical ExtUtils::TBone; # standard log
+
+
+
+my @serializers;
+
+foreach my $serializer (qw(Bencode)) {
+ if (eval "require $serializer") {
+ $T->msg("Found serializer $serializer");
+ push(@serializers, $serializer);
+ } else {
+ $T->msg("Serializer $serializer not found") unless (@serializers);
+ }
+}
+unless (@serializers) {
+ $T->begin('0 # Skipped: Bencode not installed');
+ exit;
+}
+
+
+
+my @types = qw(basic);
+
+find_features($T,@types);
+
+
+my %tests;
+my $testcount;
+
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ $testcount += $value;
+ }
+ }
+}
+$T->begin($testcount);
+$T->msg("Begin Testing for @types"); # message for the log
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ run_test($T,$serializer,$test,$type);
+ }
+ }
+}
+
@@ -0,0 +1,61 @@
+use lib "./t"; # to pick up a ExtUtils::TBone
+
+
+require "./t/serializer-testlib";
+
+use Data::Serializer;
+
+use ExtUtils::TBone;
+
+my $T = typical ExtUtils::TBone; # standard log
+
+
+
+my @serializers;
+
+foreach my $serializer (qw(Convert::Bencode)) {
+ if (eval "require $serializer") {
+ $T->msg("Found serializer $serializer");
+ push(@serializers, $serializer);
+ } else {
+ $T->msg("Serializer $serializer not found") unless (@serializers);
+ }
+}
+unless (@serializers) {
+ $T->begin('0 # Skipped: Convert::Bencode not installed');
+ exit;
+}
+
+
+
+my @types = qw(basic);
+
+find_features($T,@types);
+
+
+my %tests;
+my $testcount;
+
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ $testcount += $value;
+ }
+ }
+}
+$T->begin($testcount);
+$T->msg("Begin Testing for @types"); # message for the log
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ run_test($T,$serializer,$test,$type);
+ }
+ }
+}
+
@@ -0,0 +1,61 @@
+use lib "./t"; # to pick up a ExtUtils::TBone
+
+
+require "./t/serializer-testlib";
+
+use Data::Serializer;
+
+use ExtUtils::TBone;
+
+my $T = typical ExtUtils::TBone; # standard log
+
+
+
+my @serializers;
+
+foreach my $serializer (qw(Convert::Bencode_XS)) {
+ if (eval "require $serializer") {
+ $T->msg("Found serializer $serializer");
+ push(@serializers, $serializer);
+ } else {
+ $T->msg("Serializer $serializer not found") unless (@serializers);
+ }
+}
+unless (@serializers) {
+ $T->begin('0 # Skipped: Convert::Bencode_XS not installed');
+ exit;
+}
+
+
+
+my @types = qw(basic);
+
+find_features($T,@types);
+
+
+my %tests;
+my $testcount;
+
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ $testcount += $value;
+ }
+ }
+}
+$T->begin($testcount);
+$T->msg("Begin Testing for @types"); # message for the log
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ run_test($T,$serializer,$test,$type);
+ }
+ }
+}
+
@@ -0,0 +1,59 @@
+use lib "./t"; # to pick up a ExtUtils::TBone
+
+
+require "./t/serializer-testlib";
+
+use Data::Serializer;
+
+use ExtUtils::TBone;
+
+my $T = typical ExtUtils::TBone; # standard log
+
+
+
+my @serializers;
+
+foreach my $serializer (keys %serializers) {
+ if (eval "require $serializer") {
+ $T->msg("Found serializer $serializer");
+ push(@serializers, $serializer);
+ }
+}
+
+
+$T->msg("No serializers found!!") unless (@serializers);
+
+my @types = qw(raw newraw);
+
+find_features($T,@types);
+
+my $testcount = 0;
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ $testcount += $value;
+ }
+ }
+}
+
+unless ($testcount) {
+ $T->begin("0 # Skipped: @types not installed");
+ exit;
+}
+
+$T->begin($testcount);
+$T->msg("Begin Testing for @types"); # message for the log
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ run_test($T,$serializer,$test,$type);
+ }
+ }
+}
+
@@ -0,0 +1,58 @@
+use lib "./t"; # to pick up a ExtUtils::TBone
+
+
+require "./t/serializer-testlib";
+
+use Data::Serializer::Raw;
+
+use ExtUtils::TBone;
+
+my $T = typical ExtUtils::TBone; # standard log
+
+
+my @serializers;
+
+foreach my $serializer (keys %serializers) {
+ if (eval "require $serializer") {
+ $T->msg("Found serializer $serializer");
+ push(@serializers, $serializer);
+ }
+}
+
+
+$T->msg("No serializers found!!") unless (@serializers);
+
+my @types = qw(objraw);
+
+find_features($T,@types);
+
+my $testcount = 0;
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ $testcount += $value;
+ }
+ }
+}
+
+unless ($testcount) {
+ $T->begin("0 # Skipped: @types not installed");
+ exit;
+}
+
+$T->begin($testcount);
+$T->msg("Begin Testing for @types"); # message for the log
+
+foreach my $serializer (@serializers) {
+ while (my ($test,$value) = each %{$serializers{$serializer}}) {
+ next unless $value;
+ foreach my $type (@types) {
+ next unless $found_type{$type};
+ run_test($T,$serializer,$test,$type);
+ }
+ }
+}
+
@@ -1,59 +0,0 @@
-use lib "./t"; # to pick up a ExtUtils::TBone
-
-
-require "./t/serializer-testlib";
-
-use Data::Serializer;
-
-use ExtUtils::TBone;
-
-my $T = typical ExtUtils::TBone; # standard log
-
-
-
-my @serializers;
-
-foreach my $serializer (keys %serializers) {
- if (eval "require $serializer") {
- $T->msg("Found serializer $serializer");
- push(@serializers, $serializer);
- }
-}
-
-
-$T->msg("No serializers found!!") unless (@serializers);
-
-my @types = qw(raw newraw);
-
-find_features($T,@types);
-
-my $testcount = 0;
-
-foreach my $serializer (@serializers) {
- while (my ($test,$value) = each %{$serializers{$serializer}}) {
- next unless $value;
- foreach my $type (@types) {
- next unless $found_type{$type};
- $testcount += $value;
- }
- }
-}
-
-unless ($testcount) {
- $T->begin("0 # Skipped: @types not installed");
- exit;
-}
-
-$T->begin($testcount);
-$T->msg("Begin Testing for @types"); # message for the log
-
-foreach my $serializer (@serializers) {
- while (my ($test,$value) = each %{$serializers{$serializer}}) {
- next unless $value;
- foreach my $type (@types) {
- next unless $found_type{$type};
- run_test($T,$serializer,$test,$type);
- }
- }
-}
-
@@ -23,7 +23,7 @@ foreach my $serializer (keys %serializers) {
$T->msg("No serializers found!!") unless (@serializers);
-my @types = qw(fh-storage storage rawstorage);
+my @types = qw(fh-storage storage rawstorage1 rawstorage2);
find_features($T,@types);
@@ -19,6 +19,21 @@ foreach my $serializer (keys %serializers) {
push(@serializers, $serializer);
}
}
+#
+# XML::Simple has an internal dependency of either XML::SAX or XML::Parser, so we need to test for those
+# too, and if we don't find them, act like XML::Simple is not installed
+#
+if (grep {/^XML::Simple$/} @serializers) {
+ if (eval "require XML::SAX") {
+ $T->msg("Found XML::SAX to support XML::Simple");
+ } elsif (eval "require XML::Parser") {
+ $T->msg("Found XML::Parser to support XML::Simple");
+ } else {
+ $T->msg("Could not find XML::Parser or XML::SAX, removing XML::Simple") unless (@serializers);
+ @serializers = grep {!/^XML::Simple$/} @serializers;
+ }
+}
+
$T->msg("No serializers found!!") unless (@serializers);
@@ -229,9 +229,46 @@ $testrefs{selfrefarray}->[3] = $testrefs{selfrefarray}->[1];
complexhash => $counts{complexhash},
selfrefhash => $counts{selfrefhash},
},
+ 'Bencode' => {
+ simpleobject => 0, #Bencode does not support serializing objects
+ simplescalarref => 0, #Bencode does not support serializing saclar references
+ simplescalar => $counts{simplescalar},
+ trickyscalar => $counts{trickyscalar},
+ simplearray => $counts{simplearray},
+ complexarray => $counts{complexarray},
+ selfrefarray => $counts{selfrefarray},
+ simplehash => $counts{simplehash},
+ complexhash => $counts{complexhash},
+ selfrefhash => $counts{selfrefhash},
+ },
+ 'Convert::Bencode' => {
+ simpleobject => 0, #Convert::Bencode does not support serializing objects
+ simplescalarref => 0, #Convert::Bencode does not support serializing saclar references
+ simplescalar => $counts{simplescalar},
+ trickyscalar => $counts{trickyscalar},
+ simplearray => $counts{simplearray},
+ complexarray => $counts{complexarray},
+ selfrefarray => $counts{selfrefarray},
+ simplehash => $counts{simplehash},
+ complexhash => $counts{complexhash},
+ selfrefhash => $counts{selfrefhash},
+ },
+ 'Convert::Bencode_XS' => {
+ simpleobject => 0, #Convert::Bencode_XS does not support serializing objects
+ simplescalarref => 0, #Convert::Bencode_XS does not support serializing saclar references
+ simplescalar => $counts{simplescalar},
+ trickyscalar => $counts{trickyscalar},
+ simplearray => $counts{simplearray},
+ complexarray => $counts{complexarray},
+ selfrefarray => $counts{selfrefarray},
+ simplehash => $counts{simplehash},
+ complexhash => $counts{complexhash},
+ selfrefhash => $counts{selfrefhash},
+ },
);
%features = (
+ 'objraw' => [],
'raw' => [],
'rawnew' => [],
'non-portable' => [],
@@ -251,8 +288,14 @@ $testrefs{selfrefarray}->[3] = $testrefs{selfrefarray}->[1];
sub run_test {
my ($T,$serializer,$test,$features) = @_;
$T->msg("Test $serializer $test $features"); # message for the log
- my $obj = Data::Serializer->new(serializer=>$serializer);
- foreach my $feature (split(" ", $features)) {
+ my $obj;
+ my @features = (split(" ", $features));
+ if (grep {/^objraw$/} @features) {
+ $obj = Data::Serializer::Raw->new(serializer=>$serializer);
+ } else {
+ $obj = Data::Serializer->new(serializer=>$serializer);
+ }
+ foreach my $feature (@features) {
if ($feature eq 'basic') {
#do nothing special
} elsif ($feature eq 'non-portable') {
@@ -301,10 +344,13 @@ sub run_test {
}
}
my ($frozen,$thawed);
- if (grep {/raw/} $features) {
+ if (grep {/^objraw$/} @features) {
+ $frozen = $obj->serialize($testrefs{$test});
+ $thawed = $obj->deserialize($frozen);
+ }elsif (grep {/^raw$/} @features) {
$frozen = $obj->raw_serialize($testrefs{$test});
$thawed = $obj->raw_deserialize($frozen);
- } elsif (grep {/rawnew/} $features) {
+ } elsif (grep {/^rawnew$/} @features) {
my $newobj = Data::Serializer->new(
serializer=>$serializer,
raw => 1,
@@ -315,7 +361,7 @@ sub run_test {
$thawed = $obj->deserialize($frozen);
- } elsif (grep {/fh-storage/} $features) {
+ } elsif (grep {/fh-storage/} @features) {
my $fh = IO::File->new($file_path, O_CREAT|O_WRONLY, 0600);
$obj->store($testrefs{$test},$fh);
$fh->close();
@@ -324,11 +370,11 @@ sub run_test {
$thawed = $obj->retrieve($fh);
$fh->close();
unlink($file_path);
- } elsif (grep {/storage/} $features) {
+ } elsif (grep {/storage/} @features) {
$obj->store($testrefs{$test},$file_path);
$thawed = $obj->retrieve($file_path);
unlink($file_path);
- } elsif (grep {/rawstorage/} $features) {
+ } elsif (grep {/rawstorage1/} @features) {
my $newobj = Data::Serializer->new(
serializer=>$serializer,
raw => 1,
@@ -336,6 +382,13 @@ sub run_test {
$newobj->store($testrefs{$test},$file_path);
$thawed = $newobj->retrieve($file_path);
unlink($file_path);
+ } elsif (grep {/rawstorage2/} @features) {
+ my $newobj = Data::Serializer::Raw->new(
+ serializer=>$serializer,
+ );
+ $newobj->store($testrefs{$test},$file_path);
+ $thawed = $newobj->retrieve($file_path);
+ unlink($file_path);
} else {
$frozen = $obj->serialize($testrefs{$test});
$thawed = $obj->deserialize($frozen);