package EBook::MOBI; use strict; use warnings; our $VERSION = 0.65; # 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 ); } 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 .= "