IPP Software Navigation Tools IPP Links Communication Pan-STARRS Links

Changeset 7951


Ignore:
Timestamp:
Jul 21, 2006, 3:17:34 PM (20 years ago)
Author:
smalle
Message:
  • Added a Root object and associated Product::Parser to query the root of the datastore.
  • The 'is_success' field in a Response now gets its value carried over from the HTTP::Response as intended.
  • The 'data' field in a Response can now be undef to indicate that no records were parsed.
  • Root::request, Product::request, FileSet::request now always return a Response object.
  • FileSets and Files will now have any additional non-standard fields parsed into the @extra array.
  • Updated tests.
Location:
trunk/DataStore
Files:
3 added
12 edited

Legend:

Unmodified
Added
Removed

  • trunk/DataStore/MANIFEST

    r6650 r7951  
    33LICENSE
    44MANIFEST
    5 META.yml
    6 Makefile.PL
    75README
    86Todo
    … …  
    1311lib/DataStore/FileSet/Parser.pm
    1412lib/DataStore/Product.pm
     13lib/DataStore/Product/Parser.pm
     14lib/DataStore/Root.pm
    1515lib/DataStore/Record.pm
    1616lib/DataStore/Response.pm

  • trunk/DataStore/lib/DataStore.pm

    r6652 r7951  
    11# Copyright (C) 2006  Joshua Hoblitt
    22#
    3 # $Id: DataStore.pm,v 1.4 2006-03-20 22:09:20 jhoblitt Exp $
     3# $Id: DataStore.pm,v 1.5 2006-07-22 01:17:33 smalle Exp $
    44
    55package DataStore;
    … …  
    111111use DataStore::FileSet::Parser;
    112112use DataStore::FileSet;
     113use DataStore::Product::Parser;
    113114use DataStore::Product;
     115use DataStore::Root;
    114116use DataStore::Response;
    115117use DataStore::Utils;

  • trunk/DataStore/lib/DataStore/File.pm

    r6652 r7951  
    11# Copyright (C) 2006  Joshua Hoblitt
    22#
    3 # $Id: File.pm,v 1.12 2006-03-20 22:11:24 jhoblitt Exp $
     3# $Id: File.pm,v 1.13 2006-07-22 01:17:33 smalle Exp $
    44
    55package DataStore::File;
    … …  
    1818use Digest::MD5::File qw( file_md5_hex );
    1919use File::stat;
    20 use Params::Validate qw( validate SCALAR );
     20use Params::Validate qw( validate SCALAR ARRAYREF );
    2121
    2222use vars qw( @BASE_FIELDS );
    2323
    24 @BASE_FIELDS = qw( fileid bytes md5sum type );
     24@BASE_FIELDS = qw( fileid bytes md5sum type extra );
    2525
    2626__PACKAGE__->mk_accessors(@BASE_FIELDS);
    … …  
    129129                callbacks   => {
    130130                    'is valid uri filename' => sub { $_[0] !~ m|/$| },
    131 
    132131                },
    133132            },
    … …  
    155154                optional    => 1,
    156155            },
     156            extra   => {
     157                type        => SCALAR | ARRAYREF,
     158                optional    => 1,
     159            },
    157160        },
    158161    );
    … …  
    228231    my $response = $ua->request($request, $p{filename});
    229232
    230     if (! $response->is_success) {
    231         carp $response->status_line;
    232         return;
    233     }
    234 
    235     if (defined $self->bytes) {
    236         my $size = stat($p{filename})->size;
    237         if (! $self->bytes == $size) {
    238             unlink $p{filename};
    239             carp "uri: ", $self->uri,
    240                  " - expected size: ", $self->bytes,
    241                  " got: ", $size;
    242             return;
     233    if ($response->is_success) {
     234        # check size
     235        if (defined $self->bytes) {
     236            my $size = stat($p{filename})->size;
     237            if (! $self->bytes == $size) {
     238                unlink $p{filename};
     239                carp "uri: ", $self->uri,
     240                     " - expected size: ", $self->bytes,
     241                     " got: ", $size;
     242                return;
     243            }
     244        }
     245
     246        if (defined $self->md5sum) {
     247            my $md5 = file_md5_hex($p{filename});
     248            if (! $self->md5sum eq $md5) {
     249                unlink $p{filename};
     250                carp "uri: ", $self->uri,
     251                     " - expected md5: ", $self->md5sum,
     252                     " got: ", $md5;
     253                return;
     254            }
    243255        }
    244256    }
    245257
    246     if (defined $self->md5sum) {
    247         my $md5 = file_md5_hex($p{filename});
    248         if (! $self->md5sum eq $md5) {
    249             unlink $p{filename};
    250             carp "uri: ", $self->uri,
    251                  " - expected md5: ", $self->md5sum,
    252                  " got: ", $md5;
    253             return;
    254         }
    255     }
    256 
    257258    # return DS::Response object
    258259    my $dsr = DataStore::Response->new(
    259         is_success  => 1,
     260        is_success  => $response->is_success,
    260261        code        => $response->code,
    261262        status_line => $response->status_line,

  • trunk/DataStore/lib/DataStore/File/Parser.pm

    r6616 r7951  
    11# Copyright (C) 2006  Joshua Hoblitt
    22#
    3 # $Id: Parser.pm,v 1.10 2006-03-17 01:18:48 jhoblitt Exp $
     3# $Id: Parser.pm,v 1.11 2006-07-22 01:17:33 smalle Exp $
    44
    55package DataStore::File::Parser;
    … …  
    9090                    'is valid http uri' =>
    9191                        sub { is_uri($_[0]) and $_[0] =~ /^http:/ },
     92                     'uri ends with /'   => sub { $_[0] =~ m|/$| },
    9293                },
    9394                default =>  'http://example.org/',
    … …  
    147148        }
    148149
    149         # fields are not allowed to contain \#
    150150        foreach my $field (@fields) {
     151            # fields are not allowed to contain \#
    151152            if ($field =~ /\#/) {
    152153                carp "line $lineno: field $field: contains #: $line";
    153154                next LINE;
    154155            }
     156
     157            # strip leading and trailing whitespace
     158            $field =~ s/^\s+//;
     159            $field =~ s/\s+$//;
    155160        }
    156161
    … …  
    185190        }
    186191
     192        my @extra = @fields[4 .. $#fields] if $#fields >= 4;
     193
    187194        # fifo 
    188195        push @data, DataStore::File->new({
    … …  
    191198            md5sum  => $md5sum,
    192199            type    => $type,
     200            extra   => \@extra,
    193201            uri     => $self->base_uri . $fileid,
    194202        });

  • trunk/DataStore/lib/DataStore/FileSet.pm

    r6652 r7951  
    11# Copyright (C) 2006  Joshua Hoblitt
    22#
    3 # $Id: FileSet.pm,v 1.10 2006-03-20 22:11:24 jhoblitt Exp $
     3# $Id: FileSet.pm,v 1.11 2006-07-22 01:17:33 smalle Exp $
    44
    55package DataStore::FileSet;
    … …  
    1818use DataStore::Utils qw( $STD_FIELD $TIME_FIELD %KNOWN_FILESET_TYPES );
    1919use LWP::UserAgent;
    20 use Params::Validate qw( validate SCALAR );
     20use Params::Validate qw( validate SCALAR ARRAYREF );
    2121
    2222use vars qw( @BASE_FIELDS );
    2323
    24 @BASE_FIELDS = qw( fileset datetime type );
     24@BASE_FIELDS = qw( fileset datetime type extra );
    2525
    2626__PACKAGE__->mk_accessors(@BASE_FIELDS);
    … …  
    119119                type        => SCALAR,
    120120                callbacks   => {
    121                     'is valid uri dirname' => sub { $_[0] =~ m|/$| },
    122 
    123                 },
     121                    'is valid uri dirname'   => sub { $_[0] =~ m|/$| },
     122                }
    124123            },
    125124            fileset     => {
    … …  
    141140                optional    => 1,
    142141            },
     142            extra       => {
     143                type        => SCALAR | ARRAYREF,
     144                optional    => 1,
     145            },
    143146        },
    144147    );
    … …  
    190193    my $response = $ua->request($request);
    191194
    192     if (! $response->is_success) {
    193         carp $response->status_line;
    194         return undef;
     195    my $data;
     196
     197    if ($response->is_success) {
     198        # parse document
     199        my $parser = DataStore::File::Parser->new(base_uri => $self->uri);
     200
     201        $data = $parser->parse($response->content);
    195202    }
    196 
    197     # parse document
    198     my $parser = DataStore::File::Parser->new;
    199 
    200     my $data = $parser->parse($response->content);
    201 
    202     unless ($data) {
    203         carp "Product contains no FileSets";
    204         return undef;
    205     }
    206 
    207203
    208204    # return DS::Response object
    209205    my $dsr = DataStore::Response->new(
    210         is_success  => 1,
     206        is_success  => $response->is_success,
    211207        code        => $response->code,
    212208        status_line => $response->status_line,

  • trunk/DataStore/lib/DataStore/FileSet/Parser.pm

    r6616 r7951  
    11# Copyright (C) 2006  Joshua Hoblitt
    22#
    3 # $Id: Parser.pm,v 1.12 2006-03-17 01:18:48 jhoblitt Exp $
     3# $Id: Parser.pm,v 1.13 2006-07-22 01:17:33 smalle Exp $
    44
    55package DataStore::FileSet::Parser;
    … …  
    146146        }
    147147
    148         # fields are not allowed to contain #
    149148        foreach my $field (@fields) {
     149            # fields are not allowed to contain #
    150150            if ($field =~ /\#/) {
    151151                carp "line $lineno: field $field: contains #: $line";
    152152                next LINE;
    153153            }
     154
     155            # strip leading and trailing whitespace
     156            $field =~ s/^\s+//;
     157            $field =~ s/\s+$//;
    154158        }
    155159
    … …  
    177181        }
    178182
     183        my @extra = @fields[3 .. $#fields] if $#fields >= 3;
     184
    179185        # fifo
    180186        push @data, DataStore::FileSet->new({
    … …  
    182188            datetime    => $datetime,
    183189            type        => $type,
     190            extra       => \@extra,
    184191            uri         => $self->base_uri . $fileset . '/',
    185192        });

  • trunk/DataStore/lib/DataStore/Product.pm

    r6612 r7951  
    11# Copyright (C) 2006  Joshua Hoblitt
    22#
    3 # $Id: Product.pm,v 1.7 2006-03-16 23:52:56 jhoblitt Exp $
     3# $Id: Product.pm,v 1.8 2006-07-22 01:17:33 smalle Exp $
    44
    55package DataStore::Product;
    … …  
    1717use DataStore::Record;
    1818use DataStore::Response;
    19 use DataStore::Utils qw( $STD_FIELD );
     19use DataStore::Utils qw( $STD_FIELD $TIME_FIELD %KNOWN_PRODUCT_TYPES );
    2020use LWP::UserAgent;
    2121use Params::Validate qw( validate SCALAR);
    … …  
    2323use vars qw( @BASE_FIELDS );
    2424
    25 @BASE_FIELDS = qw( last_fileset );
     25@BASE_FIELDS = qw( product last_fileset last_datetime type desc );
    2626
    2727__PACKAGE__->mk_ro_accessors(@BASE_FIELDS);
    … …  
    103103                callbacks   => {
    104104                    'is valid uri dirname'   => sub { $_[0] =~ m|/$| },
    105 
    106105                }
     106            },
     107            product         => {
     108                type        => SCALAR,
     109                optional    => 1,
    107110            },
    108111            last_fileset    => {
    … …  
    112115                },
    113116                optional    => 1,
     117            },
     118            last_datetime    => {
     119                type        => SCALAR,
     120                regex       => $TIME_FIELD,
     121                optional    => 1,
     122            },
     123            type        => {
     124                type        => SCALAR,
     125                callbacks   => {
     126                    'is valid type' =>
     127                        sub { exists $KNOWN_PRODUCT_TYPES{$_[0]} },
     128                },
     129                optional    => 1,
     130            },
     131            desc        => {
     132                 type       => SCALAR,
     133                 optional   => 1,
    114134            },
    115135        },
    … …  
    161181    my $response = $ua->request($request);
    162182
    163     if (! $response->is_success) {
    164         carp $response->status_line;
    165         return undef;
     183    my $data;
     184
     185    if ($response->is_success) {
     186        # parse document
     187        my $parser = DataStore::FileSet::Parser->new(base_uri => $self->uri);
     188
     189        $data = $parser->parse($response->content);
    166190    }
    167 
    168     # parse document
    169     my $parser = DataStore::FileSet::Parser->new;
    170 
    171     my $data = $parser->parse($response->content);
    172 
    173     unless ($data) {
    174         carp "Product contains no FileSets";
    175         return undef;
    176     }
    177 
    178191
    179192    # return DS::Response object
    180193    my $dsr = DataStore::Response->new(
    181         is_success  => 1,
     194        is_success  => $response->is_success,
    182195        code        => $response->code,
    183196        status_line => $response->status_line,

  • trunk/DataStore/lib/DataStore/Response.pm

    r6603 r7951  
    11# Copyright (C) 2006  Joshua Hoblitt
    22#
    3 # $Id: Response.pm,v 1.3 2006-03-16 21:44:58 jhoblitt Exp $
     3# $Id: Response.pm,v 1.4 2006-07-22 01:17:33 smalle Exp $
    44
    55package DataStore::Response;
    … …  
    1313use base qw( Class::Accessor::Fast );
    1414
    15 use Params::Validate qw( validate ARRAYREF BOOLEAN SCALAR );
     15use Params::Validate qw( validate ARRAYREF BOOLEAN SCALAR UNDEF );
    1616
    1717use vars qw( @BASE_FIELDS );
    … …  
    3939    );
    4040
    41     my $success     = $dsr->is_success;
    42     my $code        = $dsr->code;
    43     my $status_line = $dsr->status_line;
    44     my $data        = $dsr->data;
    45     my DataStore::Response $response = $dsp->request;
     41    if ($data) {
     42        my $success     = $dsr->is_success;
     43        my $code        = $dsr->code;
     44        my $status_line = $dsr->status_line;
     45        my $data        = $dsr->data;
     46        my DataStore::Response $response = $dsp->request;
     47    }
    4648
    4749=head1 DESCRIPTION
    … …  
    9395=item * data
    9496
    95 Either a scalar value or an arrayref of scalar data.
     97A scalar value, an arrayref of scalar data, or undef.
    9698
    9799=item * request
    … …  
    126128            },
    127129            data        => {
    128                 type        => SCALAR | ARRAYREF,
     130                type        => SCALAR | ARRAYREF | UNDEF,
    129131            },
    130132            request     => {

  • trunk/DataStore/lib/DataStore/Utils.pm

    r6612 r7951  
    11# Copyright (C) 2006  Joshua Hoblitt
    22#
    3 # $Id: Utils.pm,v 1.1 2006-03-16 23:52:56 jhoblitt Exp $
     3# $Id: Utils.pm,v 1.2 2006-07-22 01:17:33 smalle Exp $
    44
    55package DataStore::Utils;
    … …  
    2424    %KNOWN_FILE_TYPES
    2525    %KNOWN_FILESET_TYPES
     26    %KNOWN_PRODUCT_TYPES
    2627);
    2728
    … …  
    3435    %KNOWN_FILE_TYPES
    3536    %KNOWN_FILESET_TYPES
     37    %KNOWN_PRODUCT_TYPES
    3638);
    3739
    3840$STD_FIELD = qr/^[a-z0-9-_.]+$/;
    39 $TIME_FIELD = qr/^ (\d{4})-(\d\d)-(\d\d) T (\d\d):(\d\d):(\d\d) Z $/x;
     41$TIME_FIELD = qr/^(\d{4})-(\d\d)-(\d\d) T (\d\d):(\d\d):(\d\d) Z$/x;
    4042$BYTE_FIELD = qr/^\d+$/;
    4143$MD5_FIELD = qr/^[0-9a-f]{32}$/;
    4244%KNOWN_FILE_TYPES = map { $_ => 1 } qw( chip );
    4345%KNOWN_FILESET_TYPES = map { $_ => 1 } qw( object domeflat skyflat bias dark );
     46%KNOWN_PRODUCT_TYPES = map { $_ => 1 } qw( image dump );
    4447
    4548=pod

  • trunk/DataStore/t/01_load.t

    r6612 r7951  
    55use lib qw( ./lib ./t );
    66
    7 use Test::More tests => 9;
     7use Test::More tests => 11;
    88
    99BEGIN { use_ok('DataStore'); }
    … …  
    1313BEGIN { use_ok('DataStore::FileSet::Parser'); }
    1414BEGIN { use_ok('DataStore::Product'); }
     15BEGIN { use_ok('DataStore::Product::Parser'); }
     16BEGIN { use_ok('DataStore::Root'); }
    1517BEGIN { use_ok('DataStore::Record'); }
    1618BEGIN { use_ok('DataStore::Response'); }

  • trunk/DataStore/t/02_fileset_parse.t

    r6606 r7951  
    33# Copyright (C) 2006  Joshua Hoblitt
    44#
    5 # $Id: 02_fileset_parse.t,v 1.6 2006-03-16 21:51:46 jhoblitt Exp $
     5# $Id: 02_fileset_parse.t,v 1.7 2006-07-22 01:17:34 smalle Exp $
    66
    77use strict;
    … …  
    7676    my $parser = DataStore::FileSet::Parser->new;
    7777
    78     is($parser->parse('foobar|2006-01-0100:03:04|object'), undef,
     78    is($parser->parse('foobar|2006-01-0100:03:04Z|object'), undef,
    7979        '->parse() returns undef on failure');
    8080} qr/does not conform /,

  • trunk/DataStore/t/08_response.t

    r6542 r7951  
    33# Copyright (C) 2006  Joshua Hoblitt
    44#
    5 # $Id: 08_response.t,v 1.1 2006-03-08 02:11:46 jhoblitt Exp $
     5# $Id: 08_response.t,v 1.2 2006-07-22 01:17:34 smalle Exp $
    66
    77use strict;
    … …  
    1010use lib qw( ./lib ./t );
    1111
    12 use Test::More tests => 9;
     12use Test::More tests => 8;
    1313
    1414=head1 NAME
    … …  
    8181
    8282eval {
    83     my $dsr = DataStore::Response->new( data => undef );
    84 };
    85 like($@, qr/is not one of the allowed types/,
    86     '->new() fails when data is not valid');
    87 
    88 eval {
    8983    my $dsr = DataStore::Response->new(
    9084        request => CGI->new,
Note: See TracChangeset for help on using the changeset viewer.