source: extensions/pLoader/trunk/src/Uploader/GUI/App.pm @ 6513

Last change on this file since 6513 was 6513, checked in by ronosman, 14 years ago

Add a confirmation message before canceling job.

File size: 35.9 KB
Line 
1package Uploader::GUI::App;
2use threads;
3use threads::shared;
4use Thread::Queue;
5use strict;
6use base qw/Wx::App Class::Accessor::Fast/;
7use Wx qw/
8    wxBITMAP_TYPE_GIF
9    wxBITMAP_TYPE_ICO
10    wxBITMAP_TYPE_BMP
11    wxBITMAP_TYPE_PNG
12    wxBITMAP_TYPE_JPEG
13    wxIMAGE_QUALITY_HIGH
14    wxSPLASH_CENTRE_ON_SCREEN
15    wxSPLASH_TIMEOUT
16    wxDefaultPosition
17    wxDefaultSize
18    wxSIMPLE_BORDER
19    wxFRAME_TOOL_WINDOW
20    wxFRAME_NO_TASKBAR wxSTAY_ON_TOP
21    wxWHITE
22    wxICON_EXCLAMATION
23    wxICON_QUESTION
24    wxOK
25    wxYES
26    wxYES_NO
27    wxNO_DEFAULT
28    wxICON_ERROR
29    wxLANGUAGE_CHINESE_SIMPLIFIED
30    wxLANGUAGE_CZECH
31    wxLANGUAGE_DANISH
32    wxLANGUAGE_DUTCH
33    wxLANGUAGE_ENGLISH
34    wxLANGUAGE_FRENCH
35    wxLANGUAGE_GERMAN
36    wxLANGUAGE_HUNGARIAN
37    wxLANGUAGE_ITALIAN
38    wxLANGUAGE_JAPANESE
39    wxLANGUAGE_POLISH
40    wxLANGUAGE_PORTUGUESE
41    wxLANGUAGE_PORTUGUESE_BRAZILIAN
42    wxLANGUAGE_RUSSIAN
43    wxLANGUAGE_SLOVAK
44    wxLANGUAGE_SPANISH
45/;
46use Wx::Locale qw/:default/;
47use File::HomeDir;
48use Uploader::PWG;
49use Uploader::Images;
50use Uploader::Connection;
51use Uploader::Preferences;
52use Uploader::ResizeManager;
53use Uploader::TransferManager;
54use Uploader::GUI::LoginDlg;
55use Storable;
56use utf8;
57use Data::Dumper;
58use IO::Socket;
59use Wx::Socket;
60
61my $received_filename_event : shared = Wx::NewEventType;
62my $transfer_progress_event : shared = Wx::NewEventType;
63my $transfer_done_event : shared = Wx::NewEventType;
64my $resize_done_event : shared = Wx::NewEventType;
65my $resize_progress_event : shared = Wx::NewEventType;
66
67my $image_progress_event = Wx::NewEventType;
68
69$|=1;
70
71
72my @app_properties = qw/
73    version
74    frame
75    argv
76    images
77    images_version
78    preferences
79    preferences_version
80    user_def_preferences
81    privacy_level
82    upload_hd
83    resize_manager
84    transfer_manager
85/;
86
87
88my @connection_properties = qw/
89    connection_version
90    connection
91    login_dlg
92    branding
93    use_offline
94    use_connected
95    pwg
96/;
97
98
99my @file_properties = qw/
100    bin_dir
101    resource_dir
102    thumb_dir
103    resized_dir
104    wx_thumb_dir
105    userdata_dir
106    root_dir
107    locale_dir
108    preferences_file
109    connection_file
110    images_file
111    app_file
112    instance_checker_file
113/;
114
115
116my @localized_properties = qw/
117    colors
118    positions
119    upload_hd
120    caption_patterns
121/;
122
123
124my @language_properties = qw/
125    current_language
126    locale
127    languages
128    available_languages
129    eng_colors
130    eng_positions
131    eng_upload_hd
132    eng_caption_patterns
133/;
134
135
136my @transfer_properties = qw/
137    transfer_thread
138    transfer_thread_queue
139    resize_thread
140    resize_thread_queue
141/;
142
143my @custom_events = qw/
144    resize_start_event
145    image_progress_event
146/;
147
148__PACKAGE__->mk_accessors(@app_properties);
149__PACKAGE__->mk_accessors(@file_properties);
150__PACKAGE__->mk_accessors(@connection_properties);
151__PACKAGE__->mk_accessors(@localized_properties);
152__PACKAGE__->mk_accessors(@language_properties);
153__PACKAGE__->mk_accessors(@transfer_properties);
154__PACKAGE__->mk_accessors(@custom_events);
155
156my $_params;
157
158sub new {
159    my ( $self, $params ) = @_;
160
161    $_params = $params;
162
163    $self->SUPER::new();
164
165}
166
167
168sub OnInit {
169    my( $self ) = @_;
170
171    $self->init_properties_from_params;
172    $self->init_application_properties;
173    $self->init_single_instance_checker;
174    $self->init_file_properties;
175    $self->init_locale;
176    $self->init_localized_properties;
177    $self->init_preferences;
178    $self->init_resize_manager;
179    $self->init_images;
180
181    return 0 unless $self->is_single_instance_server;
182
183    $self->connect_or_exit;
184
185}
186
187
188sub OnExit {
189    my( $self ) = @_;
190
191    unlink $self->instance_checker_file
192        if -e $self->instance_checker_file;
193    $self->store_all;
194
195}
196
197
198sub store_all {
199    my( $self ) = @_;
200
201    $self->connection->Store;;
202    $self->images->Store;
203    $self->preferences->Store;
204
205}
206
207
208sub cancel_queues {
209    my ( $self ) = @_;
210
211    $self->cancel_resize;
212    $self->cancel_transfer;
213}
214
215
216sub stop_all {
217    my( $self ) = @_;
218
219    $self->stop_resize_manager;
220    $self->stop_transfer_manager;
221    $self->stop_single_instance_server;
222    $self->login_dlg->Destroy;   
223
224
225
226}
227
228
229sub stop_queues {
230    my ( $self ) = @_;
231
232    $self->stop_resize;
233    $self->stop_transfer;
234}
235
236
237sub stop_resize_manager {
238    my( $self ) = @_;
239
240    $self->stop_resize;
241    $self->resize_thread->detach;
242}
243
244
245sub stop_transfer_manager {
246    my( $self ) = @_;
247
248    $self->stop_transfer;
249    $self->transfer_thread->detach;
250}
251
252sub cancel_transfer {
253    my( $self ) = @_;
254   
255    my $data : shared = "CANCEL";
256
257    $self->transfer_thread_queue->insert(0, $data);
258}
259
260
261sub stop_transfer {
262    my( $self ) = @_;
263   
264    my $data : shared = "STOP";
265
266    $self->transfer_thread_queue->insert(0, $data);
267}
268
269
270sub init_properties_from_params {
271    my ( $self ) = @_;
272
273    map {
274        $self->$_(
275            $_params->{$_}
276        )
277    } keys %$_params;
278
279}
280
281
282sub init_application_properties {
283    my ( $self ) = @_;
284
285    $self->version(
286        '1.7'
287    );
288   
289
290    Wx::InitAllImageHandlers();
291
292    $self->{IMGTYPE} = {
293        'jpg' => wxBITMAP_TYPE_JPEG,
294        'gif' => wxBITMAP_TYPE_GIF,
295        'png' => wxBITMAP_TYPE_PNG,
296    };
297
298    my $applicationName = "pLoader" ;
299    $self->SetAppName( $applicationName );
300    $self->SetVendorName( "Piwigo Team" );
301
302
303}
304
305
306sub init_single_instance_checker {
307    my ( $self ) = @_;
308
309
310    my $id_user=$ENV{USERNAME} || $ENV{USER} || $ENV{LOGNAME};
311    # must save the object
312    $self->{_instance_checker} = Wx::SingleInstanceChecker->new;
313    my $pid = sprintf(
314        "%s-%s",
315        $self->GetAppName,
316        $id_user,
317    );
318    $self->{_instance_checker}->Create(
319        $pid
320    );
321
322    $self->instance_checker_file(
323        File::Spec->canonpath(
324            File::Spec->catfile(
325                File::HomeDir->my_home(),
326                $pid
327            )
328        )
329    );
330
331}
332
333
334sub init_file_properties {
335    my ( $self ) = @_;
336   
337    my $applicationName = $self->GetAppName ;
338    my $userdatadir = File::Spec->canonpath(
339        File::Spec->catfile(
340            File::HomeDir->my_data(), 
341            $applicationName
342        )
343    );
344
345    if(! -d $userdatadir){
346        if(! mkdir $userdatadir){
347            Wx::MessageBox( 
348                sprintf(
349                    "%s directory creation failed",
350                    $userdatadir,
351                ),
352                "pLoader working directory creation error",
353                wxOK | wxICON_EXCLAMATION, 
354            );
355
356            $userdatadir = File::Spec->canonpath(
357                File::Spec->catfile(
358                    File::Spec->tmpdir(), 
359                    $applicationName
360                )
361            );
362            mkdir $userdatadir;
363        }   
364    }
365
366    $self->userdata_dir($userdatadir);
367
368    $self->app_file(
369        $self->userdata_filepath("$applicationName.dat")
370    );
371
372    $self->preferences_file(
373        $self->userdata_filepath("preferences.dat")
374    );
375
376    $self->connection_file(
377        $self->userdata_filepath("connection.dat")
378    );
379
380    $self->images_file(
381        $self->userdata_filepath("images.dat")
382    );
383   
384    my $thumbdir = $self->userdata_filepath('thumbnails');
385    mkdir $thumbdir unless -d $thumbdir ;
386    $self->thumb_dir($thumbdir);
387
388    my $wxthumbdir = $self->userdata_filepath('wxthumbnails');
389    mkdir $wxthumbdir unless -d $wxthumbdir ;
390    $self->wx_thumb_dir($wxthumbdir);
391
392
393    my $resizedir = $self->userdata_filepath('resize');
394    mkdir $resizedir unless -d $resizedir ;
395    $self->resized_dir($resizedir);
396}
397
398
399sub userdata_filepath {
400    my ( $self, $filename ) = @_;
401
402    File::Spec->catfile(
403        $self->userdata_dir,
404        $filename
405    );
406}
407
408
409sub read_params {
410    my( $self, $file ) = @_ ;
411
412 
413    my $expr_params ;
414    eval { $expr_params = read_file( $file ); } ;
415   
416    my $paramValues = [] ;
417    if($expr_params){
418        my $expr = '$paramValues = ' ;
419        $expr .=  "$expr_params ; " ;
420        eval $expr ;
421    }
422   
423    return unless 'ARRAY' eq ref $paramValues ;
424   
425    if(scalar(@$paramValues )){
426        my $params = $paramValues->[0] ;
427        $self->set_key_values($params);
428    }
429
430}
431
432
433sub set_key_values {
434    my ( $self, $params )= @_;   
435
436    foreach( keys %$params ) {
437        $self->{$_} = $params->{$_} ;
438    }
439}
440
441
442sub init_connection {
443    my ( $self ) = @_;
444
445    $self->connection_version('0.1');
446
447    my $stored = $self->retrieve_from_file(
448        $self->connection_file,
449        $self->connection_version
450    );
451
452    $self->connection(
453        $stored ?
454        Uploader::Connection->new(
455            $stored
456        ):
457        Uploader::Connection->new(
458            $self->default_connection
459        )
460    );
461
462}
463
464
465sub default_connection {
466    my ( $self ) = @_;
467
468    my $connection = {
469        version          => $self->connection_version,
470        storable_file    => $self->connection_file,
471    };
472
473    return $connection;
474}
475
476my $locale;
477sub init_locale {
478    my ( $self, $language ) = @_;
479
480    $self->languages(
481      [
482             ["中文 (%s)", wxLANGUAGE_CHINESE_SIMPLIFIED, 'Chinese simplified'],   
483             ["Česky (%s)", wxLANGUAGE_CZECH, 'Czech'],   
484             ["Dansk (%s)", wxLANGUAGE_DANISH, 'Danish'],   
485             ["Deutsch (%s)", wxLANGUAGE_GERMAN, 'German'],   
486             ["English (%s)", wxLANGUAGE_ENGLISH, 'English'],   
487             ["Español (%s)", wxLANGUAGE_SPANISH, 'Spanish'],   
488             ["Français (%s)", wxLANGUAGE_FRENCH, 'French'],   
489             ["Italiano (%s)", wxLANGUAGE_ITALIAN, 'Italian'],   
490             ["日本語 (にほんご) (%s)", wxLANGUAGE_JAPANESE, 'Japanese'],   
491             ["Magyar (%s)", wxLANGUAGE_HUNGARIAN, 'Hungarian'],
492             ["Nederlands (%s)", wxLANGUAGE_DUTCH, 'Dutch'],   
493             ["Polski (%s)", wxLANGUAGE_POLISH, 'Polish'],   
494             ["Português Brasileiro (%s)", wxLANGUAGE_PORTUGUESE_BRAZILIAN, 'Portuguese Brazil'],   
495             ["Português Portugal (%s)", wxLANGUAGE_PORTUGUESE, 'Portuguese Portugal'],   
496             ["Русский (%s)", wxLANGUAGE_RUSSIAN, 'Russian'],
497             ["Slovenčina (%s)", wxLANGUAGE_SLOVAK, 'Slovak'],
498      ]
499    );
500    # some languages may be unavailable due to system configuration.
501    $self->filter_available_languages;
502
503    $self->current_language(
504        $language||$self->{current_language}||Wx::Locale::GetSystemLanguage()
505    );
506
507    undef $locale;
508    $locale = Wx::Locale->new(
509        $self->current_language
510    );
511    $locale->AddCatalogLookupPathPrefix(
512        File::Spec->catfile($self->root_dir, $self->locale_dir)
513    );
514    if(!$locale->AddCatalog( 'pLoader.mo' )){
515        Wx::LogMessage gettext("Cannot find translation catalog files for %s. Use default language"), $locale->GetCanonicalName();
516    }
517    $self->locale($locale);   
518}
519
520
521sub filter_available_languages {
522    my ( $self ) = @_;
523
524    # check if the locale can be set and the translation catalog available
525    $self->available_languages(
526        [
527            grep {$_} 
528            map{
529                #  a locale may be unavailable due to system limitations ( ex: chinese, japanese when language pack are not installed )
530                if(Wx::Locale::IsAvailable($_->[1])){
531                    my $locale = Wx::Locale->new($_->[1]);
532                    $locale->AddCatalogLookupPathPrefix(
533                        File::Spec->catfile($self->root_dir, $self->locale_dir)
534                    );
535                    $_ if $locale->AddCatalog('pLoader');
536                }
537            }
538            @{$self->languages}
539        ]
540    );
541}
542
543
544sub init_localized_properties {
545    my ( $self ) = @_;
546
547    $self->colors(
548        ['Black', 'White']
549    );
550
551    # We need to translate back to english when we store properties
552    $self->eng_colors(
553        {
554            map { gettext($_) => $_ } @{$self->colors} 
555        }
556    );
557
558    $self->positions(
559        [
560            'Top',
561            'Left',
562            'Right',
563            'Bottom',
564            'Top left',
565            'Top right',
566            'Bottom left',
567            'Bottom right',
568            'Center',
569        ]
570    );
571
572    $self->eng_positions(
573        { 
574             map { gettext($_) => $_ } @{$self->positions} 
575        }
576    );
577
578    $self->upload_hd(
579        [
580            'No',
581            'Yes, use HD resized of the original photo',
582            'Yes, use a copy of the original photo',
583        ]
584    );
585
586    $self->eng_upload_hd(
587        {
588             map { gettext($_) => $_ } @{$self->upload_hd} 
589        }
590    );
591   
592
593    $self->caption_patterns(
594        [
595             'None',
596             'File name',
597             'File path and name',
598             'Caption',
599             'Caption + rank number',
600             'Rank number + caption',
601             'Caption + create date chrono',
602             'Create date chrono + caption',
603             'Create date chrono + rank',
604             'Rank + create date chrono',
605        ]
606    );
607
608    $self->eng_caption_patterns(
609        {
610             map { gettext($_) => $_ } @{$self->caption_patterns} 
611        }
612    );
613   
614    # hard coded because the piwigo api to read custom privacy level is not yet available
615    $self->privacy_level(
616        [
617            'everybody',
618            'contacts',
619            'friends',
620            'family',
621            'admins'
622        ]
623    );
624
625}
626
627
628# display privacy level list in a pyramid way :
629# ['everybody', 'contacts', friends, family, admins] -> [everybody, 'contacts, friends, family, admins', 'friends, family, admins', 'family, admins', 'admins only' ]
630sub privacy_level_choices{
631    my ( $self ) = @_;
632
633    my $pl = $self->privacy_level;   
634    my $n = scalar @$pl - 1;
635    my $list = [ gettext($pl->[0]) ];
636    my $i=0;
637    while(++$i<$n){   
638        push @$list, join(
639            ', ', 
640            map{ gettext($_) }
641            @$pl[$i..$n] 
642        );
643    }
644    push @$list, gettext($pl->[$n]);
645   
646    $list;
647}
648
649
650sub init_preferences {
651    my ( $self ) = @_;   
652
653    $self->preferences_version('0.1');
654
655    my $stored = $self->retrieve_from_file(
656        $self->preferences_file,
657        $self->preferences_version
658    );
659
660    $self->preferences(
661        $stored ?
662        Uploader::Preferences->new(
663            $stored
664        ):
665        Uploader::Preferences->new(
666            $self->default_preferences
667        )
668    );
669}
670
671
672sub retrieve_from_file {
673    my ( $self, $file, $version ) = @_;
674
675
676    my $stored;
677   
678    if( -e $file ){
679        eval {
680            $stored = retrieve $file;
681        };
682        if($@){
683            warn(
684                "An error has occured. Can not read %s\n%s",
685                $file, 
686                $@
687            );
688            undef $stored;
689        }
690        # should have a valid images
691        else{
692            undef $stored unless $version eq $stored->{version};
693        }
694    }
695
696    $stored;
697}
698
699
700sub default_preferences {
701    my ( $self ) = @_ ;
702
703    # must be read in a ini file
704    $self->user_def_preferences(
705        {}
706    );
707
708    my $preferences = {
709        version => $self->preferences_version,
710        storable_file    => $self->preferences_file,
711        hd_filter        => $self->user_def_preferences->{hd_filter}||'Lanczos',
712        hd_blur          => $self->user_def_preferences->{hd_blur}||0.9,
713        hd_quality       => $self->user_def_preferences->{hd_quality}||95,
714        hd_w             => $self->user_def_preferences->{hd_w}||1600,
715        hd_h             => $self->user_def_preferences->{hd_h}||1200,
716        hd_interlace     => $self->user_def_preferences->{hd_interlace}||'Line',
717        thumb_size       => $self->user_def_preferences->{thumbnail_size}||120,
718        wx_thumb_size    => $self->user_def_preferences->{wx_thumbnail_size}||100,
719        resize_w         => $self->user_def_preferences->{resize_w}||800,
720        resize_h         => $self->user_def_preferences->{resize_h}||600,
721        type             => 'jpg',
722        filter           => $self->user_def_preferences->{resize_filter}||'Lanczos',
723        blur             => $self->user_def_preferences->{resize_blur}||0.9,
724        quality          => $self->user_def_preferences->{resize_quality}||95,
725        wx_quality       => $self->user_def_preferences->{wx_thumbnail_quality}||90,
726        th_quality       => $self->user_def_preferences->{thumbnail_quality}||90,
727        auto_rotate      => $self->user_def_preferences->{auto_rotate}||1,
728        upload_hd        => $self->user_def_preferences->{upload_hd}||'No',
729        remove_uploaded_from_selection => $self->user_def_preferences->{remove_uploaded_from_selection}||1,
730        interlace        => $self->user_def_preferences->{resize_interlace}||'Line',
731        create_resized   => $self->user_def_preferences->{create_resized}||1,
732        prefix           => 'TN',
733        default_caption_pattern => $self->user_def_preferences->{default_caption_pattern}||'File name',
734        default_caption  => $self->user_def_preferences->{default_caption}||gettext('Photo '),
735        watermark_text => $self->user_def_preferences->{watermark_text}||gettext("my watermark"),
736        watermark_text_size => $self->user_def_preferences->{watermark_text_size}||12,
737        watermark_position => $self->user_def_preferences->{watermark_position}||'Center',
738        watermark_y => $self->user_def_preferences->{watermark_y}||10,
739        watermark_x => $self->user_def_preferences->{watermark_x}||10,
740        watermark_color => $self->user_def_preferences->{watermark_color}||'White',
741        reupload_action_files => 1,
742        reupload_action_properties => 2,
743        reupload_action_properties_m => 1,
744        display_mode => $self->user_def_preferences->{display_mode}||'Thumbnail and caption',
745        chunk_size   => $self->user_def_preferences->{chunk_size}||500000,
746    };
747
748    return $preferences;
749}
750
751
752sub init_resize_manager {
753    my ( $self ) = @_;
754
755    $self->resize_start_event(
756        Wx::NewEventType
757    );
758
759    $self->resize_manager(
760        Uploader::ResizeManager->new({
761            site_thumb_dir   => $self->thumb_dir,
762            wx_thumb_dir     => $self->wx_thumb_dir,
763            site_resized_dir => $self->resized_dir,
764            preferences      => sub { $self->preferences(@_) },
765            write_type       => 'jpg',
766        })
767    );
768
769    $self->init_resize_thread_queue;
770    $self->init_resize_done_event_handler;
771    $self->init_resize_progress_event_handler;
772}
773
774
775sub init_resize_thread_queue {
776    my ( $self ) = @_;
777
778    $self->resize_thread_queue(
779        Thread::Queue->new()
780    );
781
782    # resize worker starts when receiving data from the resize queue
783    # resize data must be sent to the calling $handler because $handler data
784    # cannot be updated inside the thread
785    $self->resize_thread(
786        $self->new_resize_thread
787    );
788
789}
790
791
792sub new_resize_thread {
793    my ( $self ) = @_;
794
795    threads->create( 
796        sub { 
797            my ( $handler, $resize_manager, $queue ) = @_;
798            while (my $data = $queue->dequeue ) {
799               
800                return 1 if 'STOP' eq $data;
801                if('CANCEL' eq $data){
802                    # remove pending
803                    while($queue->pending){
804                        # must check if valid $image hash
805                        $resize_manager->cancel_image(
806                            $queue->dequeue
807                        );
808                    }
809                }
810                else{
811                    $resize_manager->process_image(
812                        $handler,
813                        $resize_progress_event,
814                        $resize_done_event,
815                        $data
816                    );
817                }
818            }
819            printf("resize queue %s\n", $queue->pending);
820        },
821        $self,
822        $self->resize_manager,
823        $self->resize_thread_queue
824    );
825
826}
827
828
829sub init_resize_done_event_handler {
830    my ( $self ) = @_;
831
832    Wx::Event::EVT_COMMAND(
833        $self,
834        -1,
835        $resize_done_event,
836        sub {
837            my ( $handler, $event ) = @_;
838            my $data : shared = shared_clone($event->GetData);
839            $handler->on_image_progress($data);
840            # image is prepared, send to transfer queue
841            $self->transfer_thread_queue->enqueue($data);
842        } 
843    );
844
845}
846
847
848sub init_resize_progress_event_handler {
849    my ( $self ) = @_;
850
851    Wx::Event::EVT_COMMAND(
852        $self,
853        -1,
854        $resize_progress_event,
855        sub {
856            my ( $handler, $event ) = @_;
857            my $data : shared = shared_clone($event->GetData);
858            $handler->on_image_progress($data);
859        } 
860    );
861
862}
863
864
865sub on_image_progress {
866    my ( $self, $image ) = @_;
867
868    Wx::PostEvent(
869        $self->frame,
870        Wx::PlThreadEvent->new(
871            -1,
872            $self->image_progress_event,
873            $image
874        )
875    );
876}
877
878
879sub init_images {
880    my ( $self ) = @_;
881
882    $self->images_version('0.1');
883
884    my $stored = $self->retrieve_from_file(
885        $self->images_file,
886        $self->images_version,
887    );
888
889    $self->images(
890        $stored ?
891        Uploader::Images->new(
892            $stored
893        ):
894        Uploader::Images->new(
895            {
896                storable_file => $self->images_file,
897                version       => $self->images_version,
898            }
899        )
900    );
901
902    $self->images->eng_caption_patterns(
903        $self->eng_caption_patterns
904    );
905
906    $self->images->create_wx_thumbnail_cbk(
907        sub { $self->resize_manager->create_wx_thumbnail(@_) }
908    );
909
910    $self->images->default_caption_cbk(
911        sub { $self->preferences->default_caption(@_) }
912    );
913
914    $self->images->default_caption_pattern_cbk(
915        sub { $self->preferences->default_caption_pattern(@_) }
916    );
917
918    $self->images->set_current_image(-1);
919}
920
921
922sub is_single_instance_server {
923    my ( $self ) = @_;
924
925    if($self->is_single_instance_running){
926        printf("connect_to_single_instance_server\n");
927        $self->connect_to_single_instance_server;
928        printf("connected to single_instance_server\n");
929        return 0;
930    }
931    else{
932        printf("start_single_instance_server\n");
933        $self->start_single_instance_server;
934        printf("single_instance_server started\n");
935        return 1;
936    }
937}
938
939
940sub is_single_instance_running {
941    my ( $self ) = @_;
942
943    $self->{_instance_checker}->IsAnotherRunning;
944} 
945
946
947my $single_instance_port = 9101;
948
949
950sub connect_to_single_instance_server {
951    my ( $self ) = @_;
952
953    my $socket = IO::Socket::INET->new(
954        PeerAddr => '127.0.0.1',
955        PeerPort => $single_instance_port,
956        Proto    => 'tcp',
957        Type     => IO::Socket::SOCK_STREAM(),
958    );
959
960    # if connection successful, server sends pid
961    if ($socket) {
962        my $pid = '';
963        my $read = $socket->sysread( $pid, 10 );
964        if ( defined $read and $read == 10 ) {
965            my $files = join(',', @{$self->argv});
966            printf("send to server %s\n", $files);
967            $socket->print("open $files\n");
968            #$socket->print("focus\n");
969            $socket->close;
970            return 0;
971        }
972    }
973}
974
975
976sub start_single_instance_server {
977    my ( $self ) =@_;
978
979    $self->{_single_instance_server} = Wx::SocketServer->new(
980        '127.0.0.1' => $single_instance_port,
981        Wx::wxSOCKET_NOWAIT Wx::wxSOCKET_REUSEADDR,
982    );
983
984    if( $self->{_single_instance_server}->Ok ) {
985        Wx::Event::EVT_SOCKET_CONNECTION(
986            $self,
987            $self->{_single_instance_server},
988            sub {
989                $self->single_instance_connect( $_[0] );
990            }
991        );
992    }
993    else {
994        delete $self->{_single_instance_server};
995        warn( Wx::gettext("Failed to create single instance server") );
996    }
997
998    return 1;
999
1000}
1001
1002
1003sub single_instance_connect {
1004    my $self   = shift;
1005    my $server = shift;
1006    my $client = $server->Accept(0);
1007
1008    # Before we start accepting input,
1009    # send the client our process ID.
1010    $client->Write( sprintf( '% 10s', $$ ), 10 );
1011
1012    # Set up the socket hooks
1013    Wx::Event::EVT_SOCKET_INPUT(
1014        $self, $client,
1015        sub {
1016
1017            # Accept the data and stream commands
1018            my $command = '';
1019            my $buffer  = '';
1020            while ( $_[0]->Read( $buffer, 128 ) ) {
1021                $command .= $buffer;
1022                while ( $command =~ s/^(.*?)[\012\015]+//s ) {
1023                    $_[1]->single_instance_command( "$1", $_[0] );
1024                }
1025            }
1026            return 1;
1027        }
1028    );
1029    Wx::Event::EVT_SOCKET_LOST(
1030        $self, $client,
1031        sub {
1032            $_[0]->Destroy;
1033        }
1034    );
1035
1036    return 1;
1037}
1038
1039sub single_instance_command {
1040    my( $self, $line, $socket ) = @_;
1041
1042    return 1 unless defined $line && length $line;
1043
1044    # ignore the line if command isn't plain ascii
1045    return 1 unless $line =~ s/^(\S+)\s*//s;
1046
1047    if ( $1 eq 'open' ) {
1048        if ( -f $line ) {
1049            printf("received from incoming connection %s\n", $line);
1050            $self->images->add_images(
1051                [
1052                    grep { -f $_} split(/,/, $line)
1053                ]
1054            );
1055        }
1056    } 
1057    else {
1058        warn("Unsupported command '$1'");
1059    }
1060
1061    return 1;
1062}
1063
1064
1065sub stop_single_instance_server {
1066    my ( $self ) =@_;
1067
1068    if(exists $self->{_single_instance_server}){
1069        $self->{_single_instance_server}->Destroy;
1070        delete $self->{_single_instance_server};
1071    }
1072}
1073
1074
1075sub default_app {
1076    my ( $self ) = @_ ;
1077
1078    my $app = {
1079        site_thumb_dir   => $self->thumb_dir,
1080        wx_thumb_dir     => $self->wx_thumb_dir,
1081        site_resized_dir => $self->resized_dir,
1082        userdata_dir     => $self->userdata_dir,
1083        version          => $self->version,
1084        storable_file    => $self->app_file,
1085
1086    };
1087
1088    $app;
1089}
1090
1091
1092sub connect_or_exit {
1093    my ( $self ) = @_;
1094
1095
1096    my $not_exit = $self->login();
1097    $self->connection->Store;
1098    # user pressed OK
1099    if($not_exit){
1100        if( $self->use_connected ){
1101            while( $not_exit and $self->not_connected ){
1102                $not_exit = $self->login;
1103                last if $self->use_offline;
1104            }
1105            $self->init_transfer_manager;
1106        }
1107    }
1108    else {
1109        $self->stop_resize_manager;
1110        $self->stop_single_instance_server;
1111    }
1112
1113    $not_exit;
1114}
1115
1116
1117sub login {
1118    my ( $self ) = @_;   
1119
1120    $self->init_connection;
1121
1122    $self->login_dlg( 
1123        Uploader::GUI::LoginDlg->new(
1124            {
1125                title         => gettext("Piwigo login"),
1126                site_url      => sub { $self->connection->site_url(@_) },
1127                site_username => sub { $self->connection->site_username(@_) },   
1128                site_password => sub { $self->connection->site_password(@_) },
1129                use_offline   => sub { $self->connection->use_offline(@_) },   
1130            }
1131        )
1132    ) unless $self->login_dlg;
1133
1134    my $icon = Wx::Icon->new();
1135    $icon->LoadFile(
1136        $self->resource_path('favicon.ico'), 
1137        wxBITMAP_TYPE_ICO
1138    );
1139
1140    $self->login_dlg->SetIcon($icon);
1141
1142   
1143    my $rval = $self->login_dlg->ShowModal();
1144    $self->login_dlg->Show(0);
1145
1146    $self->init_branding;
1147   
1148    if ($self->connection->site_url !~ /^http:/){
1149        $self->connection->site_url(
1150            sprintf(
1151                "http://%s",
1152                $self->connection->site_url
1153            )
1154        );   
1155    }
1156
1157    $self->pwg(
1158        # get these parameters from dialog or from file
1159        Uploader::PWG->new(
1160            {
1161                site_url       => $self->connection->site_url,
1162                site_username  => $self->connection->site_username,
1163                site_password  => $self->connection->site_password,
1164                http_username  => $self->connection->http_username,
1165                http_password  => $self->connection->http_password,
1166                branding       => $self->branding,
1167                use_offline    => $self->use_offline,
1168                version        => $self->version,
1169            }
1170        )
1171    );
1172
1173    $rval;
1174}
1175
1176
1177# helper method to get the full path for a resource
1178sub resource_path{
1179    my ( $self, $file ) = @_;
1180
1181    File::Spec->catfile($self->root_dir, $self->resource_dir, $file);
1182}
1183
1184sub bin_path{
1185    my ( $self, $file ) = @_;
1186
1187    File::Spec->catfile($self->root_dir, $self->bin_dir, $file);
1188}
1189
1190sub locale_path{
1191    my ( $self, $file ) = @_;
1192
1193    File::Spec->catfile($self->root_dir, $self->locale_dir, $file);
1194}
1195
1196sub locale_catalog_path{
1197    my ( $self, $file ) = @_;
1198
1199    File::Spec->catfile($self->root_dir, $self->locale_dir, $self->locale->GetCanonicalName, $file);
1200}
1201
1202
1203# some labels differ with branding ( piwigo.com or piwigo.org )
1204sub init_branding {
1205    my ( $self ) =@_;
1206   
1207    if( $self->connection->site_url =~ /\.piwigo\.com/ ){
1208        $self->branding(
1209            {
1210                category  => gettext("album"),
1211                Category  => gettext("Album"),
1212                categories => gettext("albums"),
1213                Categories => gettext("Albums"),
1214                'Add new category' => gettext("Add new album"),
1215                'Category name' => gettext("Album name :"),
1216                'New category' => gettext("New album"),
1217                'What is the destination category?' => gettext("What is the destination album?")
1218            }
1219        );
1220    }
1221    else{
1222        $self->branding(
1223            {
1224                category  => gettext("categorie"),   
1225                Category  => gettext("Categorie"),   
1226                categories => gettext("categories"),   
1227                Categories => gettext("Categories"),   
1228                'Add new category' => gettext("Add new category"),
1229                'Category name' => gettext("Category name :"),
1230                'New category' => gettext("New category"),
1231                'What is the destination category?' => gettext("What is the destination category?")
1232            }
1233        );
1234    }   
1235}
1236
1237
1238sub use_connected {
1239    my ( $self ) = @_;
1240
1241    !$self->use_offline
1242}
1243
1244
1245sub not_connected {
1246    my ( $self ) = @_;
1247
1248    !$self->is_connected;
1249}
1250
1251
1252sub is_connected {
1253    my ( $self ) = @_;
1254
1255    my $_is_connected;
1256
1257    if($self->pwg->login_result->{stat} eq 'ok'){
1258        $_is_connected = 1;
1259    }
1260    else{
1261        Wx::MessageBox( 
1262            sprintf(
1263                "%s\n\n%s %s %s",
1264                $self->pwg->login_result->{message},
1265                gettext("Connection to"),
1266                $self->connection->site_url,
1267                gettext("failed"),
1268            ),
1269            gettext("Piwigo login error"),
1270            wxOK | wxICON_EXCLAMATION, 
1271        );
1272    }
1273   
1274    $_is_connected;
1275}
1276
1277
1278sub init_transfer_manager {
1279    my ( $self ) = @_;
1280
1281    $self->check_upload;
1282
1283    $self->transfer_manager(
1284        Uploader::TransferManager->new({
1285            site_thumb_dir   => $self->thumb_dir,
1286            site_resized_dir => $self->resized_dir,
1287            pwg              => $self->pwg,
1288        })
1289    );
1290
1291    $self->image_progress_event(
1292        $image_progress_event
1293    );
1294    $self->init_transfer_thread_queue;
1295    $self->init_transfer_done_event_handler;
1296    $self->init_transfer_progress_event_handler;
1297
1298}
1299
1300
1301sub check_upload {
1302    my ( $self ) = @_;
1303
1304    my $err_msg = $self->pwg->check_upload;
1305
1306    $err_msg = gettext("Your user account is not granted to upload photos") if
1307        'Access denied' eq $err_msg;
1308
1309    #Wx::LogMessage("%s", $err_msg) if $err_msg;
1310    Wx::MessageBox($err_msg, "", wxOK | wxICON_ERROR) if $err_msg;
1311
1312    $err_msg;
1313}
1314
1315
1316sub init_transfer_thread_queue {
1317    my ( $self ) = @_;
1318
1319    $self->transfer_thread_queue(
1320        Thread::Queue->new()
1321    );
1322
1323    # transfer worker starts when receiving data from the queue
1324    # transfer data must be sent to the calling $handler because $handler data
1325    # cannot be updated inside the thread
1326    $self->transfer_thread(
1327        $self->new_transfer_thread
1328    );
1329
1330}
1331
1332
1333sub new_transfer_thread {
1334    my ( $self ) = @_;
1335
1336    threads->create( 
1337        sub {
1338            my ( $handler, $transfer_manager, $queue ) = @_;
1339            while (my $data = $queue->dequeue ) {
1340                return 1 if 'STOP' eq $data;
1341                if('CANCEL' eq $data){
1342                    while($queue->pending){
1343                        $transfer_manager->cancel_image(
1344                            $queue->dequeue
1345                        );
1346                    }
1347                }
1348                else{
1349                    $transfer_manager->process_image(
1350                        $handler,
1351                        $transfer_progress_event,
1352                        $transfer_done_event,
1353                        $data
1354                    );
1355                }
1356            }
1357            printf("transfer queue %s\n", $queue->pending);
1358        },
1359        $self,
1360        $self->transfer_manager,
1361        $self->transfer_thread_queue
1362    );
1363
1364}
1365
1366
1367sub init_transfer_done_event_handler {
1368    my ( $self ) = @_;
1369
1370    Wx::Event::EVT_COMMAND(
1371        $self,
1372        -1,
1373        $transfer_done_event,
1374        sub {
1375            my ( $handler, $event ) = @_;
1376            my $data = $event->GetData;
1377            $handler->on_image_progress($data);
1378        } 
1379    );
1380
1381}
1382
1383
1384sub init_transfer_progress_event_handler {
1385    my ( $self ) = @_;
1386
1387    Wx::Event::EVT_COMMAND(
1388        $self,
1389        -1,
1390        $transfer_progress_event,
1391        sub {
1392            my ( $handler, $event ) = @_;
1393            my $data : shared = shared_clone($event->GetData);
1394            $handler->on_image_progress($data);
1395        } 
1396    );
1397
1398}
1399
1400
1401sub start_transfer {
1402    my( $self, $images ) = @_;
1403   
1404    my $data : shared = shared_clone($images);
1405
1406    $self->transfer_thread_queue->enqueue($data);
1407}
1408
1409
1410sub start_resize {
1411    my( $self, $all_images ) = @_;
1412
1413    # we need to copy data from object to use another thread
1414    my $images = $self->images->get_images(
1415        $self->preferences->get_data,
1416        $self->transfer_manager->destination_category,
1417        $all_images
1418    );
1419    printf("resize thread %s\n", $self->resize_thread);
1420    $self->resize_thread_queue->enqueue(
1421        map { shared_clone($_) }@$images
1422    );
1423
1424    Wx::PostEvent(
1425        $self->frame,
1426        Wx::PlThreadEvent->new(
1427            -1,
1428            $self->resize_start_event,
1429            shared_clone($images)
1430        )
1431    );
1432
1433    $images;
1434}
1435
1436
1437sub stop_resize {
1438    my( $self ) = @_;
1439   
1440    my $data : shared = "STOP";
1441
1442    $self->resize_thread_queue->insert(0,$data);
1443}
1444
1445
1446sub cancel_resize {
1447    my( $self ) = @_;
1448   
1449    my $data : shared = "CANCEL";
1450
1451    #
1452    if( $self->resize_thread_queue->pending and wxYES == Wx::MessageBox( 
1453        sprintf(
1454            "Cancel %s pending job(s) ?",
1455            $self->resize_thread_queue->pending,
1456        ),
1457        "pLoader job processing",
1458        wxYES_NO|wxNO_DEFAULT| wxICON_QUESTION, ) 
1459    ){
1460        $self->resize_thread_queue->insert(0,$data);
1461    }
1462}
1463
1464
1465sub SetFrame {
1466    my ( $self, $frame ) = @_;   
1467
1468    my $url = $self->connection->site_url;
1469   
1470    if($self->use_offline){
1471        $url = gettext("Work Offline");
1472    }
1473
1474    $self->frame($frame);
1475
1476    my $icon = Wx::Icon->new();
1477    $icon->LoadFile(
1478        File::Spec->catfile(
1479            $self->root_dir, $self->resource_dir, 'favicon.ico'
1480        ), 
1481        wxBITMAP_TYPE_ICO
1482    );
1483    $self->frame->SetIcon($icon);
1484}
1485
1486
1487sub GetWxBitmapType {
1488    my ( $self, $type ) = @_;
1489   
1490    $self->{IMGTYPE}->{$type};
1491}
1492
14931;
Note: See TracBrowser for help on using the repository browser.