lib/CXGN/FileRepository.pm

   1 package CXGN::FileRepository;
   2 use namespace::autoclean;
   3 use Moose;
   4 use Moose::Util::TypeConstraints;
   5
   6 use Carp;
   7
   8 use File::Path;
   9 use Path::Class;
  10
  11 use CXGN::FileRepository::VersionedFile;
  12
  13 =head1 NAME
  14
  15 CXGN::FileRepository - versioned file repository
  16
  17 =head1 SYNOPSIS
  18
  19   # open a repository that contains versioned files
  20   my $repos = CXGN::FileRepository
  21                  ->new( '/some/directory/somewhere/' );
  22
  23
  24   # get a certain CXGN::FileRepository::VersionedFile for the file in
  25   # FileClass 'MyFoo' that has metadata bar => 'baz', boo => 'blorg'
  26   # DIES if the given attributes are not specific enough
  27   my $versionedfile = $repos->get_vf( class => 'MyFoo',
  28                                       bar => 'baz',
  29                                       boo => 'blorg',
  30                                     );
  31
  32   # same as get_vf, but returns a Path::Class::File object for the
  33   # current version of the specified file, or nothing if there is no
  34   # current version
  35   my $file = $repos->get_file( metadata... )
  36
  37   # function to search for VersionedFiles matching some attributes
  38   my @versionedfiles = $repos->search_vfs( class => 'MyBar',
  39                                            something => 'something',
  40                                          );
  41
  42   # same as above, but returns Path::Class::File objects for current
  43   # versions
  44   my @files = $repos->search_vfs( same... )
  45
  46   # publish a new version of the MyFoo in $versionedfile, and
  47   # remove/unpublish all the files in @versionedfiles, all in one
  48   # CXGN::Publish transaction
  49
  50   $repos->publish(  $versionedfile->publish_new_version( '/foo/bar.txt' ),
  51                     map $_->publish_remove, @versionedfiles
  52                  );
  53
  54
  55 =head1 DESCRIPTION
  56
  57 Representation of a file repository of clone sequences, annotations,
  58 and other data
  59
  60 =head1 ROLES
  61
  62 none
  63
  64 =head1 BASE CLASS(ES)
  65
  66 none
  67
  68 =head1 SUBCLASSES
  69
  70 none
  71
  72 =head1 ATTRIBUTES
  73
  74 Attributes are read only unless otherwise noted.
  75
  76   basedir - (Path::Class::Dir) base directory for this file repository.
  77
  78   create - boolean, whether this repos is set to create its own base
  79            dir
  80
  81   publisher - CXGN::Publish object to use for publishing files to this
  82               repository
  83
  84 =cut
  85
  86 # and define the basedir attribute
  87 has basedir =>
  88     ( is => 'ro',
  89       isa => 'Path::Class::Dir',
  90     );
  91
  92 has create =>
  93     ( is => 'ro',
  94       isa => 'Bool',
  95     );
  96
  97 has publisher =>
  98     ( is => 'ro',
  99       isa => 'CXGN::Publish',
 100       required => 1,
 101       default => sub {
 102           my $p = CXGN::Publish->new;
 103           $p->make_dirs(1);
 104           return $p;
 105       },
 106       handles => ['publish'],
 107     );
 108
 109 =head1 METHODS
 110
 111 =head2 new
 112
 113   Usage: my $repos =
 114             CXGN::FileRepository
 115               ->new( '/data/prod/public/foo' )
 116   Desc : open an existing file repository, dies if does
 117          not exist and create => 1 not passed
 118   Args : basedir => string dirname or Path::Class::Dir,
 119          create => 1, #< will create dir and parent dirs if not
 120                       #  present
 121          # OR single argument
 122          string dirname or Path::Class::Dir, interpreted
 123          as the basedir you want
 124   Ret  : FileRepository object
 125
 126 =cut
 127
 128 sub BUILDARGS {
 129     my $class = shift;
 130
 131     my %args = @_ == 1 ? (basedir => @_) : @_;
 132
 133     # check required basedir
 134     defined $args{basedir}
 135         or croak "no 'basedir' argument passed, and it is required";
 136
 137     # coerce basedir to Path::Class::Dir
 138     unless( ref $args{basedir} && $args{basedir}->can('stringify') ) {
 139         $args{basedir} = Path::Class::Dir->new( "$args{basedir}" );
 140     }
 141
 142     # create our basedir if create was passed
 143     my $d = $args{basedir}->stringify;
 144     unless( -d $d ) {
 145         $args{create}
 146             or croak "basedir '$d' does not exist, maybe you want to specify create => 1 to create it?\n";
 147         mkpath( $d )
 148           or croak "$! creating '$d'";
 149         -d $d or die 'sanity check failed';
 150     }
 151
 152     return $class->SUPER::BUILDARGS( %args );
 153 }
 154
 155
 156 =head2 publish
 157
 158   Usage: $repos->publish( [op], [op] )
 159   Desc : do a publish operation using this repo's publisher object
 160   Args : publish operation arrayrefs,
 161          same as L<CXGN::Publish> publish()
 162   Ret  : nothing meaningful
 163   Side Effects: does publish operations
 164
 165 =cut
 166
 167 # this method created by 'handles' delegation on publisher attribute
 168
 169 =head2 search_files
 170
 171   Usage: my @files = $repo->search_files( %args );
 172   Desc : search for files present in their current versions in the
 173          repository
 174   Args : search criteria as a hash-list
 175   Ret : list of matching files as Path::Class::File objects (possibly
 176         empty), in no particular order
 177   Side Effects:
 178   Example:
 179
 180      # get a list of files in the current version of the repo that are
 181      # CloneSequence files, of type fasta, belonging to the given
 182      # clone object
 183      my @files = $repo->search_files( class => 'CloneSequence',
 184                                       type  => 'fasta',
 185                                       clone => $clone,
 186                                     );
 187
 188
 189 =cut
 190
 191 sub search_files {
 192     my $self = shift;
 193
 194     # return the current_file, for those VFs that have them
 195     map $_->current_file || (), $self->search_vfs( @_ );
 196 }
 197
 198 =head2 search_vfs
 199
 200   Same as search_files, but returns CXGN::FileRepository::VersionedFile
 201   objects for all matching files that have already been published.
 202
 203 =cut
 204
 205 sub search_vfs {
 206     my ($self, %conditions) = @_;
 207
 208     my $fileclass_condition = delete $conditions{class};
 209     my @classes =  $fileclass_condition
 210         ? ($self->_find_class_or_die($fileclass_condition))
 211         : $self->file_classes;
 212
 213     return map { $_->search_vfs( %conditions ) }
 214            @classes
 215 }
 216
 217
 218 =head2 get_file
 219
 220   Same as search_files, but returns just one Path::Class::File, or
 221   nothing if no such file currently exists.  Dies if the search
 222   conditions are not specific enough to specify exactly one file.
 223
 224 =cut
 225
 226 sub get_file {
 227     my $self = shift;
 228
 229     my $r = $self->get_vf(@_);
 230
 231     return $r->current_file if $r;
 232
 233     return;
 234 }
 235
 236 =head2 get_vf
 237
 238   Same as search_files, but returns just one VersionedFile, regardless
 239   of whether a file currently exists for it.
 240
 241 =cut
 242
 243 sub get_vf {
 244     my $self = shift;
 245
 246     my %conditions = @_;
 247
 248     my $class = delete $conditions{class}
 249         or croak "must specify a class in call to get_vf";
 250
 251     my $fileclass_obj = $self->_find_class_or_die($class);
 252
 253     return $fileclass_obj->get_vf( %conditions );
 254 }
 255
 256
 257 sub _find_class_or_die {
 258     my ( $self, $classname ) = @_;
 259
 260     my $class = ref $self;
 261     my @search_classes =
 262         ( $classname,
 263           "${class}::FileClass::$classname",
 264         );
 265
 266     foreach my $class ( @search_classes ) {
 267         unless( Class::MOP::is_class_loaded($class) ) {
 268             #it is not loaded, try to load it
 269             eval { Class::MOP::load_class( $class ) };
 270             next if $@;
 271         }
 272
 273         return $class->new( repository => $self );
 274     }
 275
 276     confess "could not find file class matching '$classname', searched for ".join(',',@search_classes);
 277 }
 278
 279
 280 =head2 file_classes
 281
 282   Usage: my @classes = $repos->file_classes
 283   Desc : list all the file classes present in the repos
 284   Args : none
 285   Ret  : list of file class objects for this repos
 286
 287 =cut
 288
 289 # makes a method _fileslots() that instantiates a list of all FileSlot
 290 # objects in this namespace, except those which end with Base
 291 use Module::Pluggable::Object ();
 292 use Devel::InnerPackage ();
 293
 294 sub file_classes {
 295     my $self = shift;
 296     my $class = ref $self;
 297
 298     my $exclude_pat    = qr/Base$/; #< exclude all packages ending in Base
 299     my $fileclass_base = $class."::FileClass";
 300
 301     my $finder =
 302         Module::Pluggable::Object
 303               ->new( exclude     => $exclude_pat,
 304                      search_path => $fileclass_base,
 305                      require => 1,
 306                    );
 307
 308     $finder->plugins( );
 309
 310     my @fileclasses =
 311         grep {$_ !~ $exclude_pat}
 312         Devel::InnerPackage::list_packages($fileclass_base);
 313
 314     #warn "$class got file classes: ".join ', ', @fileclasses;
 315
 316     return sort map {$_->new( repository => $self ) } @fileclasses;
 317 }
 318
 319
 320 =head1 MAINTAINER
 321
 322 Robert Buels, E<lt>rmb32@cornell.eduE<gt>
 323
 324 =head1 AUTHOR
 325
 326 Robert Buels, E<lt>rmb32@cornell.eduE<gt>
 327
 328 =head1 COPYRIGHT & LICENSE
 329
 330 Copyright 2009 Boyce Thompson Institute for Plant Research
 331
 332 This program is free software; you can redistribute it and/or modify
 333 it under the same terms as Perl itself.
 334
 335 =cut
 336
 337 ####
 338 __PACKAGE__->meta->make_immutable;
 339 no Moose;
 340 1;
 341 ###