File Coverage

blib/lib/App/MakeEPUB.pm

Criterion	Covered	Total	%
statement	39	232	16.8
branch	2	66	3.0
condition	4	10	40.0
subroutine	11	27	40.7
pod	3	3	100.0
total	59	338	17.4

# vim: set ts=4 sw=4 tw=78 et si ft=perl:
package App::MakeEPUB;

use warnings;
use strict;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Carp;
use File::Basename;
use File::Find;
use File::Path qw(make_path);
use HTML::TreeBuilder;

use version; our $VERSION = qv('0.3.1');

my %guidetitle = (
    cover   => 'Cover',
);

my %embed = (
    'container.xml' => q(





),
    'content.opf'   => q(



%%METADATA%%



%%MANIFEST%%



%%SPINE%%


%%GUIDE%%
),
    'toc.ncx'       => q(




%%TOCNCXHEAD%%



%%TOCNCXDOCTITLE%%



%%TOCNCXNAVMAP%%


),
);

sub new {
    my ($self, $args) = @_;
    my $type = ref($self) || $self;

    $self = bless {}, $type;
    $self->{path} = {};
    #
    $self->{nav_l2} = {
        '_tag'  => 'span',
        'class' => 'h2',
    };

    $self->_init($args)                 if (defined $args);

    return $self;
} # new()

sub add_metadata {
    my ($self, $opt) = @_;
    my %data = ();
    $data{metadata}->{identifier}   = $opt->{identifier};
    $data{metadata}->{language}     = $opt->{language};
    $data{metadata}->{title}        = $opt->{title};
    $data{metadata}->{creator}      = $opt->{creator}   if $opt->{creator};
    $data{metadata}->{publisher}    = $opt->{publisher} if $opt->{publisher};
    $data{metadata}->{rights}       = $opt->{rights}    if $opt->{rights};
    $data{guide}->{cover}           = $opt->{cover}     if $opt->{cover};
    $data{tocncx}->{uid}            = $opt->{identifier};
    $data{tocncx}->{depth}          = $opt->{tocdepth};
    $data{tocncx}->{totalPageCount} = 0;
    $data{tocncx}->{maxPageNumber}  = 0;
    $self->{data} = \%data;
    return %data;
} # add_metadata()

sub write_epub {
    my ($self,$outname) = @_;
    my $paths  = $self->{path_ids};
    my $epub   = Archive::Zip->new();
    my $m;

    $m = $epub->addString('application/epub+zip', 'mimetype');

    $m = $epub->addString($embed{'container.xml'}, 'META-INF/container.xml');

    $m = $epub->addString($self->_substitute_template($embed{'content.opf'}),
        'content.opf');

    $m = $epub->addString($self->_substitute_template($embed{'toc.ncx'}),
        'toc.ncx');

    foreach my $path (keys %$paths) {
        next if 'toc.ncx' eq $path;
        $m = $epub->addFile($self->{epubdir} . '/' . $path, $path);
    }

    unless ($outname) {
        $outname = $self->{epubdir} . '.epub';
    }
    unless (AZ_OK == $epub->writeToFileNamed($outname)) {
        die "could not write to $self->{epubdir}.epub: $!";
    }
} # write_epub()

