File Coverage

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

Criterion	Covered	Total	%
statement	30	35	85.7
branch	3	8	37.5
condition	2	6	33.3
subroutine	12	13	92.3
pod	9	9	100.0
total	56	71	78.8

package MojoMojo::Schema::Result::Attachment;

use strict;
use warnings;

use parent qw/MojoMojo::Schema::Base::Result/;

use Number::Format qw( format_bytes );

__PACKAGE__->load_components(
    qw/DateTime::Epoch TimeStamp Core/);
__PACKAGE__->table("attachment");
__PACKAGE__->add_columns(
    "id",
    {
        data_type         => "INTEGER",
        is_nullable       => 0,
        size              => undef,
        is_auto_increment => 1
    },
    "uploaded",
    {
        data_type        => "BIGINT",
        is_nullable      => 0,
        size             => undef,
        inflate_datetime => 'epoch',
        set_on_create    => 1
    },
    "page",
    { data_type => "INTEGER", is_nullable => 0, size => undef },
    "name",
    { data_type => "VARCHAR", is_nullable => 0, size => 100 },
    "size",
    { data_type => "INTEGER", is_nullable => 1, size => undef },
    "contenttype",
    { data_type => "VARCHAR", is_nullable => 1, size => 100 },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->belongs_to(
    "page",
    "MojoMojo::Schema::Result::Page",
    { id => "page" }
);
__PACKAGE__->might_have( "photo", "MojoMojo::Schema::Result::Photo" );

=head1 NAME

MojoMojo::Schema::Result::Attachment - store attachments

=head1 METHODS

=head2 delete

Delete the inline and thumbnail versions but keep the original version
(C<$self->filename>).

=cut

sub delete {
    my ($self) = @_;

    unlink( $self->inline_filename ) if -f $self->inline_filename;
    unlink( $self->thumb_filename )  if -f $self->thumb_filename;
    $self->next::method();
}

=head2 filename

Full path to this attachment.

=cut

sub filename {
    my $self           = shift;
    my $attachment_dir = $self->result_source->schema->attachment_dir;
    die "MojoMojo::Schema->attachment_dir must be set to a writable directory (Current: $attachment_dir)\n"
        unless -d $attachment_dir && -w $attachment_dir;
    return ( $attachment_dir . '/' . $self->id );
}

=head2 inline_filename

Name of attachment file when displayed inline.

=cut

sub inline_filename { shift->filename . '.inline'; }

=head2 thumb_filename

Nmae of thumbnail of attachment.

=cut

sub thumb_filename { shift->filename . '.thumb'; }

=head2 make_photo

Insert photo id and title into photo table.

=cut

sub make_photo {
    my $self  = shift;
    my $photo = $self->result_source->related_source('photo')->resultset->new(
        {
            id    => $self->id,
            title => $self->name,
        }
    );
    $photo->description('Set your description');
    $photo->extract_exif($self) if $self->contenttype eq 'image/jpeg';
    $photo->insert();
}

=head2 is_image

Predicate to indicate is the contenttype is image or not.

=cut

sub is_image {
    my $self = shift;

    return $self->contenttype =~ m{^image/};
}

=head2 is_text

Predicate to indicate is the contenttype is text or not.

=cut

sub is_text {
    my $self = shift;

    return $self->contenttype =~ m{^text/};
}

=head2 human_size

Get a human readable size.

=cut

sub human_size {
    my $self = shift;

    return format_bytes( $self->size, precision => 1 );
}

# It would be nice to find an external module/data source for this data,
# e.g. http://en.kioskea.net/contents/courrier-electronique/mime.php3
# and/or bundle it into a separate module for CPAN.
my %mime_type_to_description = (
    'application/javascript' => 'Javascript',
    'application/json'       => 'JSON data',
    'application/pdf'        => 'PDF document',
    'application/xhtml+xml'  => 'Web page',

    'audio/mpeg'   => 'Sound file',
    'audio/ogg'    => 'Sound file',
    'audio/vorbis' => 'Sound file',

    'text/css'   => 'Cascading style sheet',
    'text/csv'   => 'Comma separated values',
    'text/html'  => 'Web page',
    'text/plain' => 'Plain text file',
    'text/xml'   => 'XML file',

    'image/gif'  => 'GIF image',
    'image/jpeg' => 'JPEG image',
    'image/png'  => 'PNG image',
);

=head2 human_type

Describe the mime type (in English?).

=cut

sub human_type {
    my $self = shift;

    return $mime_type_to_description{ $self->contenttype }
        || $self->contenttype;
}

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