File Coverage

blib/lib/MongoDBx/Tiny/GridFS.pm

Criterion	Covered	Total	%
statement	24	78	30.7
branch	0	38	0.0
condition			n/a
subroutine	8	26	30.7
pod	7	7	100.0
total	39	149	26.1

package MongoDBx::Tiny::GridFS;
use strict;
use warnings;

=head1 NAME

MongoDBx::Tiny::GridFS - wrapper class of MongoDB::GridFS

=cut

use Carp qw(confess);
use MongoDB::GridFS;
use Params::Validate;

=head1 SUBROUTINES/METHODS

=head2 new

  $gridfs = MongoDBx::Tiny::GridFS->new(
  	$database->get_gridfs,$fields_name
  );

=cut

sub new {
    my $class  = shift;
    my $gridfs = shift or confess q/no gridfs/;
    my $field  = shift or confess q/no field/;

    return bless {  _gridfs => $gridfs, _field => $field  }, $class;
}

=head2 gridfs, fields

  # get Mongodb::GridFS
  $gridfs_raw = $gridfs->gridfs;

  # get fields name
  $gridfs_field_name = $gridfs->field;

=cut

sub gridfs { shift->{_gridfs} }

sub field  { shift->{_field}  }

=head2 put

  $gridfs->put('/tmp/foo.txt', {"filename" => 'foo.txt' });
  $gridfs->put('/tmp/bar.txt','bar.txt');

  $fh = IO::File->new('/tmp/baz.txt','r');
  $gridfs->put($fh,'baz.txt');

=cut

sub put {
    my $self  = shift;
    my $proto = shift or confess q/no filepath or filehandle/;
    my $opt   = shift or confess q/no gridfs filepath or opt/;
    my $fh;

    if (ref $proto)  {
	$fh = $proto;
    } else {
	require IO::File;
	$fh = IO::File->new($proto,'r');
    }

    if (ref $opt ne 'HASH') {
	# just a gridfs path
	$opt = { $self->field => $opt };
    }

    my $no_exists_check = delete $opt->{no_exists_check};

    my %meta = Params::Validate::validate_with(
	params => $opt,
	spec   => {
	    $self->field => 1,
	}
    );

    unless ($no_exists_check) {
	# xxx
	return if $self->exists_file( $meta{$self->field} );
    }

    my $oid = $self->gridfs->insert($fh, \%meta, { safe => 1 });
    $self->get($oid);
}

=head2 get

  # MongoDBx::Tiny::GridFS::File
  $gridfs_file = $gridfs->get({ filename => 'foo.txt' });
  $foo_txt = $gridfs_file->slurp;

  $bar_txt = $gridfs->get('bar.txt')->slurp;

=cut

sub get {
    my $self = shift;
    my $proto  = shift or confess /no id or query/; # $oid,$query

    my $query = ref $proto eq 'HASH'         ? $proto
	      : ref $proto eq 'MongoDB::OID' ? { _id => $proto }
	      : { $self->field => $proto };
    my $gridfs_object = $self->gridfs->find_one($query);
    return unless $gridfs_object;
    return MongoDBx::Tiny::GridFS::File->new( $gridfs_object, $self->field );
}

=head2 remove

  $gridfs->remove({ filename => 'foo.txt' });
  $gridfs->remove('bar.txt');

=cut

sub remove {
    my $self = shift;
    my $proto  = shift or confess /no id or query/; # $oid,$query

    my $query = ref $proto eq 'HASH'         ? $proto
              : ref $proto eq 'MongoDB::OID' ? { _id => $proto }
	      : { $self->field => $proto };

    $self->gridfs->remove( $query, {safe => 1, just_one => 1} );
}

=head2 exists_file

  $gridfs->exists_file({ filename => 'foo.txt' });
  $gridfs->exists_file('bar.txt');

=cut

sub exists_file {
    my $self     = shift;
    my $field    = $self->field;

    my $val      = shift or confess qq/no $field value/;
    return $self->gridfs->find_one({ $field  => $val },{ _id => 1 });
}


=head1  MongoDBx::Tiny::GridFS::File

  wrapper class of MongoDB::GridFS::File

=cut

package MongoDBx::Tiny::GridFS::File;
use strict;
use Carp qw(confess);

=head2 new

    $gf = MongoDBx::Tiny::GridFS::File->new( $gridfs->find_one($query), $self->field );

=cut

sub new {
    my $class  = shift;
    my $g_file = shift or confess q/no GridFS::File object/;
    my $field  = shift or confess q/no MongoDBx::Tiny::GridFS::field/;
    # g_file
    # bless { _info => {}, _grid => MongoDB::GridFS } MongoDB::GridFS::File
    unless ($class->can($field)) {
	{
	    no strict 'refs';
	    *{"${class}::" . $field} = sub { shift->gf->{info}->{$field} };
	}
    }

    return bless { _gridfs_file => $g_file, _field => $field }, $class;
}


=head2 gridfs_file, gf

    # MongoDB::GridFS::File
    $gf_raw = $gf->gridfs_file;

=cut

sub gridfs_file { shift->{_gridfs_file} }

sub gf          { shift->gridfs_file    }

=head2 print

  # MongoDB::GridFS::File::print
  $gf->print($fh,$length,$offset);

=cut

sub print       { shift->gf->print(@_)  }

=head2 slurp

  # MongoDB::GridFS::File::slurp
  $all = $gf->slurp();
  $buf = $gf->slurp($length,$offset);

=cut

sub slurp       { shift->gf->slurp(@_)  }

=head2 field

  field name. default is  "filename"

=cut

=head2 _id,chunk_size,upload_date,md5

  MongoDB::GridFS::File attributes

=cut

sub field       { shift->{_field}       }

sub id          { shift->gf->{info}->{_id} }

sub chunk_size  { shift->gf->{info}->{chunkSize} }

sub upload_date { shift->gf->{info}->{uploadDate} }

sub md5         { shift->gf->{info}->{md5} }

1;
__END__

=head1 AUTHOR

Naoto ISHIKAWA, C<< <toona at seesaa.co.jp> >>

=head1 LICENSE AND COPYRIGHT

Copyright 2013 Naoto ISHIKAWA.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut