File Coverage

blib/lib/EBook/EPUB/Lite.pm

Criterion	Covered	Total	%
statement	198	246	80.4
branch	15	46	32.6
condition	1	6	16.6
subroutine	43	49	87.7
pod	12	27	44.4
total	269	374	71.9

# Copyright (c) 2009, 2010 Oleksandr Tymoshenko
# All rights reserved.

# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.

# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

package EBook::EPUB::Lite;

use strict;
use warnings;
use version;
our $VERSION = 0.7;

use Moo;
use Types::Standard qw/ArrayRef HashRef Object Str/;
use EBook::EPUB::Lite::Metadata; # done
use EBook::EPUB::Lite::Manifest; # done
use EBook::EPUB::Lite::Guide; # done
use EBook::EPUB::Lite::Spine; # done
use EBook::EPUB::Lite::NCX; # done

use EBook::EPUB::Lite::Container::Zip; # not moose

use UUID::Tiny qw();
use File::Temp;
use File::Basename qw/dirname/;
use File::Copy;
use File::Path;
use File::Spec;
use Carp;

has metadata    => (
    isa     => Object,
    is      => 'ro',
    default => sub { EBook::EPUB::Lite::Metadata->new() },
    handles => [ qw/add_contributor
                    add_creator
                    add_coverage
                    add_date
                    add_meta_dcitem
                    add_description
                    add_format
                    add_meta_item
                    add_language
                    add_publisher
                    add_relation
                    add_rights
                    add_source
                    add_subject
                    add_translator
                    add_type
                /],

);

has manifest    => (
    isa     => Object,
    is      => 'ro',
    default => sub { EBook::EPUB::Lite::Manifest->new() },
);

has spine       => (
    isa     => Object,
    is      => 'ro',
    default => sub { EBook::EPUB::Lite::Spine->new() },
);

has guide       => (
    isa     => Object,
    is      => 'ro',
    default => sub { EBook::EPUB::Lite::Guide->new() },
);

has ncx     => (
    isa     => Object,
    is      => 'ro',
    default => sub { EBook::EPUB::Lite::NCX->new() },
    handles => [ qw/add_navpoint/ ],
);

has _uuid  => (
    isa     => Str,
    is      => 'rw',
);

has _encryption_key  => (
    isa     => Str,
    is      => 'rw',
);

# Array of filenames that should be encrypted
has _encrypted_filerefs => (
    is         => 'ro',
    isa        => ArrayRef[Object],
    default    => sub { [] },
);

sub add_encrypted_fileref {
    my ($self, @args) = @_;
    push @{ shift->_encrypted_filerefs }, @args;
}

sub encrypted_filerefs {
    return @{ shift->_encrypted_filerefs };
}

has id_counters => ( isa => HashRef, is => 'ro', default =>  sub { {} });

has _temporary_dir_handle => (isa => Object,
                             is => 'ro',
                             default => sub {
                                 # defaults to CLEANUP => 1 as per doc
                                 return File::Temp->newdir;
                             });

sub tmpdir {
    # return the path, not the object.
    return shift->_temporary_dir_handle->dirname;
}

sub BUILD
{
    my ($self) = @_;
    $self->manifest->add_item(
        id          => 'ncx',
        href        => 'toc.ncx',
        media_type  => 'application/x-dtbncx+xml'
    );

    $self->spine->toc('ncx');
    mkdir ($self->tmpdir . "/OPS") or die "Can't make OPS dir in " . $self->tmpdir;
    # Implicitly generate UUID for book
    $self->_set_uuid(UUID::Tiny::uuid_to_string(UUID::Tiny::create_uuid()));
}

sub to_xml
{
    my ($self) = @_;
    my $xml;

    my $writer = XML::Writer->new(
        OUTPUT      => \$xml,
        DATA_MODE   => 1,
        DATA_INDENT => 2,
    );

    $writer->xmlDecl("utf-8");
    $writer->startTag('package',
        xmlns               => 'http://www.idpf.org/2007/opf',
        version             => '2.0',
        'unique-identifier' => 'BookId',
    );
    $self->metadata->encode($writer);
    $self->manifest->encode($writer);
    $self->spine->encode($writer);
    $self->guide->encode($writer);
    $writer->endTag('package');
    $writer->end();

    return $xml;
}

sub add_author
{
    my ($self, $author, $formal) = @_;
    $self->metadata->add_author($author, $formal);
    $self->ncx->add_author($author);
}

sub add_title
{
    my ($self, $title) = @_;
    $self->metadata->add_title($title);
    my $ncx_title =  $self->ncx->title;
    # Collect all titles in a row for NCX
    $title = "$ncx_title $title" if (defined($ncx_title));
    $self->ncx->title($title);
}

