/[Arh]/lib/Arh/Action/UploadPicture.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /lib/Arh/Action/UploadPicture.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 52 - (hide annotations)
Sun Apr 6 19:54:12 2008 UTC (16 years ago) by dpavlin
File size: 2213 byte(s)
create thumbnail of uploaded image
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 52 use Imager;
15 dpavlin 44
16     =head2 take_action
17    
18     =cut
19    
20 dpavlin 52 my $buf_size = 8192;
21     my $conf = Jifty->config->app('pictures') or die "no pictures";
22     my $path = $conf->{original_path} or die "no original_path";
23     my $scale = $conf->{scale} or die "no scale";
24    
25 dpavlin 44 sub take_action {
26     my $self = shift;
27    
28     if ( my $fh = $self->argument_value('content') ) {
29    
30     my $filename = scalar( $fh );
31     $filename =~ s/^.*([\/\\])([^\1]+)$/$2/;
32    
33 dpavlin 48 if ( $filename !~ m/\.(jpg|jpeg|png|gif|tif|tiff)$/i ) {
34     $self->result->error("unknown file type $filename");
35     return;
36     }
37    
38 dpavlin 52 if ( ! -e $path ) {
39     mkdir $path or die "can't create $path: $!";
40     }
41 dpavlin 44
42 dpavlin 52 # FIXME add check of maximum upload size
43    
44     open(my $fh_out, '>', "$path/$filename" ) or die "can't open $path/$filename: $!";
45     my $buff = ' ' x $buf_size;
46     while( read($fh, $buff, $buf_size) ) {
47     print $fh_out $buff or die "can't write to $filename: $!";
48     }
49     close($fh_out) or die "can't close $filename: $!";
50    
51     warn "## $self take_action resize $filename [", -s "$path/$filename", " bytes]\n";
52    
53     my $image = Imager->new;
54     $image->read( file => "$path/$filename" ) or die $image->errstr;
55    
56     my $content;
57    
58     my $scaled_image = $image->scale( %$scale ) or die $image->errstr;
59     undef $image;
60     $scaled_image->write(
61     data => \$content,
62     type => 'jpeg',
63     # jpegquality => 95,
64     ) or die $image->errstr;
65     undef $scaled_image;
66    
67     warn "## resized to ",length($content), " bytes...";
68    
69 dpavlin 48 $self->argument_value( 'filename' => $filename ); # needed for report_success
70 dpavlin 44 $self->argument_value( 'content' => $content );
71    
72 dpavlin 48 my $id = $self->SUPER::take_action( @_ );
73    
74     # update database with correct filename (why do I need this?)
75     $self->record->set_filename( $filename );
76    
77     return $id;
78    
79     } else {
80     $self->result->error("No file uploaded!");
81 dpavlin 44 }
82    
83     }
84    
85     =head2 report_success
86    
87     =cut
88    
89     sub report_success {
90     my $self = shift;
91 dpavlin 52 $self->result->message( 'Created ' . $self->argument_value('filename') . ' [' . length( $self->argument_value('content') ) . ' bytes]' );
92 dpavlin 44 warn "## report_success ", dump( $self->result );
93     }
94    
95     1;
96    

  ViewVC Help
Powered by ViewVC 1.1.26