/[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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 55 by dpavlin, Sun Apr 6 21:07:20 2008 UTC revision 61 by dpavlin, Mon Apr 7 14:33:31 2008 UTC
# Line 11  package Arh::Action::UploadPicture; Line 11  package Arh::Action::UploadPicture;
11  use base qw/Arh::Action::CreatePicture/;  use base qw/Arh::Action::CreatePicture/;
12    
13  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
14  use Imager;  use Image::Magick::Thumbnail::Simple;
15    use File::Slurp;
16    use Encode qw/decode/;
17    
18  =head2 take_action  =head2 take_action
19    
20  =cut  =cut
21    
22  my $buf_size = 8192;  my $buf_size = 8192;
23  my $conf = Jifty->config->app('pictures') or die "no pictures";  my $config = Jifty->config->app('pictures') or die "no pictures in config.yml";
24  my $path = $conf->{original_path} or die "no original_path";  my $path = $config->{path} or die "no path";
 my $scale = $conf->{scale} or die "no scale";  
25    
26  sub take_action {  sub take_action {
27      my $self = shift;      my $self = shift;
# Line 30  sub take_action { Line 31  sub take_action {
31                  my $filename = scalar( $fh );                  my $filename = scalar( $fh );
32                  $filename =~ s/^.*([\/\\])([^\1]+)$/$2/;                  $filename =~ s/^.*([\/\\])([^\1]+)$/$2/;
33    
34                  if ( $filename !~ m/\.(jpg|jpeg|png|gif|tif|tiff)$/i ) {                  if ( $filename !~ m/^(.+)\.(jpg|jpeg|png|gif|tif|tiff)$/i ) {
35                          $self->result->error("unknown file type $filename");                          $self->result->error("unknown file type $filename");
36                          return;                          return;
37                  }                  }
38                    my ( $file, $type ) = ( $1, $2 );
39    
40                  if ( ! -e $path ) {                  foreach my $dir ( '', 'thumb', 'orig' ) {
41                          mkdir $path or die "can't create $path: $!";                          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                  # FIXME add check of maximum upload size
48    
49                  open(my $fh_out, '>', "$path/$filename" ) or die "can't open $path/$filename: $!";                  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;                  my $buff = ' ' x $buf_size;
53                  while( read($fh, $buff, $buf_size) ) {                  while( read($fh, $buff, $buf_size) ) {
54                          print $fh_out $buff or die "can't write to $filename: $!";                          print $fh_out $buff or die "can't write to $path_orig: $!";
55                  }                  }
56                  close($fh_out) or die "can't close $filename: $!";                  close($fh_out) or die "can't close $path_orig: $!";
   
                 warn "## $self take_action resize $filename [", -s "$path/$filename", " bytes]\n";  
57    
58                  my $image = Imager->new;                  warn "## $self take_action resize $filename [", -s $path_orig, " bytes]\n";
                 $image->read( file => "$path/$filename" ) or die $image->errstr;  
59    
60                  my $content;                  my $thumb_name = $file . '.jpg';
61                    my $thumb_path = "$path/thumb/$thumb_name";
62    
63                  my $scaled_image = $image->scale( %$scale ) or die $image->errstr;                  my $t = Image::Magick::Thumbnail::Simple->new;
64                  undef $image;                  $t->thumbnail(
65                            input  => "$path/orig/$filename",
66                            output => $thumb_path,
67                            size   => $config->{thumbnail} || 128,
68                    );
69    
70                  $scaled_image->write(                  my $content = read_file($thumb_path) or die "can't read $thumb_path: $!";
                         data => \$content,  
                         type => 'jpeg',  
 #                       jpegquality => 95,  
                 ) or die $scaled_image->errstr;  
                 undef $scaled_image;  
71    
72                  warn "## resized to ",length($content), " bytes...";                  warn "## resized to $thumb_name ", -s $thumb_path, " == ", length($content), " bytes...";
73    
74                  $self->argument_value( 'filename' => $filename );       # needed for report_success                  $self->argument_value( 'filename' => $filename  );      # needed for report_success
75                  $self->argument_value( 'content' => $content );                  $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( @_ );                  my $id = $self->SUPER::take_action( @_ );
81    

Legend:
Removed from v.55  
changed lines
  Added in v.61

  ViewVC Help
Powered by ViewVC 1.1.26