sub _set_uuid
{
    my ($self, $uuid) = @_;

    # Just some naive check for key to be UUID
    if ($uuid !~ /^[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}$/i) {
        carp "$uuid - is not valid UUID";
        return;
    }
    my $key = $uuid;

    $key =~ s/-//g;
    $key =~ s/([a-f0-9]{2})/chr(hex($1))/egi;
    $self->_encryption_key($key);
    if (defined($self->_uuid)) {
        warn "Overriding existing uuid " . $self->_uuid;
        $self->_uuid($uuid);
    }

    $self->ncx->uid("urn:uuid:$uuid");
    $self->metadata->set_book_id("urn:uuid:$uuid");
    $self->_uuid($uuid);
}

sub add_identifier
{
    my ($self, $ident, $scheme) = @_;
    if ($ident =~ /^urn:uuid:(.*)/i) {
        my $uuid = $1;
        $self->_set_uuid($uuid);
    }
    else {
        $self->metadata->add_identifier($ident, $scheme);
    }
}

sub add_xhtml_entry
{
    my ($self, $filename, %opts) = @_;
    my $linear = 1;

    $linear = 0 if (defined ($opts{'linear'}) &&
            $opts{'linear'} eq 'no');


    my $id = $self->nextid('ch');
    $self->manifest->add_item(
        id          => $id,
        href        => $filename,
        media_type  => 'application/xhtml+xml',
    );

    $self->spine->add_itemref(
        idref       => $id,
        linear      => $linear,
    );

    return $id;
}

sub add_stylesheet_entry
{
    my ($self, $filename) = @_;
    my $id = $self->nextid('css');
    $self->manifest->add_item(
        id          => $id,
        href        => $filename,
        media_type  => 'text/css',
    );

    return $id;
}

sub add_image_entry
{
    my ($self, $filename, $type) = @_;
    # trying to guess
    if (!defined($type)) {
        if (($filename =~ /\.jpg$/i) || ($filename =~ /\.jpeg$/i)) {
            $type = 'image/jpeg';
        }
        elsif ($filename =~ /\.gif$/i) {
            $type = 'image/gif';
        }
        elsif ($filename =~ /\.png$/i) {
            $type = 'image/png';
        }
        elsif ($filename =~ /\.svg$/i) {
            $type = 'image/svg+xml';
        }
        else {
            croak ("Unknown image type for file $filename");
            return;
        }
    }

    my $id = $self->nextid('img');
    $self->manifest->add_item(
        id          => $id,
        href        => $filename,
        media_type  => $type,
    );

    return $id;
}

sub add_entry
{
    my ($self, $filename, $type) = @_;
    my $id = $self->nextid('item');
    $self->manifest->add_item(
        id          => $id,
        href        => $filename,
        media_type  => $type,
    );

    return $id;
}

sub add_xhtml {
    my ($self, $filename, $data, %opts) = @_;
    $self->_write_text([OPS => $filename], $data);
    return $self->add_xhtml_entry($filename, %opts);
}

sub add_stylesheet {
    my ($self, $filename, $data) = @_;
    $self->_write_text([OPS => $filename], $data);
    return $self->add_stylesheet_entry($filename);
}

sub add_image
{
    my ($self, $filename, $data, $type) = @_;
    $self->_write_data([OPS => $filename], $data);
    return $self->add_image_entry($filename, $type);
}

sub add_data
{
    my ($self, $filename, $data, $type) = @_;
    $self->_write_data([OPS => $filename], $data);
    return $self->add_entry($filename, $type);
}

sub copy_xhtml
{
    my ($self, $src_filename, $filename, %opts) = @_;
    my $tmpdir = $self->tmpdir;
    if (mkdir_and_copy($src_filename, "$tmpdir/OPS/$filename")) {
        return $self->add_xhtml_entry($filename, %opts);
    }
    else {
        carp ("Failed to copy $src_filename to $tmpdir/OPS/$filename");
    }

    return;
}

sub copy_stylesheet
{
    my ($self, $src_filename, $filename) = @_;
    my $tmpdir = $self->tmpdir;
    if (mkdir_and_copy($src_filename, "$tmpdir/OPS/$filename")) {
        return $self->add_stylesheet_entry("$filename");
    }
    else {
        carp ("Failed to copy $src_filename to $tmpdir/OPS/$filename");
    }

    return;
}

