source: extensions/pLoader/trunk/src/Uploader/GUI/wxApp.pm @ 4422

Revision 4422, 23.0 KB checked in by ronosman, 10 years ago (diff)

Feature 1055 added : preparation of high definition images ( HD ).

  • Property svn:eol-style set to LF
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::GUI::wxApp;
21use strict;
22use base qw/Wx::App Class::Accessor::Fast/;   
23use Wx qw/
24             wxBITMAP_TYPE_GIF
25             wxBITMAP_TYPE_ICO
26             wxBITMAP_TYPE_BMP
27             wxBITMAP_TYPE_PNG
28             wxBITMAP_TYPE_JPEG
29             wxIMAGE_QUALITY_NORMAL
30             wxIMAGE_QUALITY_HIGH
31             wxSPLASH_CENTRE_ON_SCREEN
32             wxSPLASH_TIMEOUT
33             wxDefaultPosition
34             wxDefaultSize
35             wxSIMPLE_BORDER
36             wxFRAME_TOOL_WINDOW
37             wxFRAME_NO_TASKBAR wxSTAY_ON_TOP
38             wxWHITE
39             wxICON_EXCLAMATION
40             wxOK
41             wxLANGUAGE_CHINESE_SIMPLIFIED   
42             wxLANGUAGE_CZECH   
43             wxLANGUAGE_DANISH   
44             wxLANGUAGE_DUTCH   
45             wxLANGUAGE_ENGLISH   
46             wxLANGUAGE_FRENCH   
47             wxLANGUAGE_GERMAN   
48             wxLANGUAGE_HUNGARIAN
49             wxLANGUAGE_ITALIAN   
50             wxLANGUAGE_JAPANESE   
51             wxLANGUAGE_POLISH   
52             wxLANGUAGE_PORTUGUESE   
53             wxLANGUAGE_PORTUGUESE_BRAZILIAN   
54             wxLANGUAGE_RUSSIAN   
55             wxLANGUAGE_SLOVAK   
56             wxLANGUAGE_SPANISH   
57         /;
58use Uploader::GUI::wxFrameAUI;
59use File::Slurp ;
60use Data::Dumper;
61use Storable;
62use File::HomeDir;
63use File::Spec;
64use Uploader::PWG;
65use Uploader::ImageList;
66use Uploader::GUI::wxLoginDlg;
67use Wx::Locale qw/:default/;
68use utf8;
69
70$|=1;
71
72__PACKAGE__->mk_accessors( 
73    qw/
74          pwg
75          site_url
76          site_username
77          site_password
78          http_username
79          http_password
80          rejects
81          imagelist
82          storable_file
83          wx_thumb_dir
84          resized_dir
85          userdata_dir
86          resized_dir
87          thumb_dir
88          conf_file
89          layout_file
90          locale
91          current_language
92          languages
93          available_languages
94          version
95          imagelist_version
96          use_offline
97          login_dlg
98          branding
99          frame
100          perspective
101          imageviewerIndex
102          frameLayout
103          chunk_size
104          layout_clean
105          colors
106          eng_colors
107          positions
108          eng_positions
109          default_photo_names
110          eng_default_photo_names
111                  upload_hd
112                  eng_upload_hd
113      / 
114);
115
116sub FilterEvent {
117    my( $self, $event ) = @_;
118   
119    Wx::LogMessage "EventType %s", $event->GetEventType();
120   
121    return -1;
122}
123
124
125sub OnInit {
126    my( $self ) = @_;
127   
128    $self->version(
129        '2.0.5C'
130    );
131   
132    # to check if we can use stored cache
133    $self->imagelist_version(
134        '9'
135    );
136
137    $self->languages(
138      [
139             ["中文 (%s)", wxLANGUAGE_CHINESE_SIMPLIFIED, 'Chinese simplified'],   
140             ["Česky (%s)", wxLANGUAGE_CZECH, 'Czech'],   
141             ["Dansk (%s)", wxLANGUAGE_DANISH, 'Danish'],   
142             ["Deutsch (%s)", wxLANGUAGE_GERMAN, 'German'],   
143             ["English (%s)", wxLANGUAGE_ENGLISH, 'English'],   
144             ["Español (%s)", wxLANGUAGE_SPANISH, 'Spanish'],   
145             ["Français (%s)", wxLANGUAGE_FRENCH, 'French'],   
146             ["Italiano (%s)", wxLANGUAGE_ITALIAN, 'Italian'],   
147             ["日本語 (にほんご) (%s)", wxLANGUAGE_JAPANESE, 'Japanese'],   
148             ["Magyar (%s)", wxLANGUAGE_HUNGARIAN, 'Hungarian'],
149             ["Nederlands (%s)", wxLANGUAGE_DUTCH, 'Dutch'],   
150             ["Polski (%s)", wxLANGUAGE_POLISH, 'Polish'],   
151             ["Português Brasileiro (%s)", wxLANGUAGE_PORTUGUESE_BRAZILIAN, 'Portuguese Brazil'],   
152             ["Português Portugal (%s)", wxLANGUAGE_PORTUGUESE, 'Portuguese Portugal'],   
153             ["Русский (%s)", wxLANGUAGE_RUSSIAN, 'Russian'],
154             ["Slovenčina (%s)", wxLANGUAGE_SLOVAK, 'Slovak'],
155      ]
156    );
157    # some languages may be unavailable due to system configuration.
158    $self->_filter_available_languages;
159    Wx::InitAllImageHandlers();
160    my $applicationName = "pLoader" ;
161    $self->SetAppName( $applicationName );
162    $self->SetVendorName( "Piwigo Team" );
163
164    $self->{IMGTYPE} = {
165        'jpg' => wxBITMAP_TYPE_JPEG,
166        'gif' => wxBITMAP_TYPE_GIF,
167        'png' => wxBITMAP_TYPE_PNG,
168    };
169
170    $self->_init_userdir;
171
172    my $conf = retrieve $self->conf_file if -e $self->conf_file;       
173
174    if(defined $conf ){
175        $self->SetKeyValues($conf);
176    }
177    else {
178        $self->_readParams( 'pLoader.ini' ) unless defined $conf ;
179    }
180
181    # when language is switched, need a new layout
182    unlink $self->layout_file if $self->layout_clean;
183    $self->layout_clean(0);
184
185    my $layout = retrieve $self->layout_file if -e $self->layout_file; 
186    if(defined $layout ){
187        $self->SetKeyValues($layout);
188    }
189
190
191    $self->site_url(
192        $self->{site_url}
193    );
194   
195
196    $self->site_username(
197        $self->{site_username}
198    );
199    $self->site_password(
200        $self->{site_password}
201    );
202
203    $self->http_username(
204        $self->{http_username}
205    );
206    $self->http_password(
207        $self->{http_password}
208    );
209
210
211    $self->current_language(
212        $self->{current_language}||Wx::Locale::GetSystemLanguage()
213    );
214
215    $self->chunk_size(
216        $self->{chunk_size}||500_000
217    );
218   
219    $self->init_locale;
220    $self->_init_localized_properties;
221
222    my $not_exit = $self->Login();
223    # user pressed OK
224    if($not_exit){
225        $self->StoreConnectionProperties;
226        if( !$self->use_offline ){
227            while( $not_exit and !$self->_is_connected ){
228                $not_exit = $self->Login();
229                last if $self->use_offline;
230            }
231        }
232        $self->_init_imagelist;
233        $self->_init_thumbimagelist;
234        $self->_init_frame;
235    }
236
237    $not_exit;
238}
239
240# some properties are displayed in choice list, with translated strings
241# the translation has to be reverted to store a language independant value
242sub _init_localized_properties {
243    my ( $self ) = @_;
244
245    $self->colors(
246        ['Black', 'White']
247    );
248    # We need to translate back to english when we store properties
249    $self->eng_colors(
250        {
251            map { gettext($_) => $_ } @{$self->colors} 
252        }
253    );
254    $self->positions(
255        [
256            'Top',
257            'Left',
258            'Right',
259            'Bottom',
260            'Top left',
261            'Top right',
262            'Bottom left',
263            'Bottom right',
264            'Center',
265        ]
266    );
267
268    $self->eng_positions(
269        { 
270             map { gettext($_) => $_ } @{$self->positions} 
271        }
272    );
273       
274        $self->upload_hd(
275            [
276                    'No',
277                        'Yes, use HD resized of the original photo',
278                        'Yes, use a copy of the original photo',
279                ]
280        );
281
282    $self->eng_upload_hd(
283        {
284             map { gettext($_) => $_ } @{$self->upload_hd} 
285        }
286    );
287       
288    $self->default_photo_names(
289        [
290             'None',
291             'File name',
292             'File path and name',
293             'Prefix',
294             'Prefix + rank number',
295             'Rank number + prefix',
296             'Prefix + create date chrono',
297             'Create date chrono + prefix',
298        ]
299    );
300    $self->eng_default_photo_names(
301        {
302             map { gettext($_) => $_ } @{$self->default_photo_names} 
303        }
304    );
305}
306
307sub _filter_available_languages {
308    my ( $self ) = @_;
309
310    # check if the locale can be set and the translation catalog available
311    $self->available_languages(
312        [
313            grep {$_} 
314            map{
315                            #  a locale may be unavailable due to system limitations ( ex: chinese, japanese when language pack are not installed )
316                            if(Wx::Locale::IsAvailable($_->[1])){
317                            my $locale = Wx::Locale->new($_->[1]);
318                            $locale->AddCatalogLookupPathPrefix('../locale');
319                            $_ if $locale->AddCatalog('pLoader');
320                                }
321            }
322            @{$self->languages}
323        ]
324    );
325}
326
327sub _is_connected {
328    my ( $self ) = @_;
329
330    my $is_connected;
331
332    if($self->pwg->login_result->{stat} eq 'ok'){
333        $is_connected = 1;
334    }
335    else{
336        Wx::MessageBox( 
337            sprintf(
338                "%s\n\n%s %s %s",
339                $self->pwg->login_result->{message},
340                gettext("Connection to"),
341                $self->site_url,
342                gettext("failed"),
343            ),
344            gettext("Piwigo login error"),
345            wxOK | wxICON_EXCLAMATION, 
346        );
347    }
348   
349    $is_connected;
350}
351
352
353my $locale;
354sub init_locale {
355    my ( $self, $language ) = @_;
356   
357    $self->current_language(
358        $language
359    ) if defined $language;
360
361    undef $locale;
362    $locale = Wx::Locale->new(
363        $self->current_language
364    );
365    $locale->AddCatalogLookupPathPrefix( '../locale');
366    if(!$locale->AddCatalog( 'pLoader.mo' )){
367        Wx::LogMessage gettext("Cannot find translation catalog files for %s. Use default language"), $locale->GetCanonicalName();
368    }
369    $self->locale($locale);     
370}
371
372sub StoreConnectionProperties {
373    my ( $self ) = @_;
374
375    eval {   
376        store( 
377            {
378                map{
379                   $_ => $self->{$_},
380                }
381                qw/
382                    site_url
383                    site_username
384                    site_password
385                    http_username
386                    http_password
387                    current_language
388                    chunk_size
389                    layout_clean
390                /
391            },
392            $self->conf_file
393        );
394    };
395}
396
397sub StoreLayoutProperties {
398    my ( $self ) = @_;
399
400    eval {   
401        store( 
402            {
403                map{
404                   $_ => $self->{$_},
405                }
406                qw/
407                      perspective
408                      imageviewerIndex
409                      frameLayout
410                /
411            },
412            $self->layout_file
413        );
414    };
415}
416
417sub _init_imagelist {
418    my ( $self ) = @_; 
419
420    my $stored_imagelist;
421   
422    my $use_new_imagelist;
423   
424    if( -e $self->storable_file ){
425        eval {
426            $stored_imagelist = retrieve $self->storable_file;
427        };
428        if($@){
429            Wx::LogMessage(
430                gettext("An error has occured. Can not read %s\n%s"),
431                $self->storable_file,
432                $@
433            );
434            $use_new_imagelist = 1 ;
435        }
436        # should have a valid imagelist
437        else{
438            $use_new_imagelist = 1 unless $self->imagelist_version eq $stored_imagelist->{imagelist_version};
439            if($use_new_imagelist){
440                Wx::LogMessage(gettext("pLoader has to reset image cache."));
441            }
442        }
443    }
444    else{
445        $use_new_imagelist = 1 ;
446    }
447
448    if($use_new_imagelist){
449        $stored_imagelist = $self->_default_imagelist_params ;
450    }
451
452
453    $self->imagelist(
454        Uploader::ImageList->new(
455            $stored_imagelist
456        )
457    );
458
459    $self->imagelist->RescaleCallback(
460        sub { $self->RescaleImage(@_) }
461    );
462
463    $self->imagelist->ResizeCallback(
464        sub { $self->ResizeImage(@_) }
465    );
466
467    $self->imagelist->YieldCallback(
468        sub { Wx::Yield }
469    );
470}
471
472
473sub _default_imagelist_params {
474    my ( $self ) = @_ ;
475
476    my $params = {
477        new_files        => [],
478        hd_filter        => 'Lanczos',
479        hd_blur          => 0.9,
480        hd_quality       => 95,
481        hd_w             => 1600,
482        hd_h             => 1200,
483        hd_interlace     => 'Line',
484        thumb_size       => 120,
485        site_thumb_dir   => $self->thumb_dir,
486        wx_thumb_size    => 100,
487        wx_thumb_dir     => $self->wx_thumb_dir,
488        resize_w         => 800,
489        resize_h         => 600,
490        site_resized_dir => $self->resized_dir,
491        type             => 'jpg',
492        filter           => 'Lanczos',
493        blur             => 0.9,
494        quality          => 95,
495        wx_quality       => 90,
496        th_quality       => 90,
497        auto_rotate      => 1,
498                upload_hd        => 'No',
499        remove_uploaded_from_selection => 1,
500        interlace        => 'Line',
501        create_resized   => 1,
502        prefix           => 'TN',
503        count            => 0,
504        storable_file    => $self->storable_file,
505        userdata_dir     => $self->userdata_dir,
506        default_photo_name => 'File name',
507        default_name_prefix => gettext('Photo '),
508        upload_rejects   =>  [],
509        image_sums       => {},
510        sums             => [],
511        version          => $self->version,
512        imagelist_version => $self->imagelist_version,
513        RescaleCallback  => sub { $self->RescaleImage(@_) },
514        ResizeCallback   => sub { $self->ResizeImage(@_) },
515        watermark_text => gettext("my watermark"),
516        watermark_text_size => 12,
517        watermark_position => 'Center',
518        watermark_y => 10,
519        watermark_x => 10,
520        watermark_color => 'White',
521    };
522
523    return $params;
524}
525
526sub Login {
527    my ( $self ) = @_; 
528
529    $self->login_dlg( 
530        Uploader::GUI::wxLoginDlg->new(
531            {
532                title         => gettext("Piwigo login"),
533                site_url      => sub { $self->site_url(@_) },
534                site_username => sub { $self->site_username(@_) },     
535                site_password => sub { $self->site_password(@_) },
536                use_offline   => sub { $self->use_offline(@_) },       
537            }
538        )
539    ) unless $self->login_dlg;
540
541    my $icon = Wx::Icon->new();
542    $icon->LoadFile('../res/favicon.ico', wxBITMAP_TYPE_ICO);
543    $self->login_dlg->SetIcon($icon);   
544
545   
546    my $rval = $self->login_dlg->ShowModal();
547    $self->login_dlg->Show(0);
548
549    $self->_init_branding;
550   
551    if ($self->site_url !~ /^http:/){
552        $self->site_url(
553            sprintf(
554                "http://%s",
555                $self->site_url
556            )
557        );     
558    }
559
560    $self->pwg(
561        # get these parameters from dialog or from file
562        Uploader::PWG->new(
563            {
564                site_url       => $self->site_url,
565                site_username  => $self->site_username,
566                site_password  => $self->site_password,
567                http_username  => $self->http_username,
568                http_password  => $self->http_password,
569                branding       => $self->branding,
570                chunk_size     => $self->chunk_size,
571                use_offline    => $self->use_offline,
572                version        => $self->version,
573            }
574        )
575    );
576
577    $rval;
578}
579
580sub _init_userdir {
581    my ( $self ) = @_;
582   
583    my $applicationName = $self->GetAppName ;
584    my $userdatadir = File::Spec->canonpath(
585        File::Spec->catfile(
586            File::HomeDir->my_data(), 
587            "\.$applicationName"
588        )
589    );
590
591    if(! -d $userdatadir){
592        if(! mkdir $userdatadir){
593            Wx::MessageBox( 
594                sprintf(
595                    "%s directory creation failed",
596                    $userdatadir,
597                ),
598                "pLoader working directory creation error",
599                wxOK | wxICON_EXCLAMATION, 
600            );
601
602            $userdatadir = File::Spec->canonpath(
603                File::Spec->catfile(
604                    File::Spec->tmpdir(), 
605                    "\.$applicationName"
606                )
607            );
608            mkdir $userdatadir;
609        }       
610    }
611
612    $self->userdata_dir($userdatadir);
613   
614    $self->conf_file(
615        File::Spec->catfile(
616            $self->userdata_dir, 
617            ".$applicationName.conf"
618        )
619    );
620
621    $self->layout_file(
622        File::Spec->catfile(
623            $self->userdata_dir, 
624            ".$applicationName.layout"
625        )
626    );
627
628    $self->storable_file(
629        File::Spec->catfile($self->userdata_dir, 'pLoader.dat')
630    );
631   
632    my $thumbdir = File::Spec->catfile($self->userdata_dir, 'thumbnails');
633    mkdir $thumbdir unless -d $thumbdir ;
634    $self->thumb_dir($thumbdir);
635
636    my $wxthumbdir = File::Spec->catfile($self->userdata_dir, 'wxthumbnails');
637    mkdir $wxthumbdir unless -d $wxthumbdir ;
638    $self->wx_thumb_dir($wxthumbdir);
639
640
641    my $resizedir = File::Spec->catfile($self->userdata_dir, 'resize');
642    mkdir $resizedir unless -d $resizedir ;
643    $self->resized_dir($resizedir);
644}
645
646sub _init_thumbimagelist {
647    my ( $self ) = @_;
648
649   
650    $self->imagelist->wx_thumb_imglist(
651        Wx::ImageList->new( 
652            $self->imagelist->wx_thumb_size, 
653            $self->imagelist->wx_thumb_size, 
654            1,
655            0
656        )
657    );
658   
659    # reload images
660    $self->_reload_thumb_images;
661}
662
663
664sub _reload_thumb_images {
665    my ( $self ) = @_;
666   
667    my $wximagelist = $self->imagelist->wx_thumb_imglist;
668    my $sums = $self->imagelist->sums;
669
670    map {
671        my $image = $self->imagelist->image_sums->{$_};
672
673        $wximagelist->Add(
674            Wx::Bitmap->new( 
675                $image->wx_thumb_file, 
676                $self->GetWxBitmapType($self->imagelist->type), 
677            )
678        );
679    }
680    @$sums ;
681
682}
683
684sub GetWxBitmapType {
685    my ( $self, $type ) = @_;
686   
687    $self->{IMGTYPE}->{$type};
688}
689
690
691sub RescaleImage {
692    my ( $self, $image_file, $image_file_out, $type, $ratio, $width, $height, $quality ) = @_;
693   
694
695    my $image = Wx::Image->new(
696            $image_file, 
697            $self->GetWxBitmapType($type),
698            0
699    );
700   
701    my $w;
702    my $h;
703
704    my $img_w = $image->GetWidth;
705    my $img_h = $image->GetHeight;
706   
707    # use a ratio ( 25% default ) if defined
708    # default ratio is used for preview.
709    if($ratio){
710        $w = $ratio*$img_w/100 ;
711        $h = $ratio*$img_h/100 ;
712    }
713    # use specified width and height
714    else{
715        # portrait
716        if( $img_w < $img_h ){
717            $w = $height;
718        }
719        else{
720            $w = $width;
721        }
722        # to respect aspect ratio
723        $h = sprintf(
724            "%.0f",
725            ($w*$img_h)/$img_w
726        );
727    }
728
729    $image->Rescale(
730        $w,
731        $h,
732        wxIMAGE_QUALITY_HIGH
733    );
734   
735    $quality ||= 90;
736   
737    $image->SetOption( 
738        "quality", 
739        $quality 
740    );
741   
742    if(!$image->SaveFile(
743        $image_file_out,
744        $self->GetWxBitmapType($type),
745    )){
746        Wx::LogMessage(
747            gettext("An error has occured. Can not save file %s"),
748            $image_file_out,
749        )
750    };
751}
752
753sub ResizeImage {
754    my ( $self, $image_file, $image_file_out, $type, $width, $height, $quality ) = @_;
755   
756
757    my $image = Wx::Image->new(
758            $image_file, 
759            $self->GetWxBitmapType($type),
760            0
761    );
762
763    my $w;
764    my $h;
765
766    my $img_w = $image->GetWidth;
767    my $img_h = $image->GetHeight;
768   
769        # portrait
770        if( $img_w < $img_h ){
771            $w = $height;
772        }
773        else{
774            $w = $width;
775        }
776        # to respect aspect ratio
777        $h = sprintf(
778            "%.0f",
779            ($w*$img_h)/$img_w
780        );
781
782   
783
784    $image->Rescale(
785        $w,
786        $h,
787        wxIMAGE_QUALITY_HIGH
788    );
789
790    $image->Resize(
791        [ $width, $height ], [ 0, 20],
792    );
793   
794    $quality ||= 90;
795   
796    $image->SetOption( 
797        "quality", 
798        $quality 
799    );
800   
801    if(!$image->SaveFile(
802        $image_file_out,
803        $self->GetWxBitmapType($type),
804    )){
805        Wx::LogMessage(
806            gettext("An error has occured. Can not save file %s"),
807            $image_file_out,
808        )
809    };
810}
811
812# some labels differ with branding ( piwigo.com or piwigo.org )
813sub _init_branding {
814    my ( $self ) =@_;
815   
816    if( $self->site_url =~ /\.piwigo\.com/ ){
817        $self->branding(
818            {
819                category  => gettext("album"), 
820                Category  => gettext("Album"), 
821                categories => gettext("albums"),       
822                Categories => gettext("Albums"),
823                'Add new category' => gettext("Add new album"), 
824                'Category name' => gettext("Album name :"),
825                'New category' => gettext("New album"),
826            }
827        );
828    }
829    else{
830        $self->branding(
831            {
832                category  => gettext("categorie"),     
833                Category  => gettext("Categorie"),     
834                categories => gettext("categories"),   
835                Categories => gettext("Categories"),   
836                'Add new category' => gettext("Add new category"),
837                'Category name' => gettext("Category name :"),
838                'New category' => gettext("New category"),
839            }
840        );
841    }   
842}
843
844sub SaveConfig {
845    my ( $self, $params ) = @_; 
846
847   my $config = Wx::ConfigBase::Get;
848
849   map {
850       $config->WriteInt( $_, $params->{$_} )
851   } keys %$params;
852
853   $config->Write( 'Perspective', $params->{Perspective} )
854       
855}
856
857
858sub _init_frame {
859    my ( $self ) = @_; 
860
861    my $url = $self->site_url;
862   
863    if($self->use_offline){
864        $url = gettext("Work Offline");
865    }
866
867    $self->frame(
868        Uploader::GUI::wxFrameAUI->new( 
869            {
870                title     => sprintf("pLoader - Piwigo uploader %s - [%s]", $self->version, $url),
871                pwg       => $self->pwg,
872                imagelist => $self->imagelist,
873                perspective => $self->perspective,
874                imageviewer_index => $self->imageviewerIndex,
875                frameLayout => $self->frameLayout,
876            }
877        )
878    );
879 
880    $self->frame->Show( 1 );
881    $self->SetTopWindow( $self->frame );
882
883    my $icon = Wx::Icon->new();
884    $icon->LoadFile('../res/favicon.ico', wxBITMAP_TYPE_ICO);
885    $self->frame->SetIcon($icon);       
886}
887
888sub _readParams {
889        my( $self, $file ) = @_ ;
890
891
892        my $expr_params ;
893        eval { $expr_params = read_file( $file ); } ;
894       
895        my $paramValues = [] ;
896        if($expr_params){
897                my $expr = '$paramValues = ' ;
898                $expr .=  "$expr_params ; " ;
899                eval $expr ;
900        }
901       
902        return unless 'ARRAY' eq ref $paramValues ;
903       
904        if(scalar(@$paramValues )){
905            my $params = $paramValues->[0] ;
906            $self->SetKeyValues($params);
907        }
908}
909
910
911
912sub SetKeyValues {
913    my ( $self, $params )= @_; 
914
915    foreach( keys %$params ) {
916        $self->{$_} = $params->{$_} ;
917    }
918}
919
920
9211;
Note: See TracBrowser for help on using the repository browser.