File Coverage

blib/lib/MojoMojo/Schema/Result/Photo.pm

Criterion	Covered	Total	%
statement	18	68	26.4
branch	0	12	0.0
condition			n/a
subroutine	6	14	42.8
pod	8	8	100.0
total	32	102	31.3

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" );

=head1 NAME

MojoMojo::Schema::Result::Photo - store photos

=head1 METHODS

=cut

=head2 extract_exif

Extracts EXIF information from a given Attachment and
populates the Photo object.

=cut

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'} ) );
}

=head2 exif2datetime datetime

Creates a L<DateTime> object from an EXIF timestamp.

=cut

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;
}

=head2 prev_by_tag <tag>

Return previous image when browsing by the given tag.

=cut

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;
}

=head2 next_by_tag <tag>

Return the next image when browsing by the given tag.

=cut

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;
}

=head2 others_tags <user>

Tags other users have given to this photo.

=cut

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;
}

=head2 user_tags <user>

Tags this user has given to this photo.

=cut

sub user_tags {
    my ( $self, $user ) = @_;
    my (@tags) = $self->related_resultset('tags')->search(
        {
            photo  => $self->id,
            person => $user,
        },
        { 'order_by' => ['me.tag'] }
    );
    return @tags;
}

=head2 make_inline

Create a resized version of a photo suitable for inline usage.

=cut

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;
}

=head2 make_thumb

Create a thumbnail version of a photo, for gallery views and linking to pages.

=cut

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;
}

=head1 AUTHOR

Marcus Ramberg <[e-mail]>

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;