sub copy_image
{
    my ($self, $src_filename, $filename, $type) = @_;
    my $tmpdir = $self->tmpdir;
    if (mkdir_and_copy($src_filename, "$tmpdir/OPS/$filename")) {
        return $self->add_image_entry("$filename");
    }
    else {
        carp ("Failed to copy $src_filename to $tmpdir/OPS/$filename");
    }

    return;
}

sub copy_file
{
    my ($self, $src_filename, $filename, $type) = @_;
    my $tmpdir = $self->tmpdir;
    if (mkdir_and_copy($src_filename, "$tmpdir/OPS/$filename")) {
        my $id = $self->nextid('id');
        $self->manifest->add_item(
            id          => $id,
            href        => "$filename",
            media_type  => $type,
        );
        return $id;
    }
    else {
        carp ("Failed to copy $src_filename to $tmpdir/OPS/$filename");
    }

    return;
}

sub encrypt_file
{
    my ($self, $src_filename, $filename, $type) = @_;
    my $tmpdir = $self->tmpdir;
    if (!defined($self->_encryption_key)) {
        croak "Can't encrypt without a key: no urn:uuid: indetifier has been provided";
    }

    my $key = $self->_encryption_key;
    if (adobe_encrypt($src_filename, "$tmpdir/OPS/$filename", $key)) {
        my $id = $self->nextid('id');
        $self->manifest->add_item(
            id          => $id,
            href        => "$filename",
            media_type  => $type,
        );
        $self->add_encrypted_fileref("OPS/$filename");
        return $id;
    }
    else {
        carp ("Failed to copy $src_filename to $tmpdir/OPS/$filename");
    }

    return;
}


sub nextid
{
    my ($self, $prefix) = @_;
    my $id;

    $prefix = 'id' unless(defined($prefix));
    if (defined(${$self->id_counters}{$prefix})) {
        $id = "$prefix" . ${$self->id_counters}{$prefix};
        ${$self->id_counters}{$prefix}++;
    }
    else
    {
        # First usage of prefix
        $id = "${prefix}1";
        ${$self->id_counters}{$prefix} = 2;
    }

    return $id;
}

sub pack_zip
{
    my ($self, $filename) = @_;
    my $tmpdir = $self->tmpdir;
    $self->write_ncx;
    $self->write_opf;
    my $container = EBook::EPUB::Lite::Container::Zip->new($filename);
    $container->add_path($tmpdir . "/OPS", "OPS/");
    $container->add_root_file("OPS/content.opf", "application/oebps-package+xml");
    foreach my $fref ($self->encrypted_filerefs) {
        $container->add_encrypted_path($fref);
    }
    return $container->write();
}

sub write_opf {
    my ($self) = @_;
    $self->_write_text([OPS => 'content.opf' ], $self->to_xml);
}

sub write_ncx {
    my ($self) = @_;
    $self->_write_text([OPS => 'toc.ncx'], $self->ncx->to_xml)
}

# helper function that performs Adobe content protection "encryption"
sub adobe_encrypt
{
    my ($src, $dst, $key) = @_;
    my @key_bytes = unpack "C*", $key;

    # open source/destination files for read/write
    open (my $in,  '<', $src) or return;
    open (my $out, '>', $dst) or return;
    binmode $in;
    binmode $out;

    # XOR first 1024 bytes of file by provided key
    my $data;
    read($in, $data, 1024);
    my @bytes = unpack ("C*", $data);
    my $key_ptr = 0;
    foreach my $d (@bytes) {
        $d = $d ^ $key_bytes[$key_ptr];
        $key_ptr += 1;
        $key_ptr = $key_ptr % @key_bytes;
    }

    my $crypted_data = pack "C*", @bytes;
    print $out $crypted_data;

    # Copy th erest of the file, 1M buffer seems to be reasonable default
    while (read($in, $data, 1024*1024)) {
        print $out $data;
    }

    close $in;
    close $out;
}

sub _write_text {
    my ($self, $path, $data) = @_;
    my $filename = File::Spec->catfile($self->tmpdir, @$path);
    # print "Writing $filename\n";
    open (my $fh, '>:encoding(UTF-8)', $filename)
      or die "Failed to open $filename $!";
    print $fh $data;
    close $fh;
}

sub _write_data {
    my ($self, $path, $data) = @_;
    my $filename = File::Spec->catfile($self->tmpdir, @$path);
    open (my $fh, '>', $filename)
      or die "Failed to open $filename $!";
    binmode $fh;
    print $fh $data;
    close $fh;
}

sub mkdir_and_copy {
    my ($from, $to) = @_;
    mkpath(dirname($to));
    return copy($from, $to);
}

1;

__END__