# @(#)$Id: Schema.pm 431 2013-04-01 01:11:58Z pjf $
use strict;
use version; our $VERSION = qv( sprintf '0.15.%d', q$Rev: 431 $ =~ /\d+/gmx );
use Moose;
use File::DataClass::Constraints qw(Cache Directory DummyClass Lock Path);
use File::DataClass::Functions qw(ensure_class_loaded merge_attributes throw);
use MooseX::Types::Moose qw(Bool ClassName HashRef Num Object Str);
extends qw(File::DataClass);
has 'cache' => is => 'ro', isa => Cache,
builder => '_build_cache', lazy => TRUE;
has 'cache_attributes' => is => 'ro', isa => HashRef,
default => sub { {
driver => q(FastMmap),
page_size => 131072,
num_pages => 89,
unlink_on_exit => TRUE, } };
has 'cache_class' => is => 'ro', isa => ClassName | DummyClass,
default => q(File::DataClass::Cache);
has 'debug' => is => 'ro', isa => Bool, default => FALSE;
has 'lock' => is => 'ro', isa => Lock,
default => sub { Class::Null->new }, lazy => TRUE;
has 'log' => is => 'ro', isa => Object,
default => sub { Class::Null->new }, lazy => TRUE;
has 'path' => is => 'rw', isa => Path, coerce => TRUE;
has 'perms' => is => 'rw', isa => Num, default => PERMS;
has 'result_source_attributes' => is => 'ro', isa => HashRef,
default => sub { {} };
has 'result_source_class' => is => 'ro', isa => ClassName,
default => q(File::DataClass::ResultSource);
has 'source_registrations' => is => 'ro', isa => HashRef[Object],
builder => '_build_source_registrations', lazy => TRUE;
has 'storage' => is => 'rw', isa => Object,
builder => '_build_storage', lazy => TRUE;
has 'storage_attributes' => is => 'ro', isa => HashRef,
default => sub { {} };
has 'storage_base' => is => 'ro', isa => ClassName,
default => q(File::DataClass::Storage);
has 'storage_class' => is => 'rw', isa => Str,
default => q(XML::Simple);
has 'tempdir' => is => 'ro', isa => Directory, coerce => TRUE,
default => File::Spec->tmpdir;
around 'BUILDARGS' => sub {
my ($next, $class, @args) = @_; my $attr = $class->$next( @args );
my $builder = delete $attr->{builder} or return $attr;
my $config = $builder->can( q(config) ) ? $builder->config : {};
merge_attributes $attr, $builder, [ qw(debug lock log tempdir) ];
merge_attributes $attr, $config, [ qw(tempdir) ];
return $attr;
};
sub dump {
my ($self, $args) = @_; blessed $self or $self = $self->_constructor;
my $path = $args->{path} || $self->path;
blessed $path or $path = io( $path );
return $self->storage->dump( $path, $args->{data} || {} );
}
sub extensions {
return EXTENSIONS;
}
sub load {
my ($self, @paths) = @_; blessed $self or $self = $self->_constructor;
$paths[ 0 ] or $paths[ 0 ] = $self->path;
@paths = map { blessed $_ ? $_ : io( $_ ) } @paths;
return $self->storage->load( @paths ) || {};
}
sub resultset {
my ($self, $moniker) = @_; return $self->source( $moniker )->resultset;
}
sub source {
my ($self, $moniker) = @_; $moniker or throw 'Result source not specified';
my $source = $self->source_registrations->{ $moniker }
or throw error => 'Result source [_1] unknown', args => [ $moniker ];
return $source;
}
sub sources {
return keys %{ shift->source_registrations };
}
sub translate {
my ($self, $args) = @_;
my $class = blessed $self || $self;
my $from_class = $args->{from_class} || q(Any);
my $to_class = $args->{to_class } || q(Any);
my $attrs = { path => $args->{from}, storage_class => $from_class };
my $data = $class->new( $attrs )->load;
$attrs = { path => $args->{to}, storage_class => $to_class };
$class->new( $attrs )->dump( { data => $data } );
return;
}
# Private methods
sub _build_cache {
my $self = shift; (my $ns = lc __PACKAGE__) =~ s{ :: }{-}gmx; my $cache;
my $attrs = { cache_attributes => { %{ $self->cache_attributes } },
builder => $self };
$ns = $attrs->{cache_attributes}->{namespace} ||= $ns;
$cache = $self->F_DC_Cache and exists $cache->{ $ns }
and return $cache->{ $ns };
$self->cache_class eq q(none) and return Class::Null->new;
$attrs->{cache_attributes}->{root_dir} ||= NUL.$self->tempdir;
return $self->F_DC_Cache->{ $ns } = $self->cache_class->new( $attrs );
}
sub _build_source_registrations {
my $self = shift; my $sources = {};
for my $moniker (keys %{ $self->result_source_attributes }) {
my $attrs = { %{ $self->result_source_attributes->{ $moniker } } };
my $class = delete $attrs->{result_source_class}
|| $self->result_source_class;
$attrs->{name} = $moniker; $attrs->{schema} = $self;
$sources->{ $moniker } = $class->new( $attrs );
}
return $sources;
}
sub _build_storage {
my $self = shift; my $class = $self->storage_class;
if (q(+) eq substr $class, 0, 1) { $class = substr $class, 1 }
else { $class = $self->storage_base.q(::).$class }
ensure_class_loaded $class;
return $class->new( { %{ $self->storage_attributes }, schema => $self } );
}
sub _constructor {
my $class = shift;
my $attr = { cache_class => q(none), storage_class => q(Any) };
return $class->new( $attr );
}
__PACKAGE__->meta->make_immutable;
no Moose;
1;
__END__
=pod
=head1 Name
File::DataClass::Schema - Base class for schema definitions
=head1 Version
0.15.$Revision: 431 $
=head1 Synopsis
use File::DataClass::Schema;
$schema = File::DataClass::Schema->new
( path => [ qw(path to a file) ],
result_source_attributes => { source_name => {}, },
tempdir => [ qw(path to a directory) ] );
$schema->source( q(source_name) )->attributes( [ qw(list of attr names) ] );
$rs = $schema->resultset( q(source_name) );
$result = $rs->find( { name => q(id of field element to find) } );
$result->$attr_name( $some_new_value );
$result->update;
@result = $rs->search( { 'attr name' => q(some value) } );
=head1 Description
Base class for schema definitions. Each element in a data file
requires a result source to define it's attributes
=head1 Configuration and Environment
Registers all result sources defined by the result source attributes
Creates a new instance of the storage class which defaults to
L<File::DataClass::Storage::XML::Simple>
Defines these attributes
=over 3
=item C<cache>
Instantiates and returns the L<Cache|File::DataClass/Cache> class
attribute. Built on demand
=item C<cache_attributes>
Passed to the L<Cache::Cache> constructor
=item C<debug>
Writes debug information to the log object if set to true
=item C<exception_class>
A classname that is expected to have a class method C<throw>. Defaults to
L<File::DataClass::Exception> and is of type C<File::DataClass::Exception>
=item C<builder>
An optional object that provides these methods; C<debug>,
C<exception_class>, C<lock>, C<log>, and C<tempdir>. Their values are
or'ed with values in the attributes hash before being passed to the
constructor
=item C<lock>
Defaults to L<Class::Null>. Can be set via the C<builder>
attribute. Built on demand
=item C<log>
Log object. Typically an instance of L<Log::Handler>
=item C<path>
Path to the file. This is a L<File::DataClass::IO> object that can be
coerced from either a string or an array ref
=item C<perms>
Permissions to set on the file if it is created. Defaults to
L<PERMS|File::DataClass::Constants/PERMS>
=item C<result_source_attributes>
A hash ref of result sources. See L<File::DataClass::ResultSource>
=item C<result_source_class>
The class name used to create result sources when the source registration
attribute is instantiated. Acts as a schema wide default of not overridden
in the C<result_source_attributes>
=item C<source_registrations>
A hash ref or registered result sources, i.e. the keys of the
C<result_source_attributes> hash
=item C<storage>
An instance of a subclass of L<File::DataClass::Storage>
=item C<storage_attributes>
Attributes passed to the storage object's constructor
=item C<storage_base>
If the storage class is only a partial classname then this attribute is
prepended to it
=item C<storage_class>
The name of the storage class to instantiate
=item C<tempdir>
Temporary directory used to store the cache and lock objects disk
representation
=back
=head1 Subroutines/Methods
=head2 dump
$schema->dump( { path => $to_file, data => $data_hash } );
Dumps the data structure to a file. Path defaults to the one specified in
the schema definition. Returns the data that was written to the file if
successful
=head2 extensions
\%extension_map = $self->extensions;
Returns a hash ref that maps filename extensions (keys) onto storage
subclasses (values)
=head2 load
$data_hash = $schema->load( @paths );
Loads and returns the merged data structure from the named
files. Paths defaults to the one specified in the schema
definition. Data will be read from cache if available and not stale
=head2 resultset
$rs = $schema->resultset( $source_name );
Returns a resultset object which by default is an instance of
L<File::DataClass::Resultset>
=head2 source
$source = $schema->source( $source_name );
Returns a result source object which by default is an instance of
L<File::DataClass::ResultSource>
=head2 sources
@sources = $schema->sources;
Returns a list of all registered result source names
=head2 translate
$schema->translate( $args );
Reads a file in one format and writes it back out in another format
=head1 Diagnostics
Setting the C<debug> attribute to true will cause the log object's
debug method to be called with useful information
=head1 Dependencies
=over 3
=item L<namespace::autoclean>
=item L<Class::Null>
=item L<File::DataClass>
=item L<File::DataClass::Cache>
=item L<File::DataClass::Constants>
=item L<File::DataClass::Exception>
=item L<File::DataClass::Functions>
=item L<File::DataClass::ResultSource>
=item L<File::DataClass::Storage>
=item L<IPC::SRLock>
=item L<Moose>
=back
=head1 Incompatibilities
There are no known incompatibilities in this module
=head1 Bugs and Limitations
There are no known bugs in this module.
Please report problems to the address below.
Patches are welcome
=head1 Acknowledgements
Larry Wall - For the Perl programming language
=head1 Author
Peter Flanigan, C<< <Support at RoxSoft.co.uk> >>
=head1 License and Copyright
Copyright (c) 2013 Peter Flanigan. All rights reserved
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>
This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
=cut
# Local Variables:
# mode: perl
# tab-width: 3
# End: