File Coverage

blib/lib/Catalyst/Controller/SimpleCAS/Store/DBIC.pm
Criterion Covered Total %
statement 39 69 56.5
branch 0 12 0.0
condition n/a
subroutine 13 20 65.0
pod 7 7 100.0
total 59 108 54.6


line stmt bran cond sub pod time code
1             package Catalyst::Controller::SimpleCAS::Store::DBIC;
2              
3 1     1   903 use warnings;
  1         1  
  1         27  
4 1     1   4 use Moose;
  1         1  
  1         5  
5              
6             with qw(
7             Catalyst::Controller::SimpleCAS::Store
8             );
9              
10 1     1   4221 use File::MimeInfo::Magic;
  1         1  
  1         35  
11 1     1   4 use Image::Size;
  1         0  
  1         27  
12 1     1   4 use Digest::SHA1;
  1         0  
  1         20  
13 1     1   3 use IO::File;
  1         1  
  1         101  
14 1     1   511 use Data::Dumper;
  1         3836  
  1         45  
15 1     1   5 use MIME::Base64;
  1         1  
  1         35  
16 1     1   3 use Try::Tiny;
  1         2  
  1         34  
17 1     1   5 use Path::Class qw( file dir );
  1         1  
  1         32  
18              
19 1     1   3 use IO::All;
  1         2  
  1         4  
20              
21 1     1   47 use bytes;
  1         1  
  1         3  
22              
23             has 'model' => ( is => 'ro', isa => 'Str', required => 1 );
24             has 'tempdir' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub {
25             my $self = shift;
26             return dir( Catalyst::Utils::class2tempdir($self->resultset->result_class), 'simplecas' )->stringify;
27             });
28              
29             sub resultset {
30 0     0 1   my ( $self ) = @_;
31 0           $self->simplecas->_app->model($self->model);
32             }
33              
34             sub get_result_by_checksum {
35 0     0 1   my ( $self, $checksum ) = @_;
36 0           return $self->resultset->find({
37             checksum => $checksum,
38             });
39             }
40              
41             sub add_content {
42 0     0 1   my ( $self, $data ) = @_;
43 0           my $checksum = $self->calculate_checksum($data);
44 0 0         return $checksum if ($self->content_exists($checksum));
45 0           my $size = length($data);
46 0           my $result = $self->resultset->create({
47             content => $data,
48             checksum => $self->calculate_checksum($data),
49             size => $size,
50             });
51 0 0         die "Unable to store data of $size bytes in Storage" unless $result;
52 0           return $result->checksum;
53             }
54              
55             sub checksum_to_path {
56 0     0 1   my ( $self, $checksum ) = @_;
57 0           my @parts = unpack("(A5)*", $checksum);
58 0           my $filename = pop @parts;
59 0           my $dir = join("/",$self->tempdir,@parts);
60 0           my $fullname = join("/",$dir,$filename);
61 0 0         return $fullname if io($fullname)->exists;
62 0           io($dir)->mkpath;
63 0           my $entry = $self->get_result_by_checksum($checksum);
64 0           io($fullname)->print($entry->content);
65 0           return $fullname;
66             }
67              
68             sub fetch_content {
69 0     0 1   my ( $self, $checksum ) = @_;
70 0           my $entry = $self->get_result_by_checksum($checksum);
71 0 0         return "" unless $entry;
72 0           return $entry->content;
73             }
74              
75             sub content_exists {
76 0     0 1   my ( $self, $checksum ) = @_;
77 0 0         return $self->get_result_by_checksum($checksum) ? 1 : 0;
78             }
79              
80             around content_mimetype => sub {
81             my $orig = shift;
82             my $self = shift;
83             my $checksum = shift;
84             my $result = $self->get_result_by_checksum($checksum);
85             return undef unless $result;
86             return $result->mimetype if defined $result->mimetype;
87             my $mimetype = $self->$orig($checksum) || '';
88             $result->mimetype($mimetype);
89             $result->update;
90             return $mimetype;
91             };
92              
93             around image_size => sub {
94             my $orig = shift;
95             my $self = shift;
96             my $checksum = shift;
97             my $result = $self->get_result_by_checksum($checksum);
98             return unless $result;
99             if (defined $result->image_width) {
100             return undef unless $result->image_width;
101             return ( $result->image_width, $result->image_height );
102             }
103             my ( $width, $height ) = $self->$orig($checksum);
104             $width = 0 unless $width;
105             $height = 0 unless $height;
106             $result->image_width($width);
107             $result->image_height($height);
108             $result->update;
109             return undef unless $width;
110             return ( $width, $height );
111             };
112              
113             sub content_size {
114 0     0 1   my ( $self, $checksum ) = @_;
115 0           my $result = $self->get_result_by_checksum($checksum);
116 0 0         return $result ? $result->size : 0;
117             }
118              
119             #### --------------------- ####
120              
121 1     1   489 no Moose;
  1         1  
  1         4  
122             #__PACKAGE__->meta->make_immutable;
123             1;
124              
125             __END__
126              
127             =head1 NAME
128              
129             Catalyst::Controller::SimpleCAS::Store::DBIC - DBIx::Class Store for SimpleCAS
130              
131             =head1 SYNOPSIS
132              
133              
134              
135             =head1 DESCRIPTION
136              
137              
138              
139             =head1 ATTRIBUTES
140              
141             =head2 resultset
142              
143             The actual L<DBIx::Class> ResultSet that should be used for all storage
144             activity.
145              
146             =head1 METHODS
147              
148             =head2 add_content
149              
150             =head2 add_content_base64
151              
152             =head2 add_content_file
153              
154             =head2 add_content_file_mv
155              
156             =head2 calculate_checksum
157              
158             =head2 checksum_to_path
159              
160             =head2 content_exists
161              
162             =head2 content_mimetype
163              
164             =head2 content_size
165              
166             =head2 fetch_content
167              
168             =head2 fetch_content_fh
169              
170             =head2 file_checksum
171              
172             =head2 image_size
173              
174             =head2 init_store_dir
175              
176             =head2 split_checksum
177              
178             =head2 get_result_by_checksum
179              
180             =head1 SEE ALSO
181              
182             =over
183              
184             =item *
185              
186             L<Catalyst::Controller::SimpleCAS>
187              
188             =back
189              
190             =head1 AUTHOR
191              
192             Torsten Raudssus <torsten@raudss.us>
193              
194             =head1 COPYRIGHT AND LICENSE
195              
196             This software is copyright (c) 2014 by IntelliTree Solutions llc.
197              
198             This is free software; you can redistribute it and/or modify it under
199             the same terms as the Perl 5 programming language system itself.
200              
201             =cut