Index: /trunk/DataStore/lib/DataStore/FileSet/Parser.pm =================================================================== --- /trunk/DataStore/lib/DataStore/FileSet/Parser.pm (revision 6473) +++ /trunk/DataStore/lib/DataStore/FileSet/Parser.pm (revision 6474) @@ -1,5 +1,5 @@ # Copyright (C) 2006 Joshua Hoblitt # -# $Id: Parser.pm,v 1.1 2006-02-24 00:52:14 jhoblitt Exp $ +# $Id: Parser.pm,v 1.2 2006-02-24 02:51:31 jhoblitt Exp $ package DataStore::FileSet::Parser; @@ -13,4 +13,9 @@ use Carp qw( carp ); use Params::Validate qw( validate_pos SCALAR); + +my $time_field = qr/^ (\d{4})-(\d\d)-(\d\d) T (\d\d):(\d\d):(\d\d) Z $/x; +my $std_field = qr/^[a-z0-9-_.]+$/; +#my %known_types = map { $_ => 1 } qw( OBJECT DOMEFLAT SKYFLAT BIAS DARK ); +my %known_types = map { $_ => 1 } qw( object domeflat skyflat bias dark ); =pod @@ -80,8 +85,57 @@ ); -# @ = qw( OBJECT DOMEFLAT SKYFLAT BIAS DARK ); + 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 < 3) { + carp "line $lineno: not enough fields: $line"; + next LINE; + } + + my ($fileset, $datetime, $type) = @fields; + + # validate format of fileset and type + foreach my $field ($fileset, $type) { + unless ($field =~ $std_field) { + carp "line $lineno: field $field:" + . " does not conform to $std_field: $line"; + next LINE; + } + } + + # validate format of datetime + unless ($datetime =~ $time_field) { + carp "line $lineno: field $datetime:" + . " does not conform to $time_field"; + next LINE; + } + + unless (exists $known_types{$type}) { + carp "line $lineno: type $type unknown: $line"; + next LINE; + } + + unshift @data, DataStore::FileSet::Record->new({ + fileset => $fileset, + datetime => $datetime, + type => $type, + }); + } continue { + $lineno++; + } + + return @data ? \@data : undef; } -package DataStore::FileSetRecord; +package DataStore::FileSet::Record; use base qw( Class::Accessor::Fast ); Index: /trunk/DataStore/t/02_fileset_parse.t =================================================================== --- /trunk/DataStore/t/02_fileset_parse.t (revision 6474) +++ /trunk/DataStore/t/02_fileset_parse.t (revision 6474) @@ -0,0 +1,144 @@ +#!/usr/bin/env perl + +# Copyright (C) 2006 Joshua Hoblitt +# +# $Id: 02_fileset_parse.t,v 1.1 2006-02-24 02:51:31 jhoblitt Exp $ + +use strict; +use warnings; + +use lib qw( ./lib ./t ); + +use Test::More tests => 4; + +=head1 NAME + +t/parser.t - tests DataStore::FileSet::Parser + +=head1 SYNOPSIS + + prove t/configure/configure.t + +=cut + +use DataStore::FileSet::Parser; +#use Test::Warn; + +can_ok('DataStore::FileSet::Parser', qw( + new + parse +)); + +# ->new() + +{ + my $parser = DataStore::FileSet::Parser->new; + + isa_ok($parser, 'DataStore::FileSet::Parser'); +} + +# ->parse() + +eval { + my $parser = DataStore::FileSet::Parser->new; + + $parser->parse(undef); +}; +like($@, qr/is not one of the allowed types/, + '->parse() fails when passed undef'); + +eval { + my $parser = DataStore::FileSet::Parser->new; + + $parser->parse(''); +}; +like($@, qr/ did not pass regex check/, + '->parse() fails when passed a zero length string'); + +my $example1 =<new->parse($example1); + + is(scalar @$results, 4, "correct number of item returned"); +} +__END__ + +{ + my $item = pop @items; + is($item->stamp, "2005-08-06T19:30:01", "correct time stamp"); + is($item->file_id, "telescope_2005-08-06T19:30:01", "correct file id"); + is($item->type, "metadata", "correct type"); + is($item->size, 8640, "correct size"); + is($item->md5, "c462d570deb517d9bd92e5bb6a21cc86", "correct md5"); + is($item->url, + "http://flaxen.ifa.hawaii.edu/otis/data/metadata/telescope_2005-08-06T19:30:01", "correct url"); + is($item->attributes, undef, "no attributes"); +} + +{ + my $item = pop @items; + is($item->stamp, "2005-08-06T19:40:01", "correct time stamp"); + is($item->file_id, "telescope_2005-08-06T19:40:01", "correct file id"); + is($item->type, "metadata", "correct type"); + is($item->size, 8640, "correct size"); + is($item->md5, "c462d570deb517d9bd92e5bb6a21cc86", "correct md5"); + is($item->url, "http://flaxen.ifa.hawaii.edu/otis/data/metadata/telescope_2005-08-06T19:40:01", "correct url"); + is($item->attributes, undef, "no attributes"); +} + +{ + my $item = pop @items; + is($item->stamp, "2005-08-06T19:50:01", "correct time stamp"); + is($item->file_id, "telescope_2005-08-06T19:50:01", "correct file id"); + is($item->type, "metadata", "correct type"); + is($item->size, 8640, "correct size"); + is($item->md5, "c462d570deb517d9bd92e5bb6a21cc86", "correct md5"); + is($item->url, "http://flaxen.ifa.hawaii.edu/otis/data/metadata/telescope_2005-08-06T19:50:01", "correct url"); + is($item->attributes, undef, "no attributes"); +} +} + +my $example2 =<parse($example2); +my @items = @{ $results }; + +is(scalar @items, 1, "correct number of item returned"); + +{ + my $item = pop @items; + is($item->stamp, "2005-08-06T19:30:01", "correct time stamp"); + is($item->file_id, "telescope_2005-08-06T19:30:01", "correct file id"); + is($item->type, "metadata", "correct type"); + is($item->size, 8640, "correct size"); + is($item->md5, "c462d570deb517d9bd92e5bb6a21cc86", "correct md5"); + is($item->url, "http://flaxen.ifa.hawaii.edu/otis/data/metadata/telescope_2005-08-06T19:30:01", "correct url"); + eq_hash($item->attributes, { foo => 'bar', baz => 'baz' }, "no attributes"); +} +} + +warning_like { + my $results = $parser->parse(<parse(<