source: extras/pLoader/trunk/src/Uploader/ImageList.pm @ 3267

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

Feature 987 added: use filename or prefix to create a default photo name.

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