EBook-Tools
view release on metacpan or search on metacpan
lib/EBook/Tools/IMP.pm view on Meta::CPAN
}
$self->{filename} = $filename if($filename);
$filename = $self->{filename} if(!$filename);
my $fh_imp;
my $headerdata;
my $bookpropdata;
my $retval;
my $toc_size;
my $tocdata;
my $entrydata;
my $resource; # Hashref
if(! -f $filename)
{
carp($subname,"(): '",$filename,"' not found!\n");
return;
}
lib/EBook/Tools/IMP.pm view on Meta::CPAN
return;
}
sysread($fh_imp,$self->{resdirname},$self->{resdirlength});
debug(1,"DEBUG: resource directory = '",$self->{resdirname},"'");
if($self->{version} == 1)
{
$toc_size = 10 * $self->{filecount};
sysread($fh_imp,$tocdata,$toc_size)
or croak($subname,"(): unable to read TOC data!\n");
$self->parse_imp_toc_v1($tocdata);
$self->{resources} = ();
foreach my $entry (@{$self->{toc}})
{
sysread($fh_imp,$entrydata,$entry->{size}+10);
$resource = parse_imp_resource_v1($entrydata);
if($resource->{type} ne $entry->{type})
{
carp($subname,"():\n",
" '",$entry->{type},"' TOC entry pointed to '",
$resource->{type},"' resource!\n");
}
$self->{resources}->{$resource->{type}} = $resource;
}
}
elsif($self->{version} == 2)
{
$toc_size = 20 * $self->{filecount};
sysread($fh_imp,$tocdata,$toc_size)
or croak($subname,"(): unable to read TOC data!\n");
$self->parse_imp_toc_v2($tocdata);
$self->{resources} = ();
foreach my $entry (@{$self->{toc}})
{
sysread($fh_imp,$entrydata,$entry->{size}+20);
$resource = parse_imp_resource_v2($entrydata);
$self->{resources}->{$resource->{type}} = $resource;
}
}
else
lib/EBook/Tools/IMP.pm view on Meta::CPAN
=cut
sub pack_imp_toc :method
{
my $self = shift;
my $subname = (caller(0))[3];
croak($subname . "() called as a procedure!\n") unless(ref $self);
debug(2,"DEBUG[",$subname,"]");
my $tocdata;
if(!$self->{version})
{
carp($subname,"():\n",
" no version information found (did you load a file first?)\n");
return;
}
if($self->{version} > 2)
{
carp($subname,"():\n",
lib/EBook/Tools/IMP.pm view on Meta::CPAN
if(!$self->{toc})
{
carp($subname,"(): no TOC data found!\n");
return;
}
foreach my $entry (@{$self->{toc}})
{
if($self->{version} == 1)
{
$tocdata .= pack('a[4]nN',
$entry->{name},
$entry->{unknown1},
$entry->{size});
}
elsif($self->{version} == 2)
{
$tocdata .= pack('a[4]NNa[4]N',
$entry->{name},
$entry->{unknown1},
$entry->{size},
$entry->{type},
$entry->{unknown2});
}
}
if(!length($tocdata))
{
carp($subname,"(): no valid TOC data produced!\n");
return;
}
return $tocdata;
}
=head2 C<resdirbase()>
In scalar context, this returns the basename of C<< $self->{resdirname} >>.
In list context, it actually returns the basename, directory, and
extension as per C<fileparse> from L<File::Basename>.
=cut
lib/EBook/Tools/IMP.pm view on Meta::CPAN
my $fh_imp;
if(!open($fh_imp,'>:raw',$filename))
{
carp($subname,"():\n",
" unable to open '",$filename,"' for writing!\n");
return;
}
my $headerdata = $self->pack_imp_header();
my $bookpropdata = $self->pack_imp_book_properties();
my $tocdata = $self->pack_imp_toc;
if(not $headerdata or length($headerdata) != 48)
{
carp($subname,"(): invalid header data!\n");
return;
}
if(!$bookpropdata)
{
carp($subname,"(): invalid book properties data!\n");
return;
}
if(!$tocdata)
{
carp($subname,"(): invalid table of contents data!\n");
return;
}
if(!$self->{resdirname})
{
carp($subname,"(): invalid .RES directory name!\n");
return;
}
if(!scalar(keys %{$self->{resources}}))
{
carp($subname,"(): no resources found!\n");
return;
}
print {*$fh_imp} $headerdata;
print {*$fh_imp} $bookpropdata;
print {*$fh_imp} $self->{resdirname};
print {*$fh_imp} $tocdata;
foreach my $tocentry (@{$self->{toc}})
{
print {*$fh_imp} ${$self->pack_imp_resource(type => $tocentry->{type})};
}
return 1;
}
lib/EBook/Tools/IMP.pm view on Meta::CPAN
}
$pos++;
}
$self->{text} .= "\n</body>\n</html>";
$self->{text} =~ s/\x15 .*? \x15//gx; # Kill header - comment out?
$self->{text} =~ s/\x16 .*? \x16//gx; # Kill footer
return $textlength;
}
=head2 C<parse_imp_toc_v1($tocdata)>
Takes as a single argument a string containing the table of contents
data, and parses it into object attributes following the version 1
format (10 bytes per entry).
=head3 Format
=over
=item * Offset 0x00 [4 bytes, text]
lib/EBook/Tools/IMP.pm view on Meta::CPAN
=item * Offset 0x08 [4 bytes, big-endian unsigned long int]
Size of the resource data in bytes. Stored in hash key C<size>.
=back
=cut
sub parse_imp_toc_v1 :method
{
my ($self,$tocdata) = @_;
my $subname = (caller(0))[3];
croak($subname . "() called as a procedure!\n") unless(ref $self);
debug(2,"DEBUG[",$subname,"]");
my $length = length($tocdata);
my $lengthexpected = 10 * $self->{filecount};
my $tocentrydata;
my $offset = 0;
if($self->{version} != 1)
{
carp($subname,"(): attempting to parse a version 1 TOC,",
" but the file appears to be version ",$self->{version},"!\n");
}
lib/EBook/Tools/IMP.pm view on Meta::CPAN
carp($subname,"(): expected ",$lengthexpected," bytes, but received ",
$length," -- aborting!\n");
return;
}
$self->{toc} = ();
foreach my $index (0 .. $self->{filecount} - 1)
{
my %tocentry;
my @list;
$tocentrydata = substr($tocdata,$offset,10);
@list = unpack('a[4]nN',$tocentrydata);
$tocentry{name} = $list[0];
$tocentry{unknown1} = $list[1];
$tocentry{size} = $list[2];
debug(3,"DEBUG: found toc entry '",$tocentry{name},
"', type '",$tocentry{type},"' [",$tocentry{size}," bytes]");
push(@{$self->{toc}}, \%tocentry);
$offset += 10;
}
return 1;
}
=head2 C<parse_imp_toc_v2($tocdata)>
Takes as a single argument a string containing the table of contents
data, and parses it into object attributes following the version 2
format (20 bytes per entry).
=head3 Format
=over
=item * Offset 0x00 [4 bytes, text]
lib/EBook/Tools/IMP.pm view on Meta::CPAN
=item * Offset 0x10 [4 bytes, big-endian unsigned long int]
Unknown, but always either zero or one. Stored in C<unknown2>.
=back
=cut
sub parse_imp_toc_v2 :method
{
my ($self,$tocdata) = @_;
my $subname = (caller(0))[3];
croak($subname . "() called as a procedure!\n") unless(ref $self);
debug(2,"DEBUG[",$subname,"]");
my $length = length($tocdata);
my $lengthexpected = 20 * $self->{filecount};
my $template;
my $tocentrydata;
my $offset = 0;
if($self->{version} != 2)
{
carp($subname,"(): attempting to parse a version 2 TOC,",
" but the file appears to be version ",$self->{version},"!\n");
}
lib/EBook/Tools/IMP.pm view on Meta::CPAN
carp($subname,"(): expected ",$lengthexpected," bytes, but received ",
$length," -- aborting!\n");
return;
}
$self->{toc} = ();
foreach my $index (0 .. $self->{filecount} - 1)
{
my %tocentry;
my @list;
$tocentrydata = substr($tocdata,$offset,20);
@list = unpack('a[4]NNa[4]N',$tocentrydata);
$tocentry{name} = $list[0];
$tocentry{unknown1} = $list[1];
$tocentry{size} = $list[2];
$tocentry{type} = $list[3];
$tocentry{unknown2} = $list[4];
debug(3,"DEBUG: found toc entry '",$tocentry{name},
"', type '",$tocentry{type},"' [",$tocentry{size}," bytes,",
use Image::Size;
use Test::More tests => 84;
BEGIN { use_ok('EBook::Tools::IMP',':all') };
my $cwd;
my $imp = EBook::Tools::IMP->new();
my $filename;
my $headerdata;
my $bookpropdata;
my $resdirname;
my $tocdata;
my $resource;
my $resourceref;
my $fh_header;
my $fh_imp;
my $fh_res;
my $md5 = Digest::MD5->new();
my $md5check = Digest::MD5->new();
my ($imagex,$imagey,$imagetype);
my $scalar;
my @list;
$cwd = getcwd();
ok($imp->load('imp/REBTestDocument.imp'),
"load('imp/REBTestDocument.imp') returns succesfully");
open($fh_header,'<:raw','imp/REBTestDocument.imp')
or die("Failed to load imp/REBTestDocument.imp! [@!]");
sysread($fh_header,$headerdata,48);
sysread($fh_header,$bookpropdata,$imp->bookproplength);
sysread($fh_header,$resdirname,$imp->resdirlength);
sysread($fh_header,$tocdata,$imp->version * 10 * $imp->filecount);
sysread($fh_header,$resource,$imp->tocentry(0)->{size} + $imp->version * 10);
close($fh_header);
foreach my $type (keys %{$imp->resources})
{
next if($imp->resource($type)->{name} eq ' ');
my $resdata = $imp->resource($type)->{data};
ok(detect_resource_type(\$resdata) eq $type,
"detect_resource_type() correctly detects '$type'");
}
@list = sort {$a <=> $b} $imp->image_ids('jpg');
is_deeply(\@list, [ 128,3918,19840,35354,36173,47032 ],
'image_ids(jpg) finds expected image ids');
is($imp->pack_imp_header,$headerdata,
'pack_imp_header() creates the correct data');
is($imp->pack_imp_book_properties,$bookpropdata,
'pack_imp_book_properties() creates the correct data');
is($imp->resdirname,$resdirname,
'resdirname() returns the correct name');
is($imp->pack_imp_toc,$tocdata,
'pack_imp_tocdata() creates the correct data');
$resourceref = $imp->pack_imp_resource(type => $imp->tocentry(0)->{type});
ok($$resourceref eq $resource,
'pack_imp_resource(type) creates the correct data');
$resourceref = $imp->pack_imp_resource(name => $imp->tocentry(0)->{name});
ok($$resourceref eq $resource,
'pack_imp_resource(name) creates the correct data');
ok($imp->write_imp('repack.imp'),
'write_imp() returns successfully');
ok(-f 'repack.imp',
( run in 0.632 second using v1.01-cache-2.11-cpan-454fe037f31 )