| MojoMojo documentation | Contained in the MojoMojo distribution. |
MojoMojo::Schema::Result::Photo - store photos
Extracts EXIF information from a given Attachment and populates the Photo object.
Creates a DateTime object from an EXIF timestamp.
Return previous image when browsing by the given tag.
Return the next image when browsing by the given tag.
Create a resized version of a photo suitable for inline usage.
Create a thumbnail version of a photo, for gallery views and linking to pages.
Marcus Ramberg <mramberg@cpan.org>
This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself.
| MojoMojo documentation | Contained in the MojoMojo distribution. |
package MojoMojo::Schema::Result::Photo; use strict; use warnings; use parent qw/MojoMojo::Schema::Base::Result/; use DateTime; use Image::ExifTool; use Image::Math::Constrain; my $exif = Image::ExifTool->new(); __PACKAGE__->load_components( qw/DateTime::Epoch TimeStamp Ordered Core/); __PACKAGE__->position_column("position"); __PACKAGE__->table("photo"); __PACKAGE__->add_columns( "id", { data_type => "INTEGER", is_nullable => 0, size => undef, is_auto_increment => 1 }, "position", { data_type => "INTEGER", is_nullable => 0, size => undef }, "title", { data_type => "TEXT", is_nullable => 0, size => undef }, "description", { data_type => "TEXT", is_nullable => 1, size => undef }, "camera", { data_type => "TEXT", is_nullable => 1, size => undef }, "taken", { data_type => "INTEGER", is_nullable => 1, size => undef, default_value => undef, inflate_datetime => 'epoch', datetime_undef_if_invalid => 1, }, "iso", { data_type => "INTEGER", is_nullable => 1, size => undef }, "lens", { data_type => "TEXT", is_nullable => 1, size => undef }, "aperture", { data_type => "TEXT", is_nullable => 1, size => undef }, "flash", { data_type => "TEXT", is_nullable => 1, size => undef }, "height", { data_type => "INT", is_nullable => 1, size => undef }, "width", { data_type => "INT", is_nullable => 1, size => undef }, ); __PACKAGE__->set_primary_key("id"); __PACKAGE__->has_many( "tags", "MojoMojo::Schema::Result::Tag", { "foreign.photo" => "self.id" } ); __PACKAGE__->has_many( "comments", "MojoMojo::Schema::Result::Comment", { "foreign.picture" => "self.id" } ); __PACKAGE__->has_one( "attachment", "MojoMojo::Schema::Result::Attachment" );
sub extract_exif { my ( $self, $att ) = @_; my $info = $exif->ImageInfo( $att->filename ); $self->camera( $info->{'Model'} ); $self->lens( $info->{'FocalLength'} ); $self->iso( $info->{'ISO'} ); $self->aperture( $info->{'Aperture'} ); $self->flash( $info->{'Flash'} ); $self->description( $info->{'UserComment'} ); $self->taken( $self->exif2datetime( $info->{'DateTimeOriginal'} ) ); }
sub exif2datetime { my ( $self, $datetime ) = @_; return undef unless $datetime; my ( $date, $time ) = split( ' ', $datetime ); my ( $y, $M, $d ) = split ':', $date; my ( $h, $m, $s ) = split ':', $time; my $dto; eval { $dto = DateTime->new( year => $y, month => $M, day => $d, hour => $h, minute => $m, second => $s ); }; return $dto; }
sub prev_by_tag { my ( $self, $tag ) = @_; return $self->result_source->resultset->search( { 'me.id' => { '>', $self->id }, 'tags.tag' => $tag }, { order_by => 'taken', join => [qw/tags/],rows=>1 } )->next; }
sub next_by_tag { my ( $self, $tag ) = @_; return $self->result_source->resultset->search( { 'me.id' => { '<', $self->id }, 'tags.tag' => $tag }, { order_by => 'taken DESC', join => [qw/tags/], rows => 1 } )->next; }
sub others_tags { my ( $self, $user ) = @_; my (@tags) = $self->related_resultset('tags')->search( { photo => $self->id, person => { '!=', $user }, }, { select => [ 'me.tag', 'count(me.tag) AS refcount' ], as => [ 'tag', 'refcount' ], 'group_by' => ['me.tag'], 'order_by' => 'refcount', } ); return @tags; }
sub user_tags { my ( $self, $user ) = @_; my (@tags) = $self->related_resultset('tags')->search( { photo => $self->id, person => $user, }, { 'order_by' => ['me.tag'] } ); return @tags; }
sub make_inline { my ($self) = shift; my $img = Imager->new(); my $att = $self->attachment; $img->open( file => $att->filename ) or die $img->errstr; my $constrain = Image::Math::Constrain->new( 800, 600 ); my $image = $img->scale( constrain => $constrain ); $image->write( file => $att->filename . '.inline', type => 'jpeg' ) or die $img->errstr; }
sub make_thumb { my ($self) = shift; my $img = Imager->new(); my $att = $self->attachment; $img->open( file => $att->filename ) or die $img->errstr; my $h = $img->getheight; my $w = $img->getwidth; my ( $image, $result ); if ( $h > $w ) { $image = $img->scale( xpixels => 80 ); $h = $image->getheight; $result = $image->crop( top => int( ( $h - 80 ) / 2 ), left => 0, width => 80, height => 80 ); } else { $image = $img->scale( ypixels => 80 ); $w = $image->getwidth; $result = $image->crop( left => int( ( $w - 80 ) / 2 ), top => 0, width => 80, height => 80 ); } $result->write( file => $att->filename . '.thumb', type => 'jpeg' ) or die $img->errstr; }
1;