view release on metacpan or  search on metacpan

t/binary-load.t  view on Meta::CPAN

$ret = eval {
    $read->open_string(
        "bplist00" . pack( "CCx6CC(x4N)3", 0, 8, 1, 1, 1, 0, 7 ) );
};
ok( not($ret), "Invalid offset table address" );
like( "$@", qr/invalid offset table/i, "Threw an error" );

# Refsize is too small for NumObjects
my $string
    = do { local @ARGV = "t/data/longfile-03.binary.plist"; local $/; <> };
ok( $string, "Read from file." );
use bytes;
substr( $string, -25, 1, "\x01" );
$ret = eval { $read->open_string($string) };
ok( not($ret), "Refsize is too small for NumObjects." );
like( "$@", qr/purported number/, "Threw an error" );

### More complex testing

# Load from a file

t/binary-load.t  view on Meta::CPAN

# Load from fh
my $fh;
open( $fh, "<", "t/data/basic.binary.plist" );
$ret = $read->open_fh($fh);
ok( $ret, "Opening from a fh worked" );
isa_ok( $ret, "Data::Plist" );
ok( $ret->raw_data, "Has data inside" );

# Load from string
my $str = do { local @ARGV = "t/data/basic.binary.plist"; local $/; <> };
ok( $str, "Read binary data in by hand" );
$ret = $read->open_string($str);
ok( $ret, "Opening from a string worked" );
isa_ok( $ret, "Data::Plist" );
ok( $ret->raw_data, "Has data inside" );

# Test raw structure
is_deeply(
    $ret->raw_data,
    [   dict => {

t/binary-write.t  view on Meta::CPAN

like( $@, qr/can't/i, "Threw an error." );

# Large files
files("t/data/bigfile-01.binary.plist");
files("t/data/bigfile-02.binary.plist");

sub files {
    my $write      = Data::Plist::BinaryWriter->new( serialize => 0 );
    my $read       = Data::Plist::BinaryReader->new;
    my ($filename) = @_;
    my $str        = do { local @ARGV = $filename; local $/; <> };
    my $output;
    ok( $str, "Read binary data in by hand" );
    $output = eval { $read->open_string($str) };
    ok( $output, "Opening from a string worked" );
    isa_ok( $output, "Data::Plist" );
    $output = $output->raw_data;
    ok( $output, "Has data inside" );
    my $orig = $write->write($output);
    ok( $orig, "Created data structure" );
    like( $orig, qr/^bplist00/, "Bplist begins with correct header" );