sub _generate_guide {
    my ($self) = @_;
    my $data = $self->{data};
    my @guide = ();
    if (my $g = $data->{guide}) {
        push @guide, q( );
        foreach my $type (keys %$g) {
            push @guide,
                 qq(
               . qq( href="$g->{$type}" />);
        }
        push @guide ,q( );
    }
    return join "\n", @guide;
} # _generate_guide()

sub _generate_manifest {
    my ($self) = @_;
    my $c_opf = $self->{path}->{'content.opf'};
    my $paths = $self->{path_ids};
    my @manifest = ();
    my $type;
    foreach my $path (keys %$paths) {
        my $id = $paths->{$path};
        next if $path eq 'mimetype';
        next if $path eq 'META-INF/container.xml';
        next if $path eq $c_opf;
        if ($path =~ /\.html$/i) {
            $type = 'application/xhtml+xml';
        }
        elsif ($path =~ /\.png$/i) {
            $type = 'image/png';
        }
        elsif ($path =~ /\.jpe?g$/i) {
            $type = 'image/jpeg';
        }
        elsif ($path =~ /toc\.ncx$/i) {
            $type = 'application/x-dtbncx+xml';
            $id   = 'ncx';
        }
        elsif ($path =~ /\.css$/i) {
            $type = 'text/css';
        }
        else {
            die "Don't know type media-type for '$path'!";
        }
        push @manifest, qq(  );
    }
    return join "\n", @manifest;
} # _generate_manifest()

sub _generate_metadata {
    my ($self) = @_;
    my @metadata = ();
    my $md = $self->{data}->{metadata};
    push(@metadata
        ,qq(  $md->{identifier})
        ,  "  $md->{language}"
        ,  "  $md->{title}");
    push(@metadata
        , "  $md->{creator}") if ($md->{creator});
    push(@metadata
        , "  $md->{publisher}"
        )                                              if ($md->{publisher});
    push(@metadata
        , "  $md->{rights}"
        )                                              if ($md->{rights});
    return join "\n", @metadata;
} # _generate_metadata()

sub _generate_spine {
    my ($self) = @_;
    my $sp     = $self->{spine_order};
    my $paths  = $self->{path_ids};
    my @spine  = ();
    foreach my $path (@$sp) {
        my $id = $paths->{$path};
        push @spine, qq(  );
    }
    return join "\n", @spine;
} # _generate_spine()

sub _generate_tocncx_head {
    my ($self) = @_;
    my $data   = $self->{data}->{tocncx};
    my @head   = ();
    foreach my $key (keys %$data) {
        push @head, qq(  );
    }
    return join "\n", @head;
} # _generate_tocncx_head()

sub _generate_tocncx_navMap {
    my ($self) = @_;
    my $epubdir     = $self->{epubdir};
    my $spine_paths = $self->{spine_order};
    my $tocdepth    = $self->{data}->{tocncx}->{depth};
    my @navMap      = ();
    my $id          = 1;
    foreach my $sp (@$spine_paths) {
        my $navPoint;
        ($id, $navPoint) =  $self->_generate_tocncx_navPoint($sp,
                                                             $tocdepth,
                                                             $id);
        push @navMap, $navPoint;
    }
    return join "\n", @navMap;
} # _generate_tocncx_navMap()

sub _generate_tocncx_navPoint {
    my ($self, $path, $depth, $id) = @_;
    my $epubdir = $self->{epubdir};

    die "Can't do tocdepth > 1 at the moment." if (2 < $depth);
    my $tree = HTML::TreeBuilder->new();

    $tree->parse_file("$epubdir/$path");

    my $tt = $tree->look_down('_tag' => 'title');
    my $title = $tt->as_text();
    my $extra = '';
    my $l1id  = $id;
    my $args  = { };
    my $cnt;

    if (2 == $depth) {
        my @l2s = $tree->look_down(%{$self->{nav_l2}});
        my $nps = [];

        foreach my $l2 (@l2s) {
            my $text = $l2->as_text();
            if (my $a = $l2->look_down('_tag' => 'a', 'id' => qr//)) {
                my $id   = $a->attr('id');
                push @$nps, [ $path, $id, $text ];
            }
        }
        $args->{counter} = $id + 1;
        $args->{array}   = $nps;
        $args->{indent}  = '    ';
        $extra = _tocncf_navPoints_from_array($args);
        $cnt   = $args->{counter};
    }
    else {
        $cnt   = $id + 1;
    }

    $args->{counter} = $id;
    $args->{array}   = [ [ $path, '', $title, $extra ], ];
    $args->{indent}  = '  ';

    my $navPoints = _tocncf_navPoints_from_array($args);

    return ($cnt, $navPoints);
} # _generate_tocncx_navPoint()

sub _init {
    my ($self, $args) = @_;

    die "need argument 'epubdir'"       unless (defined $args->{epubdir});
    $self->{epubdir} = $args->{epubdir};
    $self->{epubdir} =~ s|/$||;
    $self->{spine_order} = $args->{spine_order};
    if ($args->{level2}) {
        #
        # $args->{level2} comes as 'attr1:val1,attr2:val2,...' and goes into
        # $self->{nav_l2} as { attr1 => val1, attr2 => val2, ... }
        #
        my @attrs = split(/,/, $args->{level2});
        my %nav_l2 = map { my @p = split(/:/, $_, 2); $p[0] => $p[1] } @attrs;
        $self->{nav_l2} = \%nav_l2;
    }

    $self->_scan_directory();
    $self->_spine_order();
    $self->{path}->{'content.opf'} = 'content.opf';
} # _init()

sub _scan_directory {
    my ($self)   = @_;
    my $startdir = $self->{epubdir};
    my $id = 1;
    my $dirs = {};
    my $have_toc_ncx = 0;
    my $adddir = sub {
        if (m|^$startdir/(.+)$| && -f $_) {
            my $path = $1;
            $dirs->{$path} = "id$id";
            $id++;
            if ($path =~ m|(.*/)?toc\.ncx$|) {
                $have_toc_ncx = 1;
            }
        }
    };
    find( {wanted => $adddir, no_chdir => 1 },$startdir);
    unless ($have_toc_ncx) {
        $dirs->{'toc.ncx'} = 'ncx';
    }
    $self->{path_ids} = $dirs;
    return %$dirs;
} # _scan_directory()

sub _spine_order {
    my ($self) = @_;
    my $paths = $self->{path_ids};
    my $order = $self->{spine_order};
    my %o2p = ();
    my @spo = ();
    foreach my $path (keys %$paths) {
        next unless $path =~ /^(.+)\.html/i;
        my $si = $1;
        $si =~ s|^.+/([^/]+)$|$1|;
        $o2p{$si} = $path;
    }
    if ($order) {
        @spo = map { $o2p{$_} } split /,/, $order;
    }
    else {
        @spo = map { $o2p{$_} } sort keys %o2p;
    }
    $self->{spine_order} = \@spo;
    return @spo;
} # _spine_order()

sub _substitute_template {
    my ($self,$tmpl,$data) = @_;
    my $out = "";

    unless (exists $self->{substitutes}) {
        my $s = {};
        $s->{'%%GUIDE%%'}          = $self->_generate_guide(),
        $s->{'%%MANIFEST%%'}       = $self->_generate_manifest(),
        $s->{'%%METADATA%%'}       = $self->_generate_metadata(),
        $s->{'%%SPINE%%'}          = $self->_generate_spine(),
        $s->{'%%TOCNCXDOCTITLE%%'} = ''
                                     . $self->{data}->{metadata}->{title}
                                     . '',
        $s->{'%%TOCNCXHEAD%%'}     = $self->_generate_tocncx_head(),
        $s->{'%%TOCNCXNAVMAP%%'}   = $self->_generate_tocncx_navMap(),
        $self->{substitutes} = $s;
    }
    my $substitutes = $self->{substitutes};

    my $replace = sub {
        my ($pattern) = @_;
        return $substitutes->{$pattern} ? $substitutes->{$pattern} : '';
    };

    my @lines = split /\n/, $tmpl;
    foreach (@lines) {
        s/(%%[^%]+%%)/$replace->($1)/e;
        $out .=  $_ . "\n";
    }
    return $out;
} # _substitute_template()

# Functions not bound to an object.
# ---------------------------------

# _tocncf_navPoints_from_array( {
#     counter => $cnt,
#     array   => $array,
#     indent  => "  ",
#     } )
#
# Returns a string containing  entries for the  in toc.ncf
# from the given array. The first id is named "navPoint-$cnt" and the first
# playOrder "$cnt". $cnt is updated to the next number after the last
# playOrder.
#
# The array should be of the form [ [ $fname, $anchor, $text, $extra ], ... ],
# where $fname is the name of the file, $anchor the id of an html anchor
# () and $text the text belonging to the anchor. The
# fourth field ($extra) is optional and can be used for next level navPoints.
#
sub _tocncf_navPoints_from_array {
    my ($args) = @_;
    my @anchors = @{$args->{array}};
    my $indent = $args->{indent} || "";

    my $np = sub {
        my $count = $args->{counter}++;
        my $href  = ($_[0]->[1]) ? $_[0]->[0] . "#" . $_[0]->[1] : $_[0]->[0];
        my $label = $_[0]->[2];
        my $extra = $_[0]->[3] || '';
        return << "EONAVPOINT";
$indent
$indent  $label
$indent
$extra$indent
EONAVPOINT
    };

    my $navPoints = join("", map { $np->($_) } @anchors);
} # _tocncf_navPoints_from_array()

1; # Magic true value required at end of module
__END__