/[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 74 - (hide annotations)
Fri Apr 11 18:42:39 2008 UTC (11 years, 6 months ago) by dpavlin
File size: 2607 byte(s)
convert path to absolute so that fastcgi backend works
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    

  ViewVC Help
Powered by ViewVC 1.1.26