Arh/Action/UploadPicture.pm

use strict;
use warnings;

=head1 NAME

Arh::Action::UploadPicture

=cut

package Arh::Action::UploadPicture;
use base qw/Arh::Action::CreatePicture/;

use Data::Dump qw/dump/;
use Image::Magick::Thumbnail::Simple;
use File::Slurp;
use Encode qw/decode/;

=head2 take_action

=cut

my $buf_size = 8192;
my $config = Jifty->config->app('pictures') or die "no pictures in config.yml";
my $path = $config->{path} or die "no path";

sub take_action {
    my $self = shift;

    if ( my $fh = $self->argument_value('content') ) {

                my $filename = scalar( $fh );
                $filename =~ s/^.*([\/\\])([^\1]+)$/$2/;

                if ( $filename !~ m/^(.+)\.(jpg|jpeg|png|gif|tif|tiff)$/i ) {
                        $self->result->error("unknown file type $filename");
                        return;
                }
                my ( $file, $type ) = ( $1, $2 );

                foreach my $dir ( '', 'thumb', 'orig' ) {
                        my $p = "$path/$dir";
                        if ( ! -e $p ) {
                                mkdir $p or die "can't create $p:$!";
                        }
                }

                # FIXME add check of maximum upload size

                my $path_orig = "$path/orig/$filename";

                open(my $fh_out, '>', $path_orig ) or die "can't open $path_orig: $!";
                my $buff = ' ' x $buf_size;
                while( read($fh, $buff, $buf_size) ) {
                        print $fh_out $buff or die "can't write to $path_orig: $!";
                }
                close($fh_out) or die "can't close $path_orig: $!";

                warn "## $self take_action resize $filename [", -s $path_orig, " bytes]\n";

                my $thumb_name = $file . '.jpg';
                my $thumb_path = "$path/thumb/$thumb_name";

                my $t = Image::Magick::Thumbnail::Simple->new;
                $t->thumbnail(
                        input  => "$path/orig/$filename",
                        output => $thumb_path,
                        size   => $config->{thumbnail} || 128,
                );

                my $content = read_file($thumb_path) or die "can't read $thumb_path: $!";

                warn "## resized to $thumb_name ", -s $thumb_path, " == ", length($content), " bytes...";

                $self->argument_value( 'filename' => $filename  );      # needed for report_success
                $self->argument_value( 'content' => $content );
                $self->argument_value( 'thumbnail' => $thumb_name );
                $self->argument_value( 'width' => $t->width );
                $self->argument_value( 'height' => $t->height );

                my $id = $self->SUPER::take_action( @_ );

                # update database with correct filename (why do I need this?)
                $self->record->set_filename( $filename );

                return $id;

        } else {
                $self->result->error("No file uploaded!");
        }

}

=head2 report_success

=cut

sub report_success {
        my $self = shift;
        $self->result->message( 'Uploaded ' . $self->argument_value('filename') . ' [' . length( $self->argument_value('content') ) . ' bytes]' );
        warn "## report_success ", dump( $self->result );
}

1;

1	dpavlin	44	use strict;
2			use warnings;
3
4			=head1 NAME
5
6			Arh::Action::UploadPicture
7
8			=cut
9
10			package Arh::Action::UploadPicture;
11			use base qw/Arh::Action::CreatePicture/;
12
13			use Data::Dump qw/dump/;
14	dpavlin	61	use Image::Magick::Thumbnail::Simple;
15			use File::Slurp;
16			use Encode qw/decode/;
17	dpavlin	44
18			=head2 take_action
19
20			=cut
21
22	dpavlin	52	my $buf_size = 8192;
23	dpavlin	61	my $config = Jifty->config->app('pictures') or die "no pictures in config.yml";
24			my $path = $config->{path} or die "no path";
25	dpavlin	52
26	dpavlin	44	sub take_action {
27			my $self = shift;
28
29			if ( my $fh = $self->argument_value('content') ) {
30
31			my $filename = scalar( $fh );
32			$filename =~ s/^.*([\/\\])([^\1]+)$/$2/;
33
34	dpavlin	61	if ( $filename !~ m/^(.+)\.(jpg\|jpeg\|png\|gif\|tif\|tiff)$/i ) {
35	dpavlin	48	$self->result->error("unknown file type $filename");
36			return;
37			}
38	dpavlin	61	my ( $file, $type ) = ( $1, $2 );
39	dpavlin	48
40	dpavlin	61	foreach my $dir ( '', 'thumb', 'orig' ) {
41			my $p = "$path/$dir";
42			if ( ! -e $p ) {
43			mkdir $p or die "can't create $p:$!";
44			}
45	dpavlin	52	}
46	dpavlin	44
47	dpavlin	52	# FIXME add check of maximum upload size
48
49	dpavlin	61	my $path_orig = "$path/orig/$filename";
50
51			open(my $fh_out, '>', $path_orig ) or die "can't open $path_orig: $!";
52	dpavlin	52	my $buff = ' ' x $buf_size;
53			while( read($fh, $buff, $buf_size) ) {
54	dpavlin	61	print $fh_out $buff or die "can't write to $path_orig: $!";
55	dpavlin	52	}
56	dpavlin	61	close($fh_out) or die "can't close $path_orig: $!";
57	dpavlin	52
58	dpavlin	61	warn "## $self take_action resize $filename [", -s $path_orig, " bytes]\n";
59	dpavlin	52
60	dpavlin	61	my $thumb_name = $file . '.jpg';
61			my $thumb_path = "$path/thumb/$thumb_name";
62	dpavlin	52
63	dpavlin	61	my $t = Image::Magick::Thumbnail::Simple->new;
64			$t->thumbnail(
65			input => "$path/orig/$filename",
66			output => $thumb_path,
67			size => $config->{thumbnail} \|\| 128,
68			);
69	dpavlin	52
70	dpavlin	61	my $content = read_file($thumb_path) or die "can't read $thumb_path: $!";
71	dpavlin	53
72	dpavlin	61	warn "## resized to $thumb_name ", -s $thumb_path, " == ", length($content), " bytes...";
73	dpavlin	52
74	dpavlin	61	$self->argument_value( 'filename' => $filename ); # needed for report_success
75	dpavlin	44	$self->argument_value( 'content' => $content );
76	dpavlin	61	$self->argument_value( 'thumbnail' => $thumb_name );
77			$self->argument_value( 'width' => $t->width );
78			$self->argument_value( 'height' => $t->height );
79	dpavlin	44
80	dpavlin	48	my $id = $self->SUPER::take_action( @_ );
81
82			# update database with correct filename (why do I need this?)
83			$self->record->set_filename( $filename );
84
85			return $id;
86
87			} else {
88			$self->result->error("No file uploaded!");
89	dpavlin	44	}
90
91			}
92
93			=head2 report_success
94
95			=cut
96
97			sub report_success {
98			my $self = shift;
99	dpavlin	55	$self->result->message( 'Uploaded ' . $self->argument_value('filename') . ' [' . length( $self->argument_value('content') ) . ' bytes]' );
100	dpavlin	44	warn "## report_success ", dump( $self->result );
101			}
102
103			1;
104