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	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	use Image::Magick::Thumbnail::Simple;
15	use File::Slurp;
16	use Encode qw/decode/;
17
18	=head2 take_action
19
20	=cut
21
22	my $buf_size = 8192;
23	my $config = Jifty->config->app('pictures') or die "no pictures in config.yml";
24	my $path = $config->{path} or die "no path";
25
26	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	if ( $filename !~ m/^(.+)\.(jpg\|jpeg\|png\|gif\|tif\|tiff)$/i ) {
35	$self->result->error("unknown file type $filename");
36	return;
37	}
38	my ( $file, $type ) = ( $1, $2 );
39
40	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	}
46
47	# FIXME add check of maximum upload size
48
49	my $path_orig = "$path/orig/$filename";
50
51	open(my $fh_out, '>', $path_orig ) or die "can't open $path_orig: $!";
52	my $buff = ' ' x $buf_size;
53	while( read($fh, $buff, $buf_size) ) {
54	print $fh_out $buff or die "can't write to $path_orig: $!";
55	}
56	close($fh_out) or die "can't close $path_orig: $!";
57
58	warn "## $self take_action resize $filename [", -s $path_orig, " bytes]\n";
59
60	my $thumb_name = $file . '.jpg';
61	my $thumb_path = "$path/thumb/$thumb_name";
62
63	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
70	my $content = read_file($thumb_path) or die "can't read $thumb_path: $!";
71
72	warn "## resized to $thumb_name ", -s $thumb_path, " == ", length($content), " bytes...";
73
74	$self->argument_value( 'filename' => $filename ); # needed for report_success
75	$self->argument_value( 'content' => $content );
76	$self->argument_value( 'thumbnail' => $thumb_name );
77	$self->argument_value( 'width' => $t->width );
78	$self->argument_value( 'height' => $t->height );
79
80	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	}
90
91	}
92
93	=head2 report_success
94
95	=cut
96
97	sub report_success {
98	my $self = shift;
99	$self->result->message( 'Uploaded ' . $self->argument_value('filename') . ' [' . length( $self->argument_value('content') ) . ' bytes]' );
100	warn "## report_success ", dump( $self->result );
101	}
102
103	1;
104