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

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

Bug 997 fixed : accented characters in photo filename causes default caption to be truncated.

  • Property svn:eol-style set to LF
File size: 29.8 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        splice @{$self->sums}, $_, 1 ;
502        $self->wx_thumb_imglist->Remove($_);
503        shift @images;
504    }
505    @images;
506   
507    # clear image selection
508    $self->image_selection([]);
509}
510
511# used for display in GUI. has to fit a square box ( wxImageList )
512sub CreateGUIThumbnail {
513    my ( $self ) = @_;
514
515    return 1 if( -e $self->current_image->wx_thumb_file );
516    my $rval = 0;
517    print "CreateGUIThumbnail ", $self->current_image->wx_thumb_file, "\n";
518    my $image = new Image::Magick;
519
520    my $size = $self->wx_thumb_size;
521
522    my $status = $image->Set(size=>sprintf("%sx%s", 3*$size, 3*$size));
523    warn "$status" if $status ;
524
525    $status = $image->ReadImage(
526        $self->current_image->preview_file
527    );
528    warn "$status" if $status;
529    return $rval if $status;
530
531    $self->current_image->preview_w(
532        $image->Get('width')
533    );
534    $self->current_image->preview_h(
535        $image->Get('height')
536    );
537
538
539    $status = $image->Thumbnail(
540        geometry=>sprintf("%s%s>", $size*$size, '@')
541    );
542    warn "$status" if $status;
543    return $rval if $status;
544
545#    causes strange behaviour with i18n -> yellow borders when local is other than EN
546#    $status = $image->Set(background=>"white");
547#    warn "$status" if $status ;
548
549    $status = $image->Set(Gravity=>"Center");
550    warn "$status" if $status ;
551
552    $image->Extent(
553        geometry=>sprintf("%sx%s", $size, $size),
554        gravity=>'center',
555    );
556
557    $image->Set(
558        quality=>$self->wx_quality
559    );
560
561    $status = $image->Strip();
562    warn "$status" if $status ;
563   
564
565    $image->Write(
566        sprintf(
567            "%s:%s",
568            $self->type,
569            encode('iso-8859-1', $self->current_image->wx_thumb_file),
570        )
571    );
572
573    undef $image;
574   
575    $rval = 1;
576   
577    return $rval;
578}
579
580
581sub CreateGUIPreview {
582    my ( $self ) = @_;
583    printf("CreateGUIPreview %s\n", $self->current_image->preview_file );
584    return 1 if( -e $self->current_image->preview_file );
585   
586    my $rval = 1;
587
588    my $image = Image::Magick->new();
589
590    my $ratio = $self->preview_ratio;
591
592
593    my $status = $image->Read(
594        sprintf(
595            "%s",
596            $self->current_image->file,
597        )
598    );
599    warn "$status ", $self->current_image->file, "\n" if $status ;
600    return 0 if $status;
601
602    $status = $image->Thumbnail(
603        geometry=>sprintf(
604                              "%s%%x%s%%>", 
605                              $ratio, 
606                              $ratio
607                         )
608    );
609    warn "$status" if $status ;
610    return 0 if $status;
611
612
613    $status = $image->Set(background=>"white");
614    warn "$status" if $status ;
615
616    $status = $image->Set(Gravity=>"Center");
617    warn "$status" if $status ;
618
619
620    $image->Set(quality=>$self->wx_quality);
621
622
623    $status = $image->Write(
624        sprintf(
625            "%s:%s",
626            $self->type,
627            encode('iso-8859-1', $self->current_image->preview_file),
628        )
629    );
630    warn "$status" if $status ;
631    return 0 if $status;
632   
633    undef $image;
634
635    return $rval;
636}
637
638
639sub CreateResized {
640    my ( $self ) = @_;
641   
642    my $rval = 1 ;
643    return $rval if( -e $self->current_image->site_resized_file );
644
645    printf(
646        "Create resized %s\n",
647        $self->current_image->file,
648    );     
649
650    my $image = new Image::Magick;
651
652    my $status = $image->ReadImage(
653        $self->current_image->file
654    );
655    warn "$status" if $status ;
656    return 0 if $status;
657
658    my $w = $image->Get('width');
659    my $h = $image->Get('height');
660       
661    # should calculate the aspect ratio
662    my $resize_w = $self->resize_w;
663    my $resize_h = $self->resize_h;
664       
665    if( $w < $h ){
666        my $resize_w_ = $resize_w;
667        $resize_w = $resize_h;
668        $resize_h = $resize_w_;
669    }
670   
671    $status = $image->Resize(
672        geometry => sprintf("%sx%s>", $resize_w, $resize_h), 
673        filter => sprintf("%s", $self->filter), 
674        blur => $self->blur
675    );
676    warn "$status" if $status ;
677    return 0 if $status;
678
679    $status = $image->Set(Gravity=>"Center");
680    warn "$status" if $status ;
681
682    # exif from original image
683    my $orientation = $self->current_image->exif_metadata->{Orientation};
684   
685    # Valid for Rotate 180, Rotate 90 CW, Rotate 270 CW
686    if( $orientation =~ m/Rotate (\d+)/ ){
687        printf(
688            "Rotate %s\n",
689            $1
690        );
691   
692        $image->Rotate( degrees=>$1 ); 
693    }
694
695    $status = $image->Set(quality=>$self->quality);
696    warn "$status" if $status ;
697
698    $status = $image->Set(interlace=>$self->interlace);
699    warn "$status" if $status ;
700
701    $image->Write(
702        sprintf(
703            "%s:%s",
704            $self->type,
705            encode('iso-8859-1', $self->current_image->site_resized_file),
706        )
707    );
708    warn "$status" if $status ;
709    return 0 if $status;
710   
711    undef $image;
712
713   
714    $rval = 0 if $status;
715
716    return $rval;
717}
718
719sub CreateThumbnail {
720    my ( $self ) = @_;
721   
722    return 1 if( -e $self->current_image->site_thumb_file );
723   
724    my $rval = 1;
725
726    my $image = new Image::Magick;
727
728    my $status = $image->ReadImage(
729        encode('iso-8859-1', $self->current_image->site_resized_file)
730    );
731    warn "$status" if $status ;
732
733   
734    $status = $image->Resize(
735        geometry => sprintf(
736                                "%sx%s>", 
737                                $self->thumb_size, 
738                                $self->thumb_size
739                           ),
740    );
741    warn "$status" if $status ;
742
743    $status = $image->Set(Gravity=>"Center");
744    warn "$status" if $status ;
745
746    $status = $image->Set(quality=>$self->th_quality);
747    warn "$status" if $status ;
748
749    $status = $image->Strip();
750    warn "$status" if $status ;
751
752
753    $image->Write(
754        sprintf(
755            "%s:%s",
756            $self->type,
757            encode('iso-8859-1', $self->current_image->site_thumb_file),
758        )
759    );
760   
761    undef $image;
762
763
764    $rval = 0 if $status;
765
766    return $rval;
767}
768
769
770
771sub _select_exif_data {
772    my ( $self, $exif ) = @_;
773
774    return {
775        map {
776            $_ => $exif->{$_},
777        }
778        qw/
779            CreateDate
780            ImageWidth
781            ImageHeight
782            Orientation
783            DateTimeOriginal
784            ISO
785            ExposureTime
786            ApertureValue
787            FocalLength
788            Lens
789            Exposure
790            Make
791            Model
792        /
793    };   
794}
795
796sub Store {
797    my ( $self ) = @_;
798   
799    my $data = $self->get_storable(
800        [ 
801            qw/
802                images
803                thumb_size
804                preview_ratio
805                type
806                filter
807                blur
808                quality
809                wx_quality
810                th_quality
811                prefix
812                author
813                count
814                resize_w
815                resize_h
816                new_files
817                storable_file
818                wx_thumb_size
819                current_image
820                exif_metadata
821                wx_thumb_dir
822                preview_dir
823                site_resized_dir
824                site_thumb_dir
825                userdata_dir
826                progress_msg
827                default_photo_name
828                default_name_prefix
829                upload_high
830                remove_uploaded_from_selection
831                auto_rotate
832                interlace
833                create_resized
834                use_exif_preview
835                image_sums
836                sums
837                version
838                imagelist_version
839            /
840        ] 
841   
842    );
843    eval {
844        store $data, $self->storable_file;
845    };
846    if($@){
847        print $@, "\n"; 
848    }
849}
850
851
852
853sub UploadSelection {
854    my ( $self ) = @_; 
855
856    my $viewer_callback = $self->UploadImagesViewerCallback ;
857
858
859    $self->upload_rejects(
860        []
861    );
862
863    my $count = 1;
864    my $msg;
865    $self->count(
866        $count
867    );
868    my $uploaded = 0;
869    my $rejected = 0;
870    my $time_begin = time;
871    my $last_error;
872    map {
873        # current image object         
874        $self->current_image(
875            $self->GetImage($_)
876        );
877
878        my ( $vol, $dir, $file ) = File::Spec->splitpath(
879            $self->current_image->file
880        );
881       
882        my $site_name = $self->current_image->site_name;
883   
884#        my ( $filename, $ext ) = split /\./, $file ;
885        my $filename = $self->current_image->file_sum ;
886
887        # lately defined to make sure we have the last global properties ( resize_w, resize_h )
888        $self->current_image->site_resized_file( 
889            File::Spec->catfile(
890                $self->site_resized_dir,
891                sprintf(
892                    "%s_%sx%s.%s",
893                    $filename,
894                    $self->resize_w,
895                    $self->resize_h,
896                    $self->type,
897                )
898            )
899        );
900       
901        $msg = sprintf(
902            "Preparing resized image for %s - %s",
903            $site_name,
904            $file,
905        ); 
906
907        eval {
908            # set current image thumbnail
909            $self->progress_thumbnail_refresh->();
910
911            $self->progress_msg_refresh->($msg);
912   
913            # update upload progress dialog
914            $self->progressbar_refresh->(0.25);
915        };
916        # user cancelled : dialog box is destroyed
917        croak "Upload cancelled. ", $@ if $@ ;
918
919        if( $self->create_resized ){
920            eval {
921                if(!$self->CreateResized()){
922                    printf("CreateResized failed %s. Use ResizeCallback\n", $@);
923                    # use method provided by the caller
924                    # source, target, type, ratio, width, $height
925                    $self->ResizeCallback->(
926                        $self->current_image->file,
927                        $self->current_image->site_resized_file,
928                        $self->type,
929                        undef,
930                        $self->resize_w,
931                        $self->resize_h,
932                        $self->quality,
933                    );
934               
935                    $self->RotateImage(
936                        $self->current_image->site_resized_file,
937                    ) if $self->auto_rotate;
938                }
939            };
940            $self->_set_exif_tag(
941                $self->current_image->site_resized_file,
942                'Orientation',
943                'Horizontal (normal)',
944            ) if $self->auto_rotate;
945        }
946        # the original is at the right size, no need to create a resize
947        else {
948            $self->current_image->site_resized_file(
949                $self->current_image->file,
950            );
951        }
952
953
954
955        # if upload high, rotate a copy of original file
956        if($self->upload_high){
957            $self->CreateHigh();
958        }
959
960        $msg = sprintf(
961            "Preparing thumbnail for %s - %s",
962            $site_name,
963            $file,
964        );
965
966        eval {
967            $self->progress_msg_refresh->($msg);
968        };
969        croak "Upload cancelled. ", $@ if $@ ;
970
971        eval {
972            $self->CreateThumbnail();
973        };
974
975        if($@){
976            $msg = sprintf(
977                "An error has occured %s - %s\n$@",
978                $site_name,
979                $file
980            );
981        }
982        else{
983            $msg = sprintf(
984                "Uploading %s - %s",
985                $site_name,
986                $file
987            );
988        }
989        eval {
990            $self->progress_msg_refresh->($msg);
991            $self->progressbar_refresh->(0.50);
992        };
993        croak "Upload cancelled. ", $@ if $@ ;
994
995        # photo metadata
996        $self->_prepare_upload_properties();           
997        my ( $status, $status_msg ) = $self->pwg->UploadImage();
998
999        if ( $status ){
1000            $msg = sprintf(
1001                "%s : %s upload succcessful.",
1002                $site_name,
1003                $file
1004            );
1005
1006            $uploaded++;
1007        } else {
1008            $msg = sprintf(
1009                "An error has occured.\n%s : %s upload is cancelled.\n$status_msg",
1010                $site_name,
1011                $file
1012            );
1013            $rejected++;
1014            $last_error = $status_msg;
1015        }       
1016       
1017        $count++;
1018        $self->count(
1019            $count
1020        );
1021        # update upload progress dialog
1022        eval {
1023            $self->progress_msg_refresh->($msg);
1024            $self->progressbar_refresh->(1);
1025        };
1026        croak "Upload cancelled. ", $@ if $@ ;
1027       
1028    }
1029    @{$self->image_selection} if defined 
1030        $self->image_selection;
1031
1032    my $time_end = time;
1033    my $duration = $time_end - $time_begin;
1034    $msg = sprintf(
1035        "%s images processed\n\n%s images uploaded\n\n%s images in errors and not uploaded - $last_error\n\nDuration : %s seconds",
1036        $self->count - 1,
1037        $uploaded,
1038        $rejected,
1039        $duration,
1040    );
1041    $self->progress_endinfo_refresh->($msg);
1042}
1043
1044# if we need to rotate
1045sub CreateHigh {
1046    my ( $self ) = @_;
1047
1048    my $orientation = $self->current_image->exif_metadata->{Orientation};
1049   
1050    # Valid for Rotate 180, Rotate 90 CW, Rotate 270 CW
1051    if( $self->auto_rotate and $orientation =~ m/Rotate (\d+)/ ){
1052
1053        my ( $vol, $dir, $file ) = File::Spec->splitpath(
1054            $self->current_image->file
1055        );
1056   
1057        my ( $filename, $ext ) = split /\./, $file ;
1058   
1059        # high_file is a copy of original
1060        $self->current_image->site_high_file( 
1061            File::Spec->catfile(
1062                $self->site_resized_dir,
1063                sprintf(
1064                    "%s_high.%s",
1065                    $filename,
1066                    $self->type,
1067                )
1068            )
1069        );
1070
1071        my $image = Image::Magick->new();
1072        # we read original
1073        my $status = $image->Read(
1074            $self->current_image->file
1075        );
1076        warn "$status ", $self->current_image->file, "\n" if $status ;
1077        return 0 if $status;
1078
1079        $image->Rotate( degrees=>$1 ); 
1080       
1081        $image->Write(
1082            filename=>encode('iso-8859-1', $self->current_image->site_high_file)
1083        );
1084        warn "$status ", $self->current_image->site_high_file, "\n" if $status ;
1085        return 0 if $status;
1086       
1087        undef $image;
1088
1089        $self->_set_exif_tag(
1090            $self->current_image->site_high_file,
1091            'Orientation',
1092            'Horizontal (normal)',
1093        );
1094
1095        # Now all images that need to be rotated are done. Update exif
1096        $self->current_image->exif_metadata->{Orientation} = 'Horizontal (normal)';
1097    }
1098    else{
1099        # high file is the original file
1100        $self->current_image->site_high_file(
1101            $self->current_image->file
1102        );
1103    }
1104
1105    return 1;
1106}
1107
1108sub _prepare_upload_properties {
1109    my ( $self ) = @_;
1110   
1111    $self->pwg->upload_high(
1112        $self->upload_high
1113    );
1114
1115    $self->pwg->site_high_file(
1116        $self->current_image->site_high_file
1117    );
1118
1119    $self->pwg->site_resized_file(
1120        $self->current_image->site_resized_file
1121    );
1122
1123    $self->pwg->site_thumb_file(
1124        $self->current_image->site_thumb_file
1125    );
1126
1127    $self->pwg->site_author(
1128        $self->current_image->site_author
1129    );
1130
1131    $self->pwg->site_comment(
1132        $self->current_image->site_comment
1133    );
1134
1135    $self->pwg->site_image_name(
1136        $self->current_image->site_name
1137    );
1138
1139    $self->pwg->site_img_date_creation(
1140        $self->current_image->create_date
1141    );
1142
1143    $self->current_image->site_categories(
1144        $self->categories
1145    );
1146
1147    $self->pwg->categories(
1148        sprintf(
1149            "%s",
1150            join(';', @{$self->categories})
1151        )
1152    );
1153
1154    $self->pwg->tags(
1155        #join(',', @{$self->current_image->site_tags})
1156    );
1157       
1158}
1159
1160# read Orientation exif tag from original image
1161# apply rotation to image ( preview or resize )
1162sub RotateImage {
1163    my ( $self, $file ) = @_;
1164   
1165    # exif from original image
1166    my $orientation = $self->current_image->exif_metadata->{Orientation};
1167   
1168    # Valid for Rotate 180, Rotate 90 CW, Rotate 270 CW
1169    if( $orientation =~ m/Rotate (\d+)/ ){
1170        printf(
1171            "Rotate %s\n",
1172            $1
1173        );
1174
1175        my $image = Image::Magick->new();
1176       
1177        # read resized file
1178        my $status = $image->Read(
1179            $file
1180        );
1181        warn "$status ", $file, "\n" if $status ;
1182        return 0 if $status;
1183   
1184        $image->Rotate( degrees=>$1 ); 
1185       
1186        # write resizd file
1187        $image->Write(
1188            filename=>encode('iso-8859-1', $file)
1189        );
1190        warn "$status ", $file, "\n" if $status ;
1191        return 0 if $status;
1192       
1193        undef $image;
1194   
1195    }   
1196    return 1;
1197}
1198
1199sub GetImage {
1200    my ( $self, $indx ) = @_;
1201   
1202    my $sum = $self->sums->[$indx];
1203
1204    $self->image_sums->{$sum};
1205}
1206
12071;
Note: See TracBrowser for help on using the repository browser.