File Coverage

blib/lib/Data/Library/OnePerFile.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Data::Library::OnePerFile;
use base qw(Data::Library);

$VERSION = '0.2';

my @missing = __PACKAGE__->missing_methods;
die __PACKAGE__ . ' forgot to implement ' . join ', ', @missing
  if @missing;

use Log::Channel;
{
    my $lblog = new Log::Channel;
    sub lblog { $lblog->(@_) }
}

=head1 NAME

Data::Library::OnePerFile - one-item-per-file repository support class

=head1 SYNOPSIS

Provides a general repository service.  This package
supports source data in files, where each file contains a
single source item.  A tag corresponds to a filename
(tag.EXTENSION where EXTENSION is specified at initialization).
Searching will be done through a list of directories.
The first matching file will be used.
Conflicts are not detected.

OnePerFile recognizes when a source file is changed.

=head1 METHODS

=cut

require 5.004;
use strict;
use Carp;

my %parameters = (
		  "LIB"	=> ".",
		  "EXTENSION" => "data",
		 );

=item B

  my $library = new Data::Library::OnePerFile
		  ({ name => "value" ... });

Supported Library::OnePerFile parameters:

  LIB         Search path for data files.  Defaults to current directory.

  EXTENSION   Filename extension for data files.  Defaults to "data".

=cut

sub new {
    my ($proto, $config) = @_;
    my $class = ref ($proto) || $proto;

    my $self  = $config || {};

    bless ($self, $class);

    $self->_init;

    return $self;
}


sub _init {
    my ($self) = shift;

    # verify input params and set defaults
    # dies on any unknown parameter
    # fills in the default for anything that is not provided

    foreach my $key (keys %$self) {
	if (!exists $parameters{$key}) {
	    croak "Undefined ", __PACKAGE__, " parameter $key";
	}
    }

    foreach my $key (keys %parameters) {
	$self->{$key} = $parameters{$key} unless defined $self->{$key};
    }

    if ($self->{LIB} && !ref $self->{LIB}) {
	$self->{LIB} = [ $self->{LIB} ];
    }
}


=item B

  $library->lookup($tag);

Returns cached data items.  If the source has changed since
it was cached, returns false.

=cut

sub lookup {
    my ($self, $tag) = @_;

    lblog "LOOKUP $tag\n";

    if (! $self->_cache_valid($tag)) {
	return;
    }

    return $self->{TAGS}->{$tag}->{CACHE};
}


sub _cache_valid {
    my ($self, $tag) = @_;

    return unless defined $self->{TAGS}->{$tag};
    return unless defined $self->{TAGS}->{$tag}->{CACHE};

    return unless ($self->{TAGS}->{$tag}->{LOADTS}
		   >= (stat($self->{TAGS}->{$tag}->{FILE}))[9]);

    return 1;
}


=item B

  $library->find($tag);

Searches through the directory path in LIB for a file named
"$tag.EXTENSION".  Returns the contents of that file if successful,
and records the path for subsequent checking by lookup().

=cut

sub find {
    my ($self, $tag) = @_;

    lblog "FIND $tag\n";

    my $file;
    foreach my $lib (@{$self->{LIB}}) {
	$file = "$lib/$tag.$self->{EXTENSION}";
	next unless -r $file;
    }
    if (! -r $file) {
	# never found a matching readable file
	carp "Unable to read $tag.$self->{EXTENSION}";
	return;
    }

    open(INPUT, $file) or croak "open $file failed: $!";
    local $/ = undef;
    my $data = ;
    close INPUT;

    lblog "FOUND $tag in $file\n";

    $self->{TAGS}->{$tag}->{FILE} = $file;
    $self->{TAGS}->{$tag}->{LOADTS} = (stat($self->{TAGS}->{$tag}->{FILE}))[9];

    return $data;
}


=item B

  $library->cache($tag, $data);

Caches data by tag for later fetching via lookup().

=cut

sub cache {
    my ($self, $tag, $data) = @_;

    lblog "CACHE $tag\n";

    $self->{TAGS}->{$tag}->{CACHE} = $data;
}


=item B

  my @array = $library->toc();

Search through the library and return a list of all available entries.
Does not import any of the items.

=cut

sub toc {
    my ($self) = @_;

    my %items;
    foreach my $lib (@{$self->{LIB}}) {
	opendir DIR, $lib or die "open $lib failed: $!";
	foreach my $file (readdir DIR) {
	    next unless $file =~ /\.$self->{EXTENSION}$/;
	    $file =~ s/\.$self->{EXTENSION}$//;
	    $items{$file}++;
	}
	closedir DIR;
    }

    return sort keys %items;
}


=item B

  $library->reset;

Erase all entries from the cache.

=cut

sub reset {
    my ($self) = @_;

    foreach my $tag (keys %$self) {
	delete $self->{TAGS};
    }
}

1;

=head1 AUTHOR

Jason W. May

=head1 COPYRIGHT

Copyright (C) 2001,2002 Jason W. May.  All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut