dtRdr::Book::ThoutBook_1_0 - unpacked ThoutBook reader

  mkdir foo
  cd foo
  unzip ../mybook.jar

  dotreader mybook.xml

  dtRdr::Book::ThoutBook_1_0->identify_uri($uri);

  my $tbook = dtRdr::Book::ThoutBook_1_0->new();

  $tbook->load_uri($uri);

  $book->add_to_library($library);

  my $bool = $book->member_exists($filepath);

  $book->get_member_string($filepath);

package dtRdr::Book::ThoutBook_1_0;
$VERSION = eval{require version}?version::qv($_):$_ for(0.10.1);

use warnings;
use strict;

use Carp;

use File::Basename ();
use Cwd ();

use base 'dtRdr::Book::ThoutBook_1_0::Base';
sub TYPE {'Thout_1_0';}
use dtRdr::Book (
  register => {
    types => __PACKAGE__->TYPE,
  },
);
use dtRdr::Logger;

# BEGIN {
#   dtRdr::Plugins::add_potential_handler(BOOK_READER, 'Thout_1_0', 'Thout_1_0_simple', \&book_open);
#   dtRdr::Plugins::add_potential_checker(BOOK_ID, "ThoutBook_1_0.pm checker", \&is_a_Thout_1_0_Book);
#
# }

sub identify_uri {
  my $class = shift;
  my ($filename, $cache) = @_;

  # TODO inspect file contents (dtd?) and maybe surrounding directory
  # is a single XML file enough to make a complete book?
  if($filename =~ m/\.xml$/) {
    (-e File::Basename::dirname($filename) .'/thout_package.properties') or
      L->warn("All your XML are belong to us...");
    return(1);
  }

  return(0);
}

sub new {
  my $package = shift;
  my $class = ref($package) || $package;
  my $self = $class->SUPER::new(@_);
  my %defaults = (
  );
  foreach my $k (keys(%defaults)) { $self->{$k} = $defaults{$k}; }

  return($self);
} # end subroutine new definition
########################################################################

sub load_uri {
  my $self = shift;
  my ($filename) = @_;

  (-e $filename) or die "no such file '$filename'";
  {
    open(my $fh, '<', $filename) or die "Can't open $filename, $!/$^E";
    binmode $fh;
    local $/;
    $self->set_xml_content(<$fh>);
  }

  $filename = $self->{location} = Cwd::abs_path($filename);
  $self->set_base_dir(File::Basename::dirname($filename).'/');

  return $self->finish_load;
} # end subroutine load_uri definition
########################################################################

sub add_to_library {
  my $self = shift;
  my ($library) = @_;

  my $dirname = $self->base_dir;
  $dirname or die "no base dir?";
  my $basename = $dirname;
  $basename =~ s#[\\/]+$##;
  $basename = File::Basename::basename($basename);
  $basename or die "cannot make a basename out of $dirname :-(";

  my $libname = $library->directory . '/' . $basename;

  # XXX I guess...
  (-e $libname) and
    croak("library destination $libname already exists");

  # NOTE this won't skip .svn directories, that's not our problem

  mkdir($libname) or die "cannot mkdir $libname $!";
  # WISHLIST:  please write me a cross-platform recursive copy module
  # that just throws exceptions, lets me copy to a non-existent
  # destination name, etc!
  require File::NCopy;
  File::NCopy->new(
    recursive      => 1,
    set_permission => sub {chmod(0700, $_[1]) or die $!},
    )->copy($dirname, $library->directory) or die "copy failed $!";

  unless($self->toc_is_cached) {
    # TODO how to abstract this
    # also TODO rewrite the entire propsheet
    my $unhooked = $self->toc->unhooked;

    # Ick
    my $yfile = "$libname/toc_data.toc";
    require YAML::Syck;
    YAML::Syck::DumpFile($yfile, $unhooked);
    my $sfile = $yfile . '.stb';
    require Storable;
    Storable::store($unhooked, $sfile);

    # Ick x2
    my $propfile = "$libname/thout_package.properties";
    my $prop = do {
      open(my $fh, '<', $propfile) or die " '$propfile' $!";
      local $/;
      <$fh>
    };
    $prop =~ s/toc_data:[^\n]+[\n]//g;
    $prop .= "\ntoc_data: toc_data.toc\n";
    $prop =~ s/\n+/\n/g;
    {
      open(my $fh, '>', $propfile) or die "cannot write '$propfile' $!";
      print $fh $prop;
    }
  }

  $library->add_book(
    book_id => $self->id,
    uri     => $basename . '/' .
      File::Basename::basename($self->location),
    title   => $self->title,
    type    => $self->TYPE,
  );
} # end subroutine add_to_library definition
########################################################################

sub member_exists {
  my $self = shift;
  my ($filepath) = @_;

  my $file = $self->base_dir . $filepath;
  return(-e $file);
} # end subroutine member_exists definition
########################################################################

sub get_member_string {
  my $self = shift;
  my ($filepath) = @_;

  my $file = $self->base_dir . $filepath;
  (-e $file) or croak("no file '$file'");

  open(my $fh, '<', $file);
  local $/;
  return(<$fh>);
} # end subroutine get_member_string definition
########################################################################

1;
# vim:sts=2:sw=2:et:sta