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

$path = Jifty::Util->absolute_path( $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	74	$path = Jifty::Util->absolute_path( $path );
27
28	dpavlin	44	sub take_action {
29			my $self = shift;
30
31			if ( my $fh = $self->argument_value('content') ) {
32
33			my $filename = scalar( $fh );
34			$filename =~ s/^.*([\/\\])([^\1]+)$/$2/;
35
36	dpavlin	61	if ( $filename !~ m/^(.+)\.(jpg\|jpeg\|png\|gif\|tif\|tiff)$/i ) {
37	dpavlin	48	$self->result->error("unknown file type $filename");
38			return;
39			}
40	dpavlin	61	my ( $file, $type ) = ( $1, $2 );
41	dpavlin	48
42	dpavlin	61	foreach my $dir ( '', 'thumb', 'orig' ) {
43			my $p = "$path/$dir";
44			if ( ! -e $p ) {
45			mkdir $p or die "can't create $p:$!";
46			}
47	dpavlin	52	}
48	dpavlin	44
49	dpavlin	52	# FIXME add check of maximum upload size
50
51	dpavlin	61	my $path_orig = "$path/orig/$filename";
52
53			open(my $fh_out, '>', $path_orig ) or die "can't open $path_orig: $!";
54	dpavlin	52	my $buff = ' ' x $buf_size;
55			while( read($fh, $buff, $buf_size) ) {
56	dpavlin	61	print $fh_out $buff or die "can't write to $path_orig: $!";
57	dpavlin	52	}
58	dpavlin	61	close($fh_out) or die "can't close $path_orig: $!";
59	dpavlin	52
60	dpavlin	61	warn "## $self take_action resize $filename [", -s $path_orig, " bytes]\n";
61	dpavlin	52
62	dpavlin	61	my $thumb_name = $file . '.jpg';
63			my $thumb_path = "$path/thumb/$thumb_name";
64	dpavlin	52
65	dpavlin	61	my $t = Image::Magick::Thumbnail::Simple->new;
66			$t->thumbnail(
67			input => "$path/orig/$filename",
68			output => $thumb_path,
69			size => $config->{thumbnail} \|\| 128,
70			);
71	dpavlin	52
72	dpavlin	61	my $content = read_file($thumb_path) or die "can't read $thumb_path: $!";
73	dpavlin	53
74	dpavlin	61	warn "## resized to $thumb_name ", -s $thumb_path, " == ", length($content), " bytes...";
75	dpavlin	52
76	dpavlin	61	$self->argument_value( 'filename' => $filename ); # needed for report_success
77	dpavlin	44	$self->argument_value( 'content' => $content );
78	dpavlin	61	$self->argument_value( 'thumbnail' => $thumb_name );
79			$self->argument_value( 'width' => $t->width );
80			$self->argument_value( 'height' => $t->height );
81	dpavlin	44
82	dpavlin	48	my $id = $self->SUPER::take_action( @_ );
83
84			# update database with correct filename (why do I need this?)
85			$self->record->set_filename( $filename );
86
87			return $id;
88
89			} else {
90			$self->result->error("No file uploaded!");
91	dpavlin	44	}
92
93			}
94
95			=head2 report_success
96
97			=cut
98
99			sub report_success {
100			my $self = shift;
101	dpavlin	55	$self->result->message( 'Uploaded ' . $self->argument_value('filename') . ' [' . length( $self->argument_value('content') ) . ' bytes]' );
102	dpavlin	44	warn "## report_success ", dump( $self->result );
103			}
104
105			1;
106