The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
##
#
#    Copyright 2001, AllAfrica Global Media
#
#    This file is part of XML::Comma
#
#    XML::Comma is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    For more information about XML::Comma, point a web browser at
#    http://xymbollab.com/tools/comma/, or read the tutorial included
#    with the XML::Comma distribution at docs/guide.html
#
##

package XML::Comma::Storage::Location::Abstract_file;

use strict;
use File::Spec;
use File::Copy;
use XML::Comma::Util qw( dbg );

# _extension :
# _decl_pos  :
#
# children should use an _init method (which this classes "new" method
# calls, to process arguments and set up their states. the _init
# method should return a list of methods that are "exported" by the
# child class, which new() will add to its own list of exports.
#
# exports: extension()
#
# provides: MAJOR_NUMBER(), decl_pos(), read and write methods, next_
# methods, blob methods and touch/last_modified.
#


sub new {
  my ( $class, %arg ) = @_; my $self = {}; bless ( $self, $class );
  $self->{_extension} = (defined $arg{extension}) ? $arg{extension} : '.comma';
  $self->{_decl_pos} = $arg{decl_pos};
  return ( $self, 'extension', $self->_init(%arg) );
}

sub MAJOR_NUMBER {
  1;
}

sub decl_pos {
  return $_[0]->{_decl_pos}
}

sub write {
  my ( $self, $store, $location, $id, $block ) = @_;
  XML::Comma::Storage::FileUtil->write_file ( $location,
                                              $block,
                                              $store->file_permissions() );
}

sub read {
  my ( $self, $store, $location, $id ) = @_;
  return XML::Comma::Storage::FileUtil->read_file($location);
}

sub erase {
  my ( $self, $location ) = @_;
  unlink $location;
}

sub next_location {
  my ( $self, $store, $location, $direction ) = @_;
  my ( $volume, $directories, $file ) = File::Spec->splitpath ( $location );
  return XML::Comma::Storage::FileUtil->next_in_dir_path
    ( $store->base_directory(),
      $directories,
      $file,
      $self->{_extension},
      $direction );
}

sub first_location {
  my ( $self, $store ) = @_;
  return XML::Comma::Storage::FileUtil->first_or_last_down_dir_path
    ( $store->base_directory(),
      $self->{_extension} );
}

sub last_location {
  my ( $self, $store ) = @_;
  return XML::Comma::Storage::FileUtil->first_or_last_down_dir_path
    ( $store->base_directory(),
      $self->{_extension},
      1 );
}

sub write_blob {
  my ( $self, $store, $store_location, $store_id, $blob,
       $content, $new_location ) = @_;
  my $blocation;
  if ( $new_location ) {
    $blocation = XML::Comma::Storage::FileUtil->create_randnamed_file
      ( (File::Spec->splitpath($store_location))[1],
        $store_id . '-',
        $blob->get_extension(),
        $store->file_permissions() );
  } else {
    $blocation = $blob->get_location() ||
      XML::Comma::Storage::FileUtil->create_randnamed_file
          ( (File::Spec->splitpath($store_location))[1],
            $store_id . '-',
            $blob->get_extension(),
            $store->file_permissions() );
  }
  XML::Comma::Storage::FileUtil->write_file ( $blocation,
                                              $content,
                                              $store->file_permissions() );
  return $blocation;
}

sub read_blob {
  my ( $self, $store, $blob ) = @_;
  return XML::Comma::Storage::FileUtil->read_file ( $blob->get_location() );
}

sub copy_to_blob {
  my ( $self, $store, $store_location, $store_id, $blob, 
       $from_filename, $to_filename ) = @_;
  my $blocation = $to_filename ||
    XML::Comma::Storage::FileUtil->create_randnamed_file
        ( (File::Spec->splitpath($store_location))[1],
          $store_id . '-',
          #$blob->def()->element('extension')->get(),
          $blob->get_extension(),
          $store->file_permissions() );
  copy ( $from_filename, $blocation ) ||
    die "could not copy to blob file '$from_filename': $!\n";
  return $blocation;
}

sub erase_blob {
  my ( $self, $store, $blob, $blob_location ) = @_;
  # dbg 'trying to unlink', $blob_location || $blob || '<none>';
  if ( $blob_location ) {
    unlink $blob_location;
  } else {
    unlink $blob->get_location();
  }
  # dbg 'done unlinking';
}

sub touch {
  my ( $self, $store, $location ) = @_;
  my $now = time;
  utime $now, $now, ( $location );
  return $now;
}

sub last_modified {
  my ( $self, $store, $location ) = @_;
  return (stat($location))[9];
}


##

sub extension {
  return $_[0]->{_extension};
}

1;