Index: /trunk/DataStore/MANIFEST =================================================================== --- /trunk/DataStore/MANIFEST (revision 7950) +++ /trunk/DataStore/MANIFEST (revision 7951) @@ -3,6 +3,4 @@ LICENSE MANIFEST -META.yml -Makefile.PL README Todo @@ -13,4 +11,6 @@ lib/DataStore/FileSet/Parser.pm lib/DataStore/Product.pm +lib/DataStore/Product/Parser.pm +lib/DataStore/Root.pm lib/DataStore/Record.pm lib/DataStore/Response.pm Index: /trunk/DataStore/lib/DataStore.pm =================================================================== --- /trunk/DataStore/lib/DataStore.pm (revision 7950) +++ /trunk/DataStore/lib/DataStore.pm (revision 7951) @@ -1,5 +1,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: DataStore.pm,v 1.4 2006-03-20 22:09:20 jhoblitt Exp $ +# $Id: DataStore.pm,v 1.5 2006-07-22 01:17:33 smalle Exp $ package DataStore; @@ -111,5 +111,7 @@ use DataStore::FileSet::Parser; use DataStore::FileSet; +use DataStore::Product::Parser; use DataStore::Product; +use DataStore::Root; use DataStore::Response; use DataStore::Utils; Index: /trunk/DataStore/lib/DataStore/File.pm =================================================================== --- /trunk/DataStore/lib/DataStore/File.pm (revision 7950) +++ /trunk/DataStore/lib/DataStore/File.pm (revision 7951) @@ -1,5 +1,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: File.pm,v 1.12 2006-03-20 22:11:24 jhoblitt Exp $ +# $Id: File.pm,v 1.13 2006-07-22 01:17:33 smalle Exp $ package DataStore::File; @@ -18,9 +18,9 @@ use Digest::MD5::File qw( file_md5_hex ); use File::stat; -use Params::Validate qw( validate SCALAR ); +use Params::Validate qw( validate SCALAR ARRAYREF ); use vars qw( @BASE_FIELDS ); -@BASE_FIELDS = qw( fileid bytes md5sum type ); +@BASE_FIELDS = qw( fileid bytes md5sum type extra ); __PACKAGE__->mk_accessors(@BASE_FIELDS); @@ -129,5 +129,4 @@ callbacks => { 'is valid uri filename' => sub { $_[0] !~ m|/$| }, - }, }, @@ -155,4 +154,8 @@ optional => 1, }, + extra => { + type => SCALAR | ARRAYREF, + optional => 1, + }, }, ); @@ -228,34 +231,32 @@ my $response = $ua->request($request, $p{filename}); - if (! $response->is_success) { - carp $response->status_line; - return; - } - - if (defined $self->bytes) { - my $size = stat($p{filename})->size; - if (! $self->bytes == $size) { - unlink $p{filename}; - carp "uri: ", $self->uri, - " - expected size: ", $self->bytes, - " got: ", $size; - return; + if ($response->is_success) { + # check size + if (defined $self->bytes) { + my $size = stat($p{filename})->size; + if (! $self->bytes == $size) { + unlink $p{filename}; + carp "uri: ", $self->uri, + " - expected size: ", $self->bytes, + " got: ", $size; + return; + } + } + + if (defined $self->md5sum) { + my $md5 = file_md5_hex($p{filename}); + if (! $self->md5sum eq $md5) { + unlink $p{filename}; + carp "uri: ", $self->uri, + " - expected md5: ", $self->md5sum, + " got: ", $md5; + return; + } } } - if (defined $self->md5sum) { - my $md5 = file_md5_hex($p{filename}); - if (! $self->md5sum eq $md5) { - unlink $p{filename}; - carp "uri: ", $self->uri, - " - expected md5: ", $self->md5sum, - " got: ", $md5; - return; - } - } - # return DS::Response object my $dsr = DataStore::Response->new( - is_success => 1, + is_success => $response->is_success, code => $response->code, status_line => $response->status_line, Index: /trunk/DataStore/lib/DataStore/File/Parser.pm =================================================================== --- /trunk/DataStore/lib/DataStore/File/Parser.pm (revision 7950) +++ /trunk/DataStore/lib/DataStore/File/Parser.pm (revision 7951) @@ -1,5 +1,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: Parser.pm,v 1.10 2006-03-17 01:18:48 jhoblitt Exp $ +# $Id: Parser.pm,v 1.11 2006-07-22 01:17:33 smalle Exp $ package DataStore::File::Parser; @@ -90,4 +90,5 @@ 'is valid http uri' => sub { is_uri($_[0]) and $_[0] =~ /^http:/ }, + 'uri ends with /' => sub { $_[0] =~ m|/$| }, }, default => 'http://example.org/', @@ -147,10 +148,14 @@ } - # fields are not allowed to contain \# foreach my $field (@fields) { + # fields are not allowed to contain \# if ($field =~ /\#/) { carp "line $lineno: field $field: contains #: $line"; next LINE; } + + # strip leading and trailing whitespace + $field =~ s/^\s+//; + $field =~ s/\s+$//; } @@ -185,4 +190,6 @@ } + my @extra = @fields[4 .. $#fields] if $#fields >= 4; + # fifo push @data, DataStore::File->new({ @@ -191,4 +198,5 @@ md5sum => $md5sum, type => $type, + extra => \@extra, uri => $self->base_uri . $fileid, }); Index: /trunk/DataStore/lib/DataStore/FileSet.pm =================================================================== --- /trunk/DataStore/lib/DataStore/FileSet.pm (revision 7950) +++ /trunk/DataStore/lib/DataStore/FileSet.pm (revision 7951) @@ -1,5 +1,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: FileSet.pm,v 1.10 2006-03-20 22:11:24 jhoblitt Exp $ +# $Id: FileSet.pm,v 1.11 2006-07-22 01:17:33 smalle Exp $ package DataStore::FileSet; @@ -18,9 +18,9 @@ use DataStore::Utils qw( $STD_FIELD $TIME_FIELD %KNOWN_FILESET_TYPES ); use LWP::UserAgent; -use Params::Validate qw( validate SCALAR ); +use Params::Validate qw( validate SCALAR ARRAYREF ); use vars qw( @BASE_FIELDS ); -@BASE_FIELDS = qw( fileset datetime type ); +@BASE_FIELDS = qw( fileset datetime type extra ); __PACKAGE__->mk_accessors(@BASE_FIELDS); @@ -119,7 +119,6 @@ type => SCALAR, callbacks => { - 'is valid uri dirname' => sub { $_[0] =~ m|/$| }, - - }, + 'is valid uri dirname' => sub { $_[0] =~ m|/$| }, + } }, fileset => { @@ -141,4 +140,8 @@ optional => 1, }, + extra => { + type => SCALAR | ARRAYREF, + optional => 1, + }, }, ); @@ -190,23 +193,16 @@ my $response = $ua->request($request); - if (! $response->is_success) { - carp $response->status_line; - return undef; + my $data; + + if ($response->is_success) { + # parse document + my $parser = DataStore::File::Parser->new(base_uri => $self->uri); + + $data = $parser->parse($response->content); } - - # parse document - my $parser = DataStore::File::Parser->new; - - my $data = $parser->parse($response->content); - - unless ($data) { - carp "Product contains no FileSets"; - return undef; - } - # return DS::Response object my $dsr = DataStore::Response->new( - is_success => 1, + is_success => $response->is_success, code => $response->code, status_line => $response->status_line, Index: /trunk/DataStore/lib/DataStore/FileSet/Parser.pm =================================================================== --- /trunk/DataStore/lib/DataStore/FileSet/Parser.pm (revision 7950) +++ /trunk/DataStore/lib/DataStore/FileSet/Parser.pm (revision 7951) @@ -1,5 +1,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: Parser.pm,v 1.12 2006-03-17 01:18:48 jhoblitt Exp $ +# $Id: Parser.pm,v 1.13 2006-07-22 01:17:33 smalle Exp $ package DataStore::FileSet::Parser; @@ -146,10 +146,14 @@ } - # fields are not allowed to contain # foreach my $field (@fields) { + # fields are not allowed to contain # if ($field =~ /\#/) { carp "line $lineno: field $field: contains #: $line"; next LINE; } + + # strip leading and trailing whitespace + $field =~ s/^\s+//; + $field =~ s/\s+$//; } @@ -177,4 +181,6 @@ } + my @extra = @fields[3 .. $#fields] if $#fields >= 3; + # fifo push @data, DataStore::FileSet->new({ @@ -182,4 +188,5 @@ datetime => $datetime, type => $type, + extra => \@extra, uri => $self->base_uri . $fileset . '/', }); Index: /trunk/DataStore/lib/DataStore/Product.pm =================================================================== --- /trunk/DataStore/lib/DataStore/Product.pm (revision 7950) +++ /trunk/DataStore/lib/DataStore/Product.pm (revision 7951) @@ -1,5 +1,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: Product.pm,v 1.7 2006-03-16 23:52:56 jhoblitt Exp $ +# $Id: Product.pm,v 1.8 2006-07-22 01:17:33 smalle Exp $ package DataStore::Product; @@ -17,5 +17,5 @@ use DataStore::Record; use DataStore::Response; -use DataStore::Utils qw( $STD_FIELD ); +use DataStore::Utils qw( $STD_FIELD $TIME_FIELD %KNOWN_PRODUCT_TYPES ); use LWP::UserAgent; use Params::Validate qw( validate SCALAR); @@ -23,5 +23,5 @@ use vars qw( @BASE_FIELDS ); -@BASE_FIELDS = qw( last_fileset ); +@BASE_FIELDS = qw( product last_fileset last_datetime type desc ); __PACKAGE__->mk_ro_accessors(@BASE_FIELDS); @@ -103,6 +103,9 @@ callbacks => { 'is valid uri dirname' => sub { $_[0] =~ m|/$| }, - } + }, + product => { + type => SCALAR, + optional => 1, }, last_fileset => { @@ -112,4 +115,21 @@ }, optional => 1, + }, + last_datetime => { + type => SCALAR, + regex => $TIME_FIELD, + optional => 1, + }, + type => { + type => SCALAR, + callbacks => { + 'is valid type' => + sub { exists $KNOWN_PRODUCT_TYPES{$_[0]} }, + }, + optional => 1, + }, + desc => { + type => SCALAR, + optional => 1, }, }, @@ -161,23 +181,16 @@ my $response = $ua->request($request); - if (! $response->is_success) { - carp $response->status_line; - return undef; + my $data; + + if ($response->is_success) { + # parse document + my $parser = DataStore::FileSet::Parser->new(base_uri => $self->uri); + + $data = $parser->parse($response->content); } - - # parse document - my $parser = DataStore::FileSet::Parser->new; - - my $data = $parser->parse($response->content); - - unless ($data) { - carp "Product contains no FileSets"; - return undef; - } - # return DS::Response object my $dsr = DataStore::Response->new( - is_success => 1, + is_success => $response->is_success, code => $response->code, status_line => $response->status_line, Index: /trunk/DataStore/lib/DataStore/Product/Parser.pm =================================================================== --- /trunk/DataStore/lib/DataStore/Product/Parser.pm (revision 7951) +++ /trunk/DataStore/lib/DataStore/Product/Parser.pm (revision 7951) @@ -0,0 +1,210 @@ +# Adapted from FileSet/Parser.pm +# +# Copyright (C) 2006 Joshua Hoblitt +# +# $Id: Parser.pm,v 1.1 2006-07-22 01:17:34 smalle Exp $ + +package DataStore::Product::Parser; + +use strict; +use warnings; + +use vars qw($VERSION); +$VERSION = '0.01'; + +use base qw( Class::Accessor::Fast ); + +use Carp qw( carp ); +use Data::Validate::URI qw( is_uri ); +use DataStore::Product; +use DataStore::Utils qw( $STD_FIELD $TIME_FIELD %KNOWN_PRODUCT_TYPES ); +use Params::Validate qw( validate validate_pos SCALAR); + +__PACKAGE__->mk_ro_accessors(qw(base_uri)); + +=pod + +=head1 NAME + +DataStore::Product::Parser - parses the DataStore 'Product' list format + +=head1 SYNOPSIS + + use DataStore::Product::Parser; + + my $parser = DataStore::Product::Parser->new( + base_uri => 'http://example.org/', + ); + + my @data = $parser->parse($str); + or + my $data = $parser->parse($str); + +=head1 DESCRIPTION + +This class parses a root DataStore listing into an array of L objects. + +=head1 USAGE + +=head2 Import Parameters + +This module accepts no arguments to it's C method and exports no +I. + +=head2 Methods + +=head3 Constructors + +=over 4 + +=item * C + +Basic constructor. + + my $parser = DataStore::Product::Parser->new( + base_uri => 'http://example.org/', + ); + +Accepts an optional hash and returns a L object. + +=over 4 + +=item * base_uri + +The base of the URI to set in the created L objects. + +This key is optional and defaults to C. + +=back + +=cut + +sub new +{ + my $class = shift; + + my %p = validate(@_, + { + base_uri => { + type => SCALAR, + callbacks => { + 'is valid http uri' => + sub { is_uri($_[0]) and $_[0] =~ /^http:/ }, + 'uri ends with /' => sub { $_[0] =~ m|/$| }, + }, + default => 'http://example.org/', + }, + }, + ); + + my $self = bless \%p, ref $class || $class; + + return $self; +} + +=back + +=head3 Object Methods + +=over 4 + +=item * C + +Basic accessor. + +=item * C + +Accepts a string and returns a list in list context or an arrayref is scalar +context. An empty list or undef is returned if the string contained no rows. + +=cut + +sub parse +{ + my $self = shift; + + my ($doc) = validate_pos(@_, + { + type => SCALAR, + regex => qr/\S+/, # string with at least 1 non WS char + } + ); + + my @data; + my $lineno = 1; +LINE: foreach my $line (split /\n/, $doc) { + # blank lines + next LINE if $line =~ /^\s*$/; + + # comment lines + next LINE if $line =~ /^\s*\#/; + + my @fields = split /\|/, $line; + + # at least fileset, datatime, and type fields are required + if (scalar @fields < 5) { + carp "line $lineno: not enough fields: $line"; + next LINE; + } + + foreach my $field (@fields) { + # fields are not allowed to contain # + if ($field =~ /\#/) { + carp "line $lineno: field $field: contains #: $line"; + next LINE; + } + + # strip leading and trailing whitespace + $field =~ s/^\s+//; + $field =~ s/\s+$//; + } + + my ($product, $last_fileset, $last_datetime, $type, $desc) = @fields; + + # validate format of fileset + unless ($last_fileset =~ $STD_FIELD) { + carp "line $lineno: field $last_fileset:" + . " does not conform to $STD_FIELD: $line"; + next LINE; + } + + # validate format of datetime + unless ($last_datetime =~ $TIME_FIELD) { + carp "line $lineno: field $last_datetime:" + . " does not conform to $TIME_FIELD"; + next LINE; + } + + unless (exists $KNOWN_PRODUCT_TYPES{$type}) { + carp "line $lineno: type $type unknown: $line"; + next LINE; + } + + # fifo + push @data, DataStore::Product->new({ + product => $product, + last_fileset => $last_fileset, + last_datetime => $last_datetime, + type => $type, + desc => $desc, + uri => $self->base_uri . $product . '/', + }); + } continue { + $lineno++; + } + + return unless @data; + return wantarray ? @data : \@data; +} + +=back + +=head1 SEE ALSO + +L, L + +=cut + +1; + +__END__ Index: /trunk/DataStore/lib/DataStore/Response.pm =================================================================== --- /trunk/DataStore/lib/DataStore/Response.pm (revision 7950) +++ /trunk/DataStore/lib/DataStore/Response.pm (revision 7951) @@ -1,5 +1,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: Response.pm,v 1.3 2006-03-16 21:44:58 jhoblitt Exp $ +# $Id: Response.pm,v 1.4 2006-07-22 01:17:33 smalle Exp $ package DataStore::Response; @@ -13,5 +13,5 @@ use base qw( Class::Accessor::Fast ); -use Params::Validate qw( validate ARRAYREF BOOLEAN SCALAR ); +use Params::Validate qw( validate ARRAYREF BOOLEAN SCALAR UNDEF ); use vars qw( @BASE_FIELDS ); @@ -39,9 +39,11 @@ ); - my $success = $dsr->is_success; - my $code = $dsr->code; - my $status_line = $dsr->status_line; - my $data = $dsr->data; - my DataStore::Response $response = $dsp->request; + if ($data) { + my $success = $dsr->is_success; + my $code = $dsr->code; + my $status_line = $dsr->status_line; + my $data = $dsr->data; + my DataStore::Response $response = $dsp->request; + } =head1 DESCRIPTION @@ -93,5 +95,5 @@ =item * data -Either a scalar value or an arrayref of scalar data. +A scalar value, an arrayref of scalar data, or undef. =item * request @@ -126,5 +128,5 @@ }, data => { - type => SCALAR | ARRAYREF, + type => SCALAR | ARRAYREF | UNDEF, }, request => { Index: /trunk/DataStore/lib/DataStore/Root.pm =================================================================== --- /trunk/DataStore/lib/DataStore/Root.pm (revision 7951) +++ /trunk/DataStore/lib/DataStore/Root.pm (revision 7951) @@ -0,0 +1,176 @@ +# Adapted from Product.pm +# +# Copyright (C) 2006 Joshua Hoblitt +# +# $Id: Root.pm,v 1.1 2006-07-22 01:17:33 smalle Exp $ + +package DataStore::Root; + +use strict; +use warnings; + +use vars qw($VERSION); +$VERSION = '0.01'; + +use base qw( DataStore::Record ); + +use Carp qw( carp ); +use DataStore::FileSet::Parser; +use DataStore::Record; +use DataStore::Response; +use DataStore::Utils qw( $STD_FIELD ); +use LWP::UserAgent; +use Params::Validate qw( validate SCALAR); + +use vars qw( @BASE_FIELDS ); + +@BASE_FIELDS = qw( last_fileset ); + +__PACKAGE__->mk_ro_accessors(@BASE_FIELDS); + +=pod + +=head1 NAME + +DataStore::Root - container for root DataStore index + +=head1 SYNOPSIS + + use DataStore::Root; + + my $dsp = DataStore::Root->new( + uri => 'http://example.com/productid/', + ); + + my DataStore::Response $response = $dsp->request; + +=head1 DESCRIPTION + +This class I L + +=head1 USAGE + +=head2 Import Parameters + +This module accepts no arguments to it's C method and exports no +I. + +=head2 Methods + +=head3 Constructors + +=over 4 + +=item * C + +Basic constructor. + + my $dsp = DataStore::Product->new( + uri => 'http://example.com/productid/', + last_fileset => 'foobar', + ); + +Accepts a mandatory hash and returns a L object. + +=over 4 + +=item * uri + +A valid I URI as a string. I + +=item * last_fileset + +The last FileSet ID that was requested as a string. + +This key is optional. + +=back + +=cut + +sub new +{ + my $class = shift; + + # validates uri, doesn't check other params + my $self = $class->SUPER::new(@_); + + validate(@_, + { + uri => { + type => SCALAR, + callbacks => { + 'is valid uri dirname' => sub { $_[0] =~ m|/$| }, + } + }, + }, + ); + + return $self; +} + +=back + +=head3 Object Methods + +=over 4 + +=item * C + +Basic accessor. + +=item * C + +Basic accessor. + +=item * C + +Retrieves and processes the FileSet listing pointed to by the L of this +object. + +Accepts no parameters and returns a L object. + +=cut + +sub request +{ + my $self = shift; + + # no params + validate(@_, {}); + + # make request + my $ua = LWP::UserAgent->new; + my $request = HTTP::Request->new(GET => $self->uri); + my $response = $ua->request($request); + + my $data; + + if ($request->is_success) { + # parse document + my $parser = DataStore::Product::Parser->new(base_uri => $self->uri); + + $data = $parser->parse($response->content); + } + + # return DS::Response object + my $dsr = DataStore::Response->new( + is_success => $response->is_success, + code => $response->code, + status_line => $response->status_line, + data => $data, + request => $self, + ); +} + +=back + +=head1 SEE ALSO + +L + +=cut + +1; + +__END__ Index: /trunk/DataStore/lib/DataStore/Utils.pm =================================================================== --- /trunk/DataStore/lib/DataStore/Utils.pm (revision 7950) +++ /trunk/DataStore/lib/DataStore/Utils.pm (revision 7951) @@ -1,5 +1,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: Utils.pm,v 1.1 2006-03-16 23:52:56 jhoblitt Exp $ +# $Id: Utils.pm,v 1.2 2006-07-22 01:17:33 smalle Exp $ package DataStore::Utils; @@ -24,4 +24,5 @@ %KNOWN_FILE_TYPES %KNOWN_FILESET_TYPES + %KNOWN_PRODUCT_TYPES ); @@ -34,12 +35,14 @@ %KNOWN_FILE_TYPES %KNOWN_FILESET_TYPES + %KNOWN_PRODUCT_TYPES ); $STD_FIELD = qr/^[a-z0-9-_.]+$/; -$TIME_FIELD = qr/^ (\d{4})-(\d\d)-(\d\d) T (\d\d):(\d\d):(\d\d) Z $/x; +$TIME_FIELD = qr/^(\d{4})-(\d\d)-(\d\d) T (\d\d):(\d\d):(\d\d) Z$/x; $BYTE_FIELD = qr/^\d+$/; $MD5_FIELD = qr/^[0-9a-f]{32}$/; %KNOWN_FILE_TYPES = map { $_ => 1 } qw( chip ); %KNOWN_FILESET_TYPES = map { $_ => 1 } qw( object domeflat skyflat bias dark ); +%KNOWN_PRODUCT_TYPES = map { $_ => 1 } qw( image dump ); =pod Index: /trunk/DataStore/t/01_load.t =================================================================== --- /trunk/DataStore/t/01_load.t (revision 7950) +++ /trunk/DataStore/t/01_load.t (revision 7951) @@ -5,5 +5,5 @@ use lib qw( ./lib ./t ); -use Test::More tests => 9; +use Test::More tests => 11; BEGIN { use_ok('DataStore'); } @@ -13,4 +13,6 @@ BEGIN { use_ok('DataStore::FileSet::Parser'); } BEGIN { use_ok('DataStore::Product'); } +BEGIN { use_ok('DataStore::Product::Parser'); } +BEGIN { use_ok('DataStore::Root'); } BEGIN { use_ok('DataStore::Record'); } BEGIN { use_ok('DataStore::Response'); } Index: /trunk/DataStore/t/02_fileset_parse.t =================================================================== --- /trunk/DataStore/t/02_fileset_parse.t (revision 7950) +++ /trunk/DataStore/t/02_fileset_parse.t (revision 7951) @@ -3,5 +3,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: 02_fileset_parse.t,v 1.6 2006-03-16 21:51:46 jhoblitt Exp $ +# $Id: 02_fileset_parse.t,v 1.7 2006-07-22 01:17:34 smalle Exp $ use strict; @@ -76,5 +76,5 @@ my $parser = DataStore::FileSet::Parser->new; - is($parser->parse('foobar|2006-01-0100:03:04|object'), undef, + is($parser->parse('foobar|2006-01-0100:03:04Z|object'), undef, '->parse() returns undef on failure'); } qr/does not conform /, Index: /trunk/DataStore/t/08_response.t =================================================================== --- /trunk/DataStore/t/08_response.t (revision 7950) +++ /trunk/DataStore/t/08_response.t (revision 7951) @@ -3,5 +3,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: 08_response.t,v 1.1 2006-03-08 02:11:46 jhoblitt Exp $ +# $Id: 08_response.t,v 1.2 2006-07-22 01:17:34 smalle Exp $ use strict; @@ -10,5 +10,5 @@ use lib qw( ./lib ./t ); -use Test::More tests => 9; +use Test::More tests => 8; =head1 NAME @@ -81,10 +81,4 @@ eval { - my $dsr = DataStore::Response->new( data => undef ); -}; -like($@, qr/is not one of the allowed types/, - '->new() fails when data is not valid'); - -eval { my $dsr = DataStore::Response->new( request => CGI->new,