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

Last change on this file since 3387 was 3387, checked in by ronosman, 11 years ago

Feature 989 added : Global settings option to remove uploaded photos from selection.

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