File Coverage

blib/lib/EBook/MOBI.pm

Criterion	Covered	Total	%
statement	109	123	88.6
branch	24	32	75.0
condition	9	17	52.9
subroutine	22	24	91.6
pod	14	15	93.3
total	178	211	84.3

package EBook::MOBI;

use strict;
use warnings;

our $VERSION = 0.72;

# needed CPAN stuff
use File::Temp qw(tempfile);
use Carp;

# needed local stuff
use EBook::MOBI::Driver::POD;
use EBook::MOBI::Mhtml2Mobi;

# Constructor of this class
sub new {
    my $self = shift;
    my $ref = { html_data => '',
                html_toc  => '',
                toc_label => 'Table of Contents',
                toc_set   => 0,
                toc_done  => 0,

                filename  => 'book.mobi',
                title     => 'This Book has no Title',
                author    => 'This Book has no Author',

                encoding  => ':encoding(UTF-8)',
           default_driver => 'EBook::MOBI::Driver::POD',

                CONST     => '6_--TOC-_thisStringShouldNeverOccurInInput',

                ref_to_debug_sub => 0,
            };

    bless($ref, $self);
    return $ref;
}

sub reset {
    my $self = shift;
    $self->{html_data} = '',
    $self->{html_toc } = '',
    $self->{toc_label} = 'Table of Contents',
    $self->{toc_set  } = 0,
    $self->{toc_done } = 0,

    $self->{filename } = 'book',
    $self->{title    } = 'This Book has no Title',
    $self->{author   } = 'This Book has no Author',

    $self->{encoding } = ':encoding(UTF-8)',
$self->{default_driver}= 'EBook::MOBI::Driver::POD',

    $self->{CONST    } = '6_--TOC-_thisStringShouldNeverOccurInInput',

    $self->{ref_to_debug_sub} = 0,
}

sub debug_on {
    my ($self, $ref_to_debug_sub) = @_;

    $self->{ref_to_debug_sub} = $ref_to_debug_sub;

    &$ref_to_debug_sub('DEBUG mode on');
}

sub debug_off {
    my ($self) = @_;

    if ($self->{ref_to_debug_sub}) {
        &{$self->{ref_to_debug_sub}}('DEBUG mode off');
        $self->{ref_to_debug_sub} = 0;
    }
}

# Internal debug method
sub _debug {
    my ($self,$msg) = @_;

    if ($self->{ref_to_debug_sub}) {
        &{$self->{ref_to_debug_sub}}($msg);
    }
}

sub set_title {
    my $self = shift;

    $self->{title} = shift;
}

sub set_author {
    my $self = shift;

    $self->{author} = shift;
}

sub set_filename {
    my $self = shift;

    $self->{filename} = shift;
}

sub set_encoding {
    my $self = shift;
    my $encoding = shift;

    if (! $self->_encoding_to_codepage($encoding))
    {
        croak "Encoding $encoding is not supported by EPub::MOBI";
    }

    $self->{encoding} = $encoding;
}

sub _encoding_to_codepage
{
    # Translate a Perl encoding name into a codepage value or return
    # undef if not supported.

    my $self = shift;
    my $encoding = shift;

    if ($encoding =~ /iso-8859-1|ascii/i)
    {
        return 1252;
    }
    elsif ($encoding =~ /utf-*8/i)
    {
        return 65001;
    }
    else
    {
        return undef;
    }
}

sub add_mhtml_content {
    my ($self, $html) = @_;

    $self->{html_data} .= $html;
}

sub add_content {
    my $self = shift;
    my %args = @_;

    my $data       = $args{data}       || 0;
    my $pagemode   = $args{pagemode}   || 0;
    my $head0_mode = $args{head0_mode} || 0;
    my $driver     = $args{driver}     || $self->{default_driver};
    my $driver_opt = $args{driver_options} || 0;

    # we load a plugin to convert the input to mobi format
    my $parser;
    (my $require_name = $driver . ".pm") =~ s{::}{/}g;
    eval {
        require $require_name;
        $parser = $driver->new();
    };
    die "Problems with plugin $driver at $require_name: $@" if $@;

    # pass some settings
    if ($self->{ref_to_debug_sub}) {
        $parser->debug_on($self->{ref_to_debug_sub});
    }
    if ($driver_opt) {
        $parser->set_options($driver_opt);
    }

    my $output = $parser->parse($data);

    $self->{html_data} .= $output;
}

sub add_pagebreak {
    my ($self) = @_;

    $self->{html_data} .= '' . "\n";
}

sub add_toc_once {
    my ($self, $label) = @_;

    $self->{toc_label} = $label if $label;
    $self->{toc_set} = 1;
    $self->{html_data} .= $self->{CONST};
    # this newline is needed, otherwise the generation of the toc will
    # not recognise the first  in the split function
    $self->{html_data} .= "\n";
}

sub make {
    my ($self) = @_;

    if (exists $self->{toc_set} and $self->{toc_set}) {
        $self->_generate_toc();
    }
    else {
        my $tmp = $self->{html_data};
    $self->{html_data} = "



" . $tmp . "\n\n";
    }
}

sub print_mhtml {
    my ($self, $arg) = @_;

    unless ($arg) {
        print $self->{html_data};
    }

    return $self->{html_data};
}

sub save {
    my ($self) = @_;

    my $mobi = EBook::MOBI::Mhtml2Mobi->new();
    $mobi->debug_on($self->{ref_to_debug_sub})
        if ($self->{ref_to_debug_sub});

    my $codepage = $self->_encoding_to_codepage($self->{encoding});

    $mobi->pack(    $self->{html_data},
                    $self->{filename},
                    $self->{author},
                    $self->{title},
                    $codepage,
                    $self->{header_opts},
                );
}

sub _generate_toc {
    my $self = shift;

    if (exists $self->{toc_done} and $self->{toc_done}) {
        $self->_debug(
            'Skipping generation of TOC, has been done earlier.');

        return 1;
    }
    else {
        $self->_debug("generating TOC...");
        $self->{toc_done} = 1;
    }

    foreach my $line (split("\n", $self->{html_data})) {
        # The  is only added to TOC if it is at the beginning of a line
        # and if there is a newline directly following afterwards
        if ($line =~ m/^(.*)<\/h1>$/) {
            $self->{html_toc} .=
                "$1\n";
        }
    }

    my $toc  = "$self->{toc_label}\n";
       $toc .= "\n$self->{html_toc}<\/ul><\/p>\n";

    $self->{html_data} =~ s/$self->{CONST}/$toc/;

    my $tmp = $self->{html_data};
    $self->{html_data} = "


{toc_label}\" filepos=\"00000000\"/>



" . $tmp . "\n\n";

    # now we need to calculate the positions for "filepos"
    my $chars = 0;
    my $data_copy = $self->{html_data};
    foreach my $line (split("\n", $data_copy)) {

        if ($line =~ m/^(.*)<\/h1>$/) {
            my $this_pos = $chars;
            my $fill_pos = sprintf("%08d", $this_pos);
            my $m = $1;

            $self->_debug("...ref to char $this_pos,\ttitle '$1'");

            $self->{html_data} =~
            s/\Q$m\E<\/a><\/li>/$m<\/a><\/li>/;
        }
        elsif ($line =~ /$/) {
            my $this_pos = $chars;
            my $fill_pos = sprintf("%08d", $this_pos);
            my $label    = $self->{toc_label};

            $self->{html_data} =~
            s///;
        }
        $chars += length($line) + 1;
    }

}

1;

__END__