package dtRdr::Library::YAMLLibrary;

our $VERSION = '0.0.1';

use warnings;
use strict;
use Carp;

use base 'dtRdr::Library';
use dtRdr::Library (
  register => {
    type => 'YAMLLibrary'
  },
);
sub LIBTYPE {'YAMLLibrary';} # needs to go away when plugins work?
sub CORE_ATTRIBS {qw(name type id);}

use dtRdr::Metadata;

use Class::Accessor::Classy;
no  Class::Accessor::Classy;

use YAML::Syck qw(
  LoadFile
  DumpFile
);

use File::Basename qw(
  dirname
);

=head1 NAME

dtRdr::Library::YAMLLibrary - a library in yaml

=head1 SYNOPSIS

=cut

=head1 Initializer

=head2 create

  dtRdr::Library::YAMLLibrary->create($file);

=cut

sub create {
  my $package = shift;
  my $file = shift;
  $file or croak("must have a filename");
  (@_ % 2) and croak('odd number of elements in argument list');
  my (%args) = @_;

  my $id = exists($args{id}) ? $args{id} : '_setme_';

  my %data = (
    library_info => {
      id      => $id,
      type    => $package->LIBTYPE,
      version => $package->VERSION . '', # ensure stringification
    },
    books => [
    ],
  );
  DumpFile($file, \%data);
} # end subroutine create definition
########################################################################
sub _ylibrary_info { $_[0]->{yml}{library_info};}
sub _ybooks        { $_[0]->{yml}{books};}

=head1 Constructor

=head2 new

  my $library = dtRdr::Library::YAMLLibrary->new();

=cut

# XXX who said I needed this?
# sub new {
#   my $package = shift;
#   my $class = ref($package) || $package;
#   my $self = {};
#   bless($self, $class);
#   return($self);
# } # end subroutine new definition
# ########################################################################

=head1 Methods

=head2 load_uri

  $library->load_uri($uri);

=cut

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

  (-e $file) or croak("cannot find library file '$file'");
  $self->{location} = $file;
  $self->_load;
  $self->_setup_info;

} # end subroutine load_uri definition
########################################################################

=head2 _dumpload

Ensure that the on-disk and in-memory data are in sync.

  $self->_dumpload;

=cut

sub _dumpload {
  my $self = shift;
  $self->_dump;
  $self->_load;
} # end subroutine _dumpload definition
########################################################################

=head2 _dump

  $self->_dump;

=cut

sub _dump {
  my $self = shift;
  DumpFile($self->location, $self->{yml});
} # end subroutine _dump definition
########################################################################

=head2 _load

  $self->_load;

=cut

sub _load {
  my $self = shift;
  $self->{yml} = LoadFile($self->location);
} # end subroutine _load definition
########################################################################

=head2 _setup_info

  $self->_setup_info;

=cut

sub _setup_info {
  my $self = shift;

  my $L = $self->_ylibrary_info;
  # TODO check $L->{version};
  foreach my $key ($self->CORE_ATTRIBS) {
    $self->{$key} = $L->{$key} if(exists($L->{$key}));
  }

  my $dir = dirname($self->location);
  # TODO allow absolute path?
  my $storage = exists($L->{storage}) ? ('/' . $L->{storage}) : '';
  $self->{directory} = (defined($dir) ? $dir : '.') . $storage;
} # end subroutine _setup_info definition
########################################################################

=head2 set_id

Allows you to set the library id iff the current value is '_setme_'.

  $lib->set_id($id);

=cut

sub set_id {
  my $self = shift;
  my ($id) = @_;

  my $L = $self->_ylibrary_info;
  ($L->{id} eq '_setme_') or
    croak("the library's id is locked: '$L->{id}'");
  $L->{id} = $self->{id} = $id;
  $self->_dumpload;
} # end subroutine set_id definition
########################################################################

=head2 set_name

Change the library name.

  $lib->set_name($name);

=cut

sub set_name {
  my $self = shift;
  my ($name) = @_;

  my $L = $self->_ylibrary_info;
  $L->{name} = $self->{name} = $name;
  $self->_dumpload;
} # end subroutine set_name definition
########################################################################

=head2 set_storage

Set the library's storage location (relative to the library location.)
This ends up as the $lib->directory property.

  $lib->set_storage($storage);

=cut

sub set_storage {
  my $self = shift;
  my ($sdir) = @_;

  my $L = $self->_ylibrary_info;
  my $checkdir = dirname($self->location) . '/' . $sdir;
  (-e $checkdir) or
    croak("cannot set a non-existent path ($checkdir) ",
      "as the storage directory");
  $L->{storage} = $sdir;
  $self->_dumpload;
  $self->_setup_info;
} # end subroutine set_storage definition
########################################################################

=head2 add_book

Returns the unique id of the new entry.

  $id = $library->add_book(
    book_id => $id,
    title   => $title,
    uri     => $uri,
    type    => $type
  );

=cut

sub add_book {
  my $self = shift;
  (@_ % 2) and croak('odd number of elements in argument list');
  my (%data) = @_;

  my $B = $self->_ybooks;
  if(defined(my $id = delete($data{id}))) {
    ($id == @$B) or croak("cannot use id '$id'");
  }
  my $v = push(@$B, \%data) - 1;

  $self->_dumpload;
  return($v);
} # end subroutine add_book definition
########################################################################

# XXX these two should go away {{{

=head2 get_info

  my $value = $library->get_info($key);

=cut

sub get_info {
  my $self = shift;
  my ($key) = @_;

  my $L = $self->_ylibrary_info;
  return($L->{$key});
} # end subroutine get_info definition
########################################################################

=head2 set_info

  $library->set_info($key, $value);

=cut

sub set_info {
  my $self = shift;
  my ($key, $value) = @_;

  my $L = $self->_ylibrary_info;
  $L->{$key} = $value;

  $self->_dumpload;
} # end subroutine set_info definition
########################################################################
# XXX these two should go away }}}

=head2 find_book_by

  $info = $lib->find_book_by($key, $value);

=cut

sub find_book_by {
  my $self = shift;
  my ($key, $value) = @_;

  my $B = $self->book_data;
  my @books = grep({$_->{$key} eq $value} @$B);
  return(@books);
} # end subroutine find_book_by definition
########################################################################


=head2 book_data

  $self->book_data;

=cut

sub book_data {
  my $self = shift;

  my $B = $self->_ybooks;
  # TODO make those persistent objects
  return([map({
    dtRdr::LibraryData::BookInfo->new(%{$B->[$_]},
      id => $_, library => $self
    )
  } 0..$#$B)]);
} # end subroutine book_data definition
########################################################################

=head1 AUTHOR

Eric Wilhelm <ewilhelm at cpan dot org>

http://scratchcomputing.com/

=head1 COPYRIGHT

Copyright (C) 2006 Eric L. Wilhelm and OSoft, All Rights Reserved.

=head1 NO WARRANTY

Absolutely, positively NO WARRANTY, neither express or implied, is
offered with this software.  You use this software at your own risk.  In
case of loss, no person or entity owes you anything whatsoever.  You
have been warned.

=head1 LICENSE

The dotReader(TM) is OSI Certified Open Source Software licensed under
the GNU General Public License (GPL) Version 2, June 1991. Non-encrypted
and encrypted packages are usable in connection with the dotReader(TM).
The ability to create, edit, or otherwise modify content of such
encrypted packages is self-contained within the packages, and NOT
provided by the dotReader(TM), and is addressed in a separate commercial
license.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

=cut

# vi:ts=2:sw=2:et:sta
1;
