view release on metacpan or  search on metacpan

lib/EBook/Ishmael/EBook/Mobi.pm  view on Meta::CPAN

    my $data = shift;

    my $res = 0;

    my $trail = substr $data, -4;

    for my $c (unpack "C4", $trail) {
        if ($c & 0x80) {
            $res = 0;
        }
        $res = ($res << 7) | ($c & 0x7f);
    }

    return $res;

}

sub _trailing_entries_size {

    my $self = shift;
    my $data = shift;

    my $res = 0;

    for my $i (0 .. $self->{_trailers} - 1) {
        my $n = _trailing_entry_size($data);
        $res += $n;
        substr $data, -$n, $n, '';
    }

    if ($self->{_extra_data} & 1) {
        $res += (ord(substr $data, -1) & 3) + 1;
    }

    return $res;

}

# Index processing code was adapted from KindleUnpack

sub _get_index_data {

    my $self = shift;
    my $idx  = shift;

    return {} if $idx == $NULL_INDEX;

    my $outtbl = [];
    my $ctoc   = {};

    my $data;
    $$data = $self->{_pdb}->record($idx)->data;

    my ($idxhdr, $hordt1, $hordt2) = $self->_parse_indx_header($data);
    my $icount = $idxhdr->{count};
    my $roff = 0;
    my $off = $idx + $icount + 1;

    for my $i (0 .. $idxhdr->{nctoc} - 1) {
        my $cdata = $self->{_pdb}->record($off + $i)->data;
        my $ctocdict = $self->_read_ctoc(\$cdata);
        for my $j (sort keys %$ctocdict) {
            $ctoc->{ $j + $roff } = $ctocdict->{ $j };
        }
        $roff += 0x10000;
    }

    my $tagstart = $idxhdr->{len};
    my ($ctrlcount, $tagtbl) = _read_tag_section($tagstart, $data);

    for my $i ($idx + 1 .. $idx + 1 + $icount - 1) {
        my $d = $self->{_pdb}->record($i)->data;
        my ($hdrinfo, $ordt1, $ordt2) = $self->_parse_indx_header(\$d);
        my $idxtpos = $hdrinfo->{start};
        my $ecount  = $hdrinfo->{count};
        my $idxposits = [];
        for my $j (0 .. $ecount - 1) {
            my $pos = unpack "n", substr $d, $idxtpos + 4 + (2 * $j), 2;
            push @$idxposits, $pos;
        }
        for my $j (0 .. $ecount - 1) {
            my $spos = $idxposits->[$j];
            my $epos = $idxposits->[$j + 1];
            my $txtlen = ord(substr $d, $spos, 1);
            my $txt = substr $d, $spos + 1, $txtlen;
            if (@$hordt2) {
                $txt = join '',
                    map { chr $hordt2->[ ord $_ ] }
                    split //, $txt;
            }
            my $tagmap = _get_tagmap(
                $ctrlcount,
                $tagtbl,
                \$d,
                $spos + 1 + $txtlen,
                $epos
            );
            push @$outtbl, [ $txt, $tagmap ];
        }
    }

    return ( $outtbl, $ctoc );

}

sub _parse_indx_header {

    my $self = shift;
    my $data = shift;

    unless (substr($$data, 0, 4) eq 'INDX') {
        die "Index section is not INDX\n";
    }

    my @words = qw(
        len nul1 type gen start count code lng total ordt ligt nligt nctoc
    );
    my $num = scalar @words;
    my @values = unpack "N$num", substr $$data, 4, 4 * $num;
    my $header = {};