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