source: extensions/pLoader/trunk/src/Uploader/ImageList.pm @ 3366

Last change on this file since 3366 was 3366, checked in by ronosman, 15 years ago

Bug 1010 fixed : Error with pLoader cache.

  • Property svn:eol-style set to LF
File size: 30.0 KB
Line 
1# +-----------------------------------------------------------------------+
2# | pLoader - a Perl photo uploader for Piwigo                            |
3# +-----------------------------------------------------------------------+
4# | Copyright(C) 2008      Piwigo Team                  http://piwigo.org |
5# +-----------------------------------------------------------------------+
6# | This program is free software; you can redistribute it and/or modify  |
7# | it under the terms of the GNU General Public License as published by  |
8# | the Free Software Foundation                                          |
9# |                                                                       |
10# | This program is distributed in the hope that it will be useful, but   |
11# | WITHOUT ANY WARRANTY; without even the implied warranty of            |
12# | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      |
13# | General Public License for more details.                              |
14# |                                                                       |
15# | You should have received a copy of the GNU General Public License     |
16# | along with this program; if not, write to the Free Software           |
17# | Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, |
18# | USA.                                                                  |
19# +-----------------------------------------------------------------------+
20package Uploader::ImageList;
21use strict;
22use Carp;
23use base qw/Uploader::Object/;
24use Image::ExifTool qw(:Public);
25use Image::Magick;
26use File::Spec;
27use Uploader::Image;
28use Data::Dumper;
29use Storable;
30use Digest::MD5::File qw/file_md5_hex md5_hex/;
31use Encode qw/encode decode is_utf8/;
32use Wx::Locale qw/:default/;
33
34# this class implements a collection of image files with associated data
35$|=1;
36__PACKAGE__->mk_accessors( 
37    qw/
38                thumb_size
39                preview_ratio
40                categories
41                type
42                filter
43                blur
44                quality
45                prefix
46                author
47                count
48                resize_w
49                resize_h
50                new_files
51                storable_file
52                wx_thumb_size
53                current_image
54                images
55                image_selection
56                exif_metadata
57                wx_thumb_imglist
58                wx_thumb_dir
59                preview_dir
60                site_resized_dir
61                site_thumb_dir
62                userdata_dir
63                progress_msg
64                last_error_msg
65                default_photo_name
66                default_photo_name_method
67                default_name_prefix
68                SetNewFilesViewerRefreshCallback
69                SetNewFilesProgressCallback
70                SetNewFilesDisplayEndInfoCallback
71                UploadImagesViewerCallback
72                progress_thumbnail_refresh
73                progress_msg_refresh
74                progressbar_refresh
75                progress_endinfo_refresh
76                RescaleCallback
77                ResizeCallback
78                upload_rejects
79                pwg
80                upload_high
81                remove_uploaded_from_selection
82                wx_quality
83                th_quality
84                auto_rotate
85                interlace
86                create_resized
87                use_exif_preview
88                image_sums
89                sums
90                version
91                imagelist_version
92     /
93);
94
95
96sub Init {
97    my ( $self ) = @_;
98   
99   
100}
101
102
103
104# save exif preview image if available
105# otherwise create a preview image
106sub _write_preview_image {
107    my ( $self, $imagedata ) = @_;
108
109
110    # If PreviewImage is available, we use it
111    if(defined $imagedata ) {
112        print "_write_preview_image, use exif PreviewImage\n";
113        eval {
114            open PREVIEW_FILE, ">", $self->current_image->preview_file ;
115            binmode PREVIEW_FILE;
116            print PREVIEW_FILE $$imagedata;
117            close PREVIEW_FILE;
118        };
119        $self->last_error_msg($@) if $@;
120    }
121   
122}
123
124
125sub _set_exif_tag {
126    my ( $self, $file, $tag, $newValue ) = @_; 
127
128  my $options = {};
129  # Create a new Image::ExifTool object
130  my $exifTool = new Image::ExifTool;
131
132  # Extract meta information from an image
133  $exifTool->ExtractInfo($file, $options);
134
135  # Set a new value for a tag
136  $exifTool->SetNewValue($tag, $newValue);
137
138  # Write new meta information to a file
139  $exifTool->WriteInfo($file);
140
141}
142
143sub _set_current_image_filepaths__ {
144    my ( $self ) = @_;
145
146    my ( $vol, $dir, $file ) = File::Spec->splitpath(
147        $self->current_image->file
148    );
149
150    my ( $filename, $ext ) = split /\./, $file ;
151   
152
153    $self->current_image->wx_thumb_file( 
154        File::Spec->catfile(
155            $self->wx_thumb_dir,
156            sprintf(
157                "%s.%s",
158                $filename,
159                $self->type,
160            )
161        )
162    );
163
164    $self->current_image->preview_file( 
165        File::Spec->catfile(
166            $self->preview_dir,
167            sprintf(
168                "%s.%s",
169                $filename,
170                $self->type,
171            )
172        )
173    );
174    $self->current_image->preview_file( 
175        encode('iso-8859-1', $self->current_image->preview_file)
176    );
177
178    $self->current_image->site_thumb_file( 
179        File::Spec->catfile(
180            $self->site_thumb_dir,
181            sprintf(
182                "%s.%s",
183                $filename,
184                $self->type,
185            )
186        )
187    );
188
189}
190
191sub _set_current_image_filepaths {
192    my ( $self ) = @_;
193
194    my $filename = sprintf(
195        "%s.%s",
196        $self->current_image->file_sum,
197        $self->type,
198    );
199
200
201    $self->current_image->wx_thumb_file( 
202        File::Spec->catfile(
203            $self->wx_thumb_dir,
204            $filename
205        )
206    );
207
208    $self->current_image->preview_file( 
209        File::Spec->catfile(
210            $self->preview_dir,
211            $filename
212        )
213    );
214    $self->current_image->preview_file( 
215        encode('iso-8859-1', $self->current_image->preview_file)
216    );
217
218    $self->current_image->site_thumb_file( 
219        File::Spec->catfile(
220            $self->site_thumb_dir,
221            $filename
222        )
223    );
224
225}
226
227
228sub SetCurrentImage {
229    my ( $self, $indx ) = @_;   
230
231    $self->current_image(
232        $self->GetImage($indx)
233    );
234}
235
236
237sub SetNewFiles {
238    my ( $self, $files ) = @_;
239
240    $self->new_files( $files );
241
242    # if some files have been previously selected
243    my $i = scalar @{$self->sums};
244    my $count = 0;
245    $self->count($count);
246    my $errors = 0;
247
248    map {
249        my $info = $self->_read_exif_metatdata($_);
250        my $is_new_image = $self->_add_image($_, $info, $i);   
251        $self->SetCurrentImage($i);
252        $self->_set_current_image_filepaths();
253
254        if($is_new_image){
255            my $use_wx_resize = $self->_create_gui_preview($info);
256            $self->_create_gui_thumbnail($use_wx_resize);
257
258            # ok
259            if(!$@){
260                $self->progress_msg("Thumbnail and preview created for %s");
261            }
262            else {
263                $self->progress_msg("An error has occured when processing %s\n$@");
264                # remove from list
265                splice @{$self->sums}, $i, 1;
266                $errors++;
267            }
268       
269            $self->SetNewFilesProgressCallback->();
270        }
271        $i++;
272        $count++;
273        $self->count($count);
274        $self->SetNewFilesViewerRefreshCallback->();
275    }
276    @{$files};
277    $self->SetNewFilesDisplayEndInfoCallback->(
278        sprintf(
279            "%s images added to the selection\n\n%s errors",
280            $self->count,
281            $errors
282           
283        )
284    );
285   
286    $self->Store;
287   
288}
289
290sub _read_exif_metatdata {
291    my ( $self, $file ) = @_;
292   
293    # read exif metadata
294    my $info;
295    eval {
296        $info = ImageInfo( $file );
297    };
298    $info = {} if($@);
299   
300    $info;
301}
302
303# key is file path
304sub _add_image {
305    my ( $self, $file, $info, $i ) = @_;       
306
307    my $is_new_image;
308
309    # for legacy imagelist that do not have image_sums property
310    $self->image_sums(
311        {}
312    ) if !$self->image_sums;
313
314    my $sum = file_md5_hex($file);
315
316    my $image;
317    if ( !exists $self->image_sums->{$sum} ){
318print "_add_image ", $file, "\n";
319        # append to image list
320        $image = Uploader::Image->new(
321        {
322                file              => $file,
323                file_sum          => $sum,
324                site_name         => $self->_default_photo_name($file, $info, $i),
325                site_author       => $self->author,
326                exif_metadata     => $self->_select_exif_data($info),
327                add_rank          => $i,
328                site_categories   => [],
329                site_tags         => [],
330                site_high_file    => $_,
331            }
332        );
333
334        $self->image_sums->{$sum} = $image ;
335        $is_new_image = 1;
336    } else {
337        $image = $self->image_sums->{$sum};
338    }
339
340       
341    $self->sums->[$i] = $sum ;
342
343    $is_new_image;
344}
345
346
347sub _default_photo_name {
348    my ( $self, $file, $info, $i ) = @_;
349   
350#    $file = encode('iso-8859-1', $file);
351   
352    my $name;
353    my $create_date = $info->{CreateDate};
354    my $ext;
355    my ( $vol, $path, $filename ) = File::Spec->splitpath($file);
356    ( $filename, $ext ) = split /\.\w+$/, $filename;
357   
358    my ( $yyyy, $mm, $dd, $hh, $mi, $ss ) = split /[:\s]/, $create_date ;
359 
360    my $chrono = join('', $yyyy, $mm, $dd);
361    if(gettext('Prefix') eq $self->default_photo_name){
362        $name = $self->default_name_prefix
363    }
364    elsif(gettext('File name') eq $self->default_photo_name){
365        $name = $filename
366    }
367    elsif(gettext('File path and name') eq $self->default_photo_name){
368        $name = sprintf(
369            "%s", 
370            File::Spec->catfile($path, $filename), 
371        )       
372    }   
373    elsif(gettext('Prefix + rank number') eq $self->default_photo_name){
374        $name = sprintf(
375            "%s%s", 
376            $self->default_name_prefix, 
377            1+$i,
378        )       
379    }   
380    elsif(gettext('Rank number + prefix') eq $self->default_photo_name){
381        $name = sprintf(
382            "%s%s", 
383            1+$i,
384            $self->default_name_prefix, 
385        )       
386    }   
387    elsif(gettext('Prefix + create date chrono') eq $self->default_photo_name){
388        $name = sprintf(
389            "%s%s", 
390            $self->default_name_prefix, 
391            $chrono,
392        )       
393    }   
394    elsif(gettext('Create date chrono + prefix') eq $self->default_photo_name){
395        $name = sprintf(
396            "%s%s", 
397            $chrono,
398            $self->default_name_prefix, 
399        )       
400    }   
401
402    $name;     
403}
404
405sub _create_gui_preview {
406    my ( $self, $info ) = @_;
407
408    my $create_gui_preview;
409    my $use_wx_resize;
410    if($self->use_exif_preview){       
411        # an exif preview is available. we try to use it
412        if(defined $info->{PreviewImage} ){
413            printf("use preview\n");
414            $self->_write_preview_image( $info->{PreviewImage} );
415            my $image = new Image::Magick;
416            eval {
417                $create_gui_preview = $image->ReadImage(
418                    $self->current_image->preview_file
419                );
420            };
421            unlink $self->current_image->preview_file if $create_gui_preview;
422        }
423        else {
424            $create_gui_preview = 1;
425        }
426    }
427    else {
428        $create_gui_preview = 1;
429    }
430    print "create gui preview", $create_gui_preview, "\n";
431    # have to create a preview file
432    if($create_gui_preview) {
433        eval {
434            if(!$self->CreateGUIPreview()){
435                # use method provided by the caller
436                # source, target, type, ratio
437                print "CreateGUIPreview failed, use callback\n";
438                $self->RescaleCallback->(
439                    $self->current_image->file,
440                    $self->current_image->preview_file,
441                    $self->type,
442                    $self->preview_ratio,
443                    undef,
444                    undef,
445                    $self->quality,
446                );
447                $use_wx_resize = 1;
448            }
449        };# create a preview file
450    }   
451
452    $self->RotateImage(
453        $self->current_image->preview_file,
454    ) if $self->auto_rotate;
455
456    $self->_set_exif_tag(
457        $self->current_image->preview_file,
458        'Orientation',
459        'Horizontal (normal)',
460    ) if $self->auto_rotate;
461   
462    $use_wx_resize;     
463}
464
465sub _create_gui_thumbnail {
466    my ( $self, $use_wx_resize ) = @_;
467
468    # Now, we should have a valid preview image.
469    # try to thumbnail it
470     eval {
471        printf("create gui thumbnail\n");
472        # use the preview image to create a gui display thumbnail
473        if($use_wx_resize)
474        {
475                print "CreateGUIThumbnail failed, use callback\n";
476                $self->ResizeCallback->(
477                    $self->current_image->preview_file,
478                    $self->current_image->wx_thumb_file,
479                    $self->type,
480                    $self->wx_thumb_size,
481                    $self->wx_thumb_size,
482                    $self->wx_quality,
483                );
484               
485        } else {
486            $self->CreateGUIThumbnail();               
487        }
488     };
489}
490
491sub RemoveImageSelection {
492    my ( $self ) = @_;
493   
494    return if (! scalar @{$self->sums} );
495    return if (! defined $self->image_selection );
496   
497    # higher first, to keep same indexes during remove
498    my @images = reverse @{$self->image_selection};     
499    map {
500        #my $image = $self->GetImage($_)->file;
501        $self->DeleteImage($_);
502        splice @{$self->sums}, $_, 1 ;
503        $self->wx_thumb_imglist->Remove($_);
504        shift @images;
505    }
506    @images;
507   
508    # clear image selection
509    $self->image_selection([]);
510}
511
512# used for display in GUI. has to fit a square box ( wxImageList )
513sub CreateGUIThumbnail {
514    my ( $self ) = @_;
515
516    return 1 if( -e $self->current_image->wx_thumb_file );
517    my $rval = 0;
518    print "CreateGUIThumbnail ", $self->current_image->wx_thumb_file, "\n";
519    my $image = new Image::Magick;
520
521    my $size = $self->wx_thumb_size;
522
523    my $status = $image->Set(size=>sprintf("%sx%s", 3*$size, 3*$size));
524    warn "$status" if $status ;
525
526    $status = $image->ReadImage(
527        $self->current_image->preview_file
528    );
529    warn "$status" if $status;
530    return $rval if $status;
531
532    $self->current_image->preview_w(
533        $image->Get('width')
534    );
535    $self->current_image->preview_h(
536        $image->Get('height')
537    );
538
539
540    $status = $image->Thumbnail(
541        geometry=>sprintf("%s%s>", $size*$size, '@')
542    );
543    warn "$status" if $status;
544    return $rval if $status;
545
546#    causes strange behaviour with i18n -> yellow borders when local is other than EN
547#    $status = $image->Set(background=>"white");
548#    warn "$status" if $status ;
549
550    $status = $image->Set(Gravity=>"Center");
551    warn "$status" if $status ;
552
553    $image->Extent(
554        geometry=>sprintf("%sx%s", $size, $size),
555        gravity=>'center',
556    );
557
558    $image->Set(
559        quality=>$self->wx_quality
560    );
561
562    $status = $image->Strip();
563    warn "$status" if $status ;
564   
565
566    $image->Write(
567        sprintf(
568            "%s:%s",
569            $self->type,
570            encode('iso-8859-1', $self->current_image->wx_thumb_file),
571        )
572    );
573
574    undef $image;
575   
576    $rval = 1;
577   
578    return $rval;
579}
580
581
582sub CreateGUIPreview {
583    my ( $self ) = @_;
584    printf("CreateGUIPreview %s\n", $self->current_image->preview_file );
585    return 1 if( -e $self->current_image->preview_file );
586   
587    my $rval = 1;
588
589    my $image = Image::Magick->new();
590
591    my $ratio = $self->preview_ratio;
592
593
594    my $status = $image->Read(
595        sprintf(
596            "%s",
597            $self->current_image->file,
598        )
599    );
600    warn "$status ", $self->current_image->file, "\n" if $status ;
601    return 0 if $status;
602
603    $status = $image->Thumbnail(
604        geometry=>sprintf(
605                              "%s%%x%s%%>", 
606                              $ratio, 
607                              $ratio
608                         )
609    );
610    warn "$status" if $status ;
611    return 0 if $status;
612
613
614    $status = $image->Set(background=>"white");
615    warn "$status" if $status ;
616
617    $status = $image->Set(Gravity=>"Center");
618    warn "$status" if $status ;
619
620
621    $image->Set(quality=>$self->wx_quality);
622
623
624    $status = $image->Write(
625        sprintf(
626            "%s:%s",
627            $self->type,
628            encode('iso-8859-1', $self->current_image->preview_file),
629        )
630    );
631    warn "$status" if $status ;
632    return 0 if $status;
633   
634    undef $image;
635
636    return $rval;
637}
638
639
640sub CreateResized {
641    my ( $self ) = @_;
642   
643    my $rval = 1 ;
644    return $rval if( -e $self->current_image->site_resized_file );
645
646    printf(
647        "Create resized %s\n",
648        $self->current_image->file,
649    );     
650
651    my $image = new Image::Magick;
652
653    my $status = $image->ReadImage(
654        $self->current_image->file
655    );
656    warn "$status" if $status ;
657    return 0 if $status;
658
659    my $w = $image->Get('width');
660    my $h = $image->Get('height');
661       
662    # should calculate the aspect ratio
663    my $resize_w = $self->resize_w;
664    my $resize_h = $self->resize_h;
665       
666    if( $w < $h ){
667        my $resize_w_ = $resize_w;
668        $resize_w = $resize_h;
669        $resize_h = $resize_w_;
670    }
671   
672    $status = $image->Resize(
673        geometry => sprintf("%sx%s>", $resize_w, $resize_h), 
674        filter => sprintf("%s", $self->filter), 
675        blur => $self->blur
676    );
677    warn "$status" if $status ;
678    return 0 if $status;
679
680    $status = $image->Set(Gravity=>"Center");
681    warn "$status" if $status ;
682
683    # exif from original image
684    my $orientation = $self->current_image->exif_metadata->{Orientation};
685   
686    # Valid for Rotate 180, Rotate 90 CW, Rotate 270 CW
687    if( $orientation =~ m/Rotate (\d+)/ ){
688        printf(
689            "Rotate %s\n",
690            $1
691        );
692   
693        $image->Rotate( degrees=>$1 ); 
694    }
695
696    $status = $image->Set(quality=>$self->quality);
697    warn "$status" if $status ;
698
699    $status = $image->Set(interlace=>$self->interlace);
700    warn "$status" if $status ;
701
702    $image->Write(
703        sprintf(
704            "%s:%s",
705            $self->type,
706            encode('iso-8859-1', $self->current_image->site_resized_file),
707        )
708    );
709    warn "$status" if $status ;
710    return 0 if $status;
711   
712    undef $image;
713
714   
715    $rval = 0 if $status;
716
717    return $rval;
718}
719
720sub CreateThumbnail {
721    my ( $self ) = @_;
722   
723    return 1 if( -e $self->current_image->site_thumb_file );
724   
725    my $rval = 1;
726
727    my $image = new Image::Magick;
728
729    my $status = $image->ReadImage(
730        encode('iso-8859-1', $self->current_image->site_resized_file)
731    );
732    warn "$status" if $status ;
733
734   
735    $status = $image->Resize(
736        geometry => sprintf(
737                                "%sx%s>", 
738                                $self->thumb_size, 
739                                $self->thumb_size
740                           ),
741    );
742    warn "$status" if $status ;
743
744    $status = $image->Set(Gravity=>"Center");
745    warn "$status" if $status ;
746
747    $status = $image->Set(quality=>$self->th_quality);
748    warn "$status" if $status ;
749
750    $status = $image->Strip();
751    warn "$status" if $status ;
752
753
754    $image->Write(
755        sprintf(
756            "%s:%s",
757            $self->type,
758            encode('iso-8859-1', $self->current_image->site_thumb_file),
759        )
760    );
761   
762    undef $image;
763
764
765    $rval = 0 if $status;
766
767    return $rval;
768}
769
770
771
772sub _select_exif_data {
773    my ( $self, $exif ) = @_;
774
775    return {
776        map {
777            $_ => $exif->{$_},
778        }
779        qw/
780            CreateDate
781            ImageWidth
782            ImageHeight
783            Orientation
784            DateTimeOriginal
785            ISO
786            ExposureTime
787            ApertureValue
788            FocalLength
789            Lens
790            Exposure
791            Make
792            Model
793        /
794    };   
795}
796
797sub Store {
798    my ( $self ) = @_;
799   
800    my $data = $self->get_storable(
801        [ 
802            qw/
803                images
804                thumb_size
805                preview_ratio
806                type
807                filter
808                blur
809                quality
810                wx_quality
811                th_quality
812                prefix
813                author
814                count
815                resize_w
816                resize_h
817                new_files
818                storable_file
819                wx_thumb_size
820                current_image
821                exif_metadata
822                wx_thumb_dir
823                preview_dir
824                site_resized_dir
825                site_thumb_dir
826                userdata_dir
827                progress_msg
828                default_photo_name
829                default_name_prefix
830                upload_high
831                remove_uploaded_from_selection
832                auto_rotate
833                interlace
834                create_resized
835                use_exif_preview
836                image_sums
837                sums
838                version
839                imagelist_version
840            /
841        ] 
842   
843    );
844    eval {
845        store $data, $self->storable_file;
846    };
847    if($@){
848        print $@, "\n"; 
849    }
850}
851
852
853
854sub UploadSelection {
855    my ( $self ) = @_; 
856
857    my $viewer_callback = $self->UploadImagesViewerCallback ;
858
859
860    $self->upload_rejects(
861        []
862    );
863
864    my $count = 1;
865    my $msg;
866    $self->count(
867        $count
868    );
869    my $uploaded = 0;
870    my $rejected = 0;
871    my $time_begin = time;
872    my $last_error;
873    map {
874        # current image object         
875        $self->current_image(
876            $self->GetImage($_)
877        );
878
879        my ( $vol, $dir, $file ) = File::Spec->splitpath(
880            $self->current_image->file
881        );
882       
883        my $site_name = $self->current_image->site_name;
884   
885#        my ( $filename, $ext ) = split /\./, $file ;
886        my $filename = $self->current_image->file_sum ;
887
888        # lately defined to make sure we have the last global properties ( resize_w, resize_h )
889        $self->current_image->site_resized_file( 
890            File::Spec->catfile(
891                $self->site_resized_dir,
892                sprintf(
893                    "%s_%sx%s.%s",
894                    $filename,
895                    $self->resize_w,
896                    $self->resize_h,
897                    $self->type,
898                )
899            )
900        );
901       
902        $msg = sprintf(
903            "Preparing resized image for %s - %s",
904            $site_name,
905            $file,
906        ); 
907
908        eval {
909            # set current image thumbnail
910            $self->progress_thumbnail_refresh->();
911
912            $self->progress_msg_refresh->($msg);
913   
914            # update upload progress dialog
915            $self->progressbar_refresh->(0.20);
916        };
917        # user cancelled : dialog box is destroyed
918        croak "Upload cancelled. ", $@ if $@ ;
919
920        if( $self->create_resized ){
921            eval {
922                if(!$self->CreateResized()){
923                    printf("CreateResized failed %s. Use ResizeCallback\n", $@);
924                    # use method provided by the caller
925                    # source, target, type, ratio, width, $height
926                    $self->ResizeCallback->(
927                        $self->current_image->file,
928                        $self->current_image->site_resized_file,
929                        $self->type,
930                        undef,
931                        $self->resize_w,
932                        $self->resize_h,
933                        $self->quality,
934                    );
935               
936                    $self->RotateImage(
937                        $self->current_image->site_resized_file,
938                    ) if $self->auto_rotate;
939                }
940            };
941            $self->_set_exif_tag(
942                $self->current_image->site_resized_file,
943                'Orientation',
944                'Horizontal (normal)',
945            ) if $self->auto_rotate;
946        }
947        # the original is at the right size, no need to create a resize
948        else {
949            $self->current_image->site_resized_file(
950                $self->current_image->file,
951            );
952        }
953
954
955
956        # if upload high, rotate a copy of original file
957        if($self->upload_high){
958            $self->CreateHigh();
959        }
960
961        $msg = sprintf(
962            "Preparing thumbnail for %s - %s",
963            $site_name,
964            $file,
965        );
966
967        eval {
968            $self->progress_msg_refresh->($msg);
969        };
970        croak "Upload cancelled. ", $@ if $@ ;
971
972        eval {
973            $self->CreateThumbnail();
974        };
975
976        if($@){
977            $msg = sprintf(
978                "An error has occured %s - %s\n$@",
979                $site_name,
980                $file
981            );
982        }
983        else{
984            $msg = sprintf(
985                "Uploading %s - %s",
986                $site_name,
987                $file
988            );
989        }
990        eval {
991            $self->progress_msg_refresh->($msg);
992            $self->progressbar_refresh->(0.50);
993        };
994        croak "Upload cancelled. ", $@ if $@ ;
995
996        # photo metadata
997        $self->_prepare_upload_properties();           
998        my ( $status, $status_msg ) = $self->pwg->UploadImage();
999
1000        if ( $status ){
1001            $msg = sprintf(
1002                "%s : %s upload succcessful.",
1003                $site_name,
1004                $file
1005            );
1006
1007            $uploaded++;
1008        } else {
1009            $msg = sprintf(
1010                "An error has occured.\n%s : %s upload is cancelled.\n$status_msg",
1011                $site_name,
1012                $file
1013            );
1014            $rejected++;
1015            $last_error = $status_msg;
1016        }       
1017       
1018        $count++;
1019        $self->count(
1020            $count
1021        );
1022        # update upload progress dialog
1023        eval {
1024            $self->progress_msg_refresh->($msg);
1025            $self->progressbar_refresh->(1);
1026        };
1027        croak "Upload cancelled. ", $@ if $@ ;
1028       
1029    }
1030    @{$self->image_selection} if defined 
1031        $self->image_selection;
1032
1033    my $time_end = time;
1034    my $duration = $time_end - $time_begin;
1035    $msg = sprintf(
1036        "%s images processed\n\n%s images uploaded\n\n%s images in errors and not uploaded - $last_error\n\nDuration : %s seconds",
1037        $self->count - 1,
1038        $uploaded,
1039        $rejected,
1040        $duration,
1041    );
1042    $self->progress_endinfo_refresh->($msg);
1043}
1044
1045# if we need to rotate
1046sub CreateHigh {
1047    my ( $self ) = @_;
1048
1049    my $orientation = $self->current_image->exif_metadata->{Orientation};
1050   
1051    # Valid for Rotate 180, Rotate 90 CW, Rotate 270 CW
1052    if( $self->auto_rotate and $orientation =~ m/Rotate (\d+)/ ){
1053
1054        my ( $vol, $dir, $file ) = File::Spec->splitpath(
1055            $self->current_image->file
1056        );
1057   
1058        my ( $filename, $ext ) = split /\./, $file ;
1059   
1060        # high_file is a copy of original
1061        $self->current_image->site_high_file( 
1062            File::Spec->catfile(
1063                $self->site_resized_dir,
1064                sprintf(
1065                    "%s_high.%s",
1066                    $filename,
1067                    $self->type,
1068                )
1069            )
1070        );
1071
1072        my $image = Image::Magick->new();
1073        # we read original
1074        my $status = $image->Read(
1075            $self->current_image->file
1076        );
1077        warn "$status ", $self->current_image->file, "\n" if $status ;
1078        return 0 if $status;
1079
1080        $image->Rotate( degrees=>$1 ); 
1081       
1082        $image->Write(
1083            filename=>encode('iso-8859-1', $self->current_image->site_high_file)
1084        );
1085        warn "$status ", $self->current_image->site_high_file, "\n" if $status ;
1086        return 0 if $status;
1087       
1088        undef $image;
1089
1090        $self->_set_exif_tag(
1091            $self->current_image->site_high_file,
1092            'Orientation',
1093            'Horizontal (normal)',
1094        );
1095
1096        # Now all images that need to be rotated are done. Update exif
1097        $self->current_image->exif_metadata->{Orientation} = 'Horizontal (normal)';
1098    }
1099    else{
1100        # high file is the original file
1101        $self->current_image->site_high_file(
1102            $self->current_image->file
1103        );
1104    }
1105
1106    return 1;
1107}
1108
1109sub _prepare_upload_properties {
1110    my ( $self ) = @_;
1111   
1112    $self->pwg->upload_high(
1113        $self->upload_high
1114    );
1115
1116    $self->pwg->site_high_file(
1117        $self->current_image->site_high_file
1118    );
1119
1120    $self->pwg->site_resized_file(
1121        $self->current_image->site_resized_file
1122    );
1123
1124    $self->pwg->site_thumb_file(
1125        $self->current_image->site_thumb_file
1126    );
1127
1128    $self->pwg->site_author(
1129        $self->current_image->site_author
1130    );
1131
1132    $self->pwg->site_comment(
1133        $self->current_image->site_comment
1134    );
1135
1136    $self->pwg->site_image_name(
1137        $self->current_image->site_name
1138    );
1139
1140    $self->pwg->site_img_date_creation(
1141        $self->current_image->create_date
1142    );
1143
1144    $self->current_image->site_categories(
1145        $self->categories
1146    );
1147
1148    $self->pwg->categories(
1149        sprintf(
1150            "%s",
1151            join(';', @{$self->categories})
1152        )
1153    );
1154
1155    $self->pwg->tags(
1156        #join(',', @{$self->current_image->site_tags})
1157    );
1158       
1159}
1160
1161# read Orientation exif tag from original image
1162# apply rotation to image ( preview or resize )
1163sub RotateImage {
1164    my ( $self, $file ) = @_;
1165   
1166    # exif from original image
1167    my $orientation = $self->current_image->exif_metadata->{Orientation};
1168   
1169    # Valid for Rotate 180, Rotate 90 CW, Rotate 270 CW
1170    if( $orientation =~ m/Rotate (\d+)/ ){
1171        printf(
1172            "Rotate %s\n",
1173            $1
1174        );
1175
1176        my $image = Image::Magick->new();
1177       
1178        # read resized file
1179        my $status = $image->Read(
1180            $file
1181        );
1182        warn "$status ", $file, "\n" if $status ;
1183        return 0 if $status;
1184   
1185        $image->Rotate( degrees=>$1 ); 
1186       
1187        # write resizd file
1188        $image->Write(
1189            filename=>encode('iso-8859-1', $file)
1190        );
1191        warn "$status ", $file, "\n" if $status ;
1192        return 0 if $status;
1193       
1194        undef $image;
1195   
1196    }   
1197    return 1;
1198}
1199
1200sub GetImage {
1201    my ( $self, $indx ) = @_;
1202   
1203    my $sum = $self->sums->[$indx];
1204
1205    $self->image_sums->{$sum};
1206}
1207
1208sub DeleteImage {
1209    my ( $self, $indx ) = @_;
1210   
1211    my $sum = $self->sums->[$indx];
1212
1213    delete $self->image_sums->{$sum};
1214}
1215
1216
12171;
Note: See TracBrowser for help on using the repository browser.