1# $Id: Config.pm 2376 2009-02-22 18:49:03Z joern $ 2 3#----------------------------------------------------------------------- 4# Copyright (C) 2001-2006 J�rn Reder <joern AT zyn.de>. 5# All Rights Reserved. See file COPYRIGHT for details. 6# 7# This module is part of Video::DVDRip, which is free software; you can 8# redistribute it and/or modify it under the same terms as Perl itself. 9#----------------------------------------------------------------------- 10 11package Video::DVDRip::Config; 12use Locale::TextDomain qw (video.dvdrip); 13use POSIX qw(locale_h); 14 15use base Video::DVDRip::Base; 16 17use Video::DVDRip::Preset; 18 19use strict; 20use FileHandle; 21use Data::Dumper; 22use Carp; 23 24sub config { shift->{config} } 25 26sub order { shift->{order} } 27sub presets { shift->{presets} } 28sub filename { shift->{filename} } 29sub last_saved_data { shift->{last_saved_data} } 30 31sub set_order { shift->{order} = $_[1] } 32sub set_presets { shift->{presets} = $_[1] } 33sub set_filename { shift->{filename} = $_[1] } 34sub set_last_saved_data { shift->{last_saved_data} = $_[1] } 35 36my @BPP = '<none>'; 37for ( my $b = 1.0; $b > 0 && push @BPP, sprintf( "%.2f", $b ); $b -= 0.05 ) { 38; 39} 40 41my @LANG = ( 42 "en - English", 43 "de - Deutsch", 44 "fr - Francais", 45 "es - Espanol", 46 "it - Italiano", 47 "nl - Nederlands", 48 "aa - Afar", 49 "ab - Abkhazian", 50 "af - Afrikaans", 51 "am - Amharic", 52 "ar - Arabic", 53 "as - Assamese", 54 "ay - Aymara", 55 "az - Azerbaijani", 56 "ba - Bashkir", 57 "be - Byelorussian", 58 "bg - Bulgarian", 59 "bh - Bihari", 60 "bi - Bislama", 61 "bn - Bengali / Bangla", 62 "bo - Tibetan", 63 "br - Breton", 64 "ca - Catalan", 65 "co - Corsican", 66 "cs - Czech", 67 "cy - Welsh", 68 "da - Dansk", 69 "dz - Bhutani", 70 "el - Greek", 71 "eo - Esperanto", 72 "et - Estonian", 73 "eu - Basque", 74 "fa - Persian", 75 "fi - Suomi", 76 "fj - Fiji", 77 "fo - Faroese", 78 "fy - Frisian", 79 "ga - Gaelic", 80 "gd - Scots Gaelic", 81 "gl - Galician", 82 "gn - Guarani", 83 "gu - Gujarati", 84 "ha - Hausa", 85 "he - Hebrew", 86 "hi - Hindi", 87 "hr - Hrvatski", 88 "hu - Magyar", 89 "hy - Armenian", 90 "ia - Interlingua", 91 "id - Indonesian", 92 "ie - Interlingue", 93 "ik - Inupiak", 94 "in - Indonesian", 95 "is - Islenska", 96 "iu - Inuktitut", 97 "iw - Hebrew", 98 "ja - Japanese", 99 "ji - Yiddish", 100 "jw - Javanese", 101 "ka - Georgian", 102 "kk - Kazakh", 103 "kl - Greenlandic", 104 "km - Cambodian", 105 "kn - Kannada", 106 "ko - Korean", 107 "ks - Kashmiri", 108 "ku - Kurdish", 109 "ky - Kirghiz", 110 "la - Latin", 111 "ln - Lingala", 112 "lo - Laothian", 113 "lt - Lithuanian", 114 "lv - Latvian, Lettish", 115 "mg - Malagasy", 116 "mi - Maori", 117 "mk - Macedonian", 118 "ml - Malayalam", 119 "mn - Mongolian", 120 "mo - Moldavian", 121 "mr - Marathi", 122 "ms - Malay", 123 "mt - Maltese", 124 "my - Burmese", 125 "na - Nauru", 126 "ne - Nepali", 127 "no - Norsk", 128 "oc - Occitan", 129 "om - Oromo", 130 "or - Oriya", 131 "pa - Punjabi", 132 "pl - Polish", 133 "ps - Pashto, Pushto", 134 "pt - Portugues", 135 "qu - Quechua", 136 "rm - Rhaeto-Romance", 137 "rn - Kirundi", 138 "ro - Romanian", 139 "ru - Russian", 140 "rw - Kinyarwanda", 141 "sa - Sanskrit", 142 "sd - Sindhi", 143 "sg - Sangho", 144 "sh - Serbo-Croatian", 145 "si - Sinhalese", 146 "sk - Slovak", 147 "sl - Slovenian", 148 "sm - Samoan", 149 "sn - Shona", 150 "so - Somali", 151 "sq - Albanian", 152 "sr - Serbian", 153 "ss - Siswati", 154 "st - Sesotho", 155 "su - Sundanese", 156 "sv - Svenska", 157 "sw - Swahili", 158 "ta - Tamil", 159 "te - Telugu", 160 "tg - Tajik", 161 "th - Thai", 162 "ti - Tigrinya", 163 "tk - Turkmen", 164 "tl - Tagalog", 165 "tn - Setswana", 166 "to - Tonga", 167 "tr - Turkish", 168 "ts - Tsonga", 169 "tt - Tatar", 170 "tw - Twi", 171 "ug - Uighur", 172 "uk - Ukrainian", 173 "ur - Urdu", 174 "uz - Uzbek", 175 "vi - Vietnamese", 176 "vo - Volapuk", 177 "wo - Wolof", 178 "xh - Xhosa", 179 "yi - Yiddish", 180 "yo - Yoruba", 181 "za - Zhuang", 182 "zh - Chinese", 183 "zu - Zulu", 184); 185 186my @LANG_POPUP = ( [ "", "<none>" ] ); 187push @LANG_POPUP, [ $_, $_ ] for @LANG; 188 189my %CONFIG_PARAMETER = ( 190 program_name => { 191 type => 'string', 192 value => "dvd::rip", 193 }, 194 dvd_device => { 195 label => __ "Default DVD device", 196 type => 'file', 197 value => "/cdrom", 198 dvd_button => 1, 199 }, 200 selected_dvd_device => { 201 value => "/cdrom", 202 }, 203 eject_command => { 204 label => __ "Eject Command", 205 type => 'string', 206 value => "cdcontrol", 207 rules => "executable-command", 208 }, 209 play_dvd_command => { 210 label => __ "DVD player command", 211 type => 'string', 212 value => 213 'mplayer <dvd://%t -aid %(%a+%b) -chapter %c -dvdangle %m -dvd-device %d>', 214 presets => [ 215 'mplayer <dvd://%t -aid %(%a+%b) -chapter %c -dvdangle %m -dvd-device %d>', 216 'xine -a %a -p <dvd://%d/%t.%c>', 217 ], 218 rules => "executable-command", 219 }, 220 play_file_command => { 221 label => __ "File player command", 222 type => 'string', 223 value => 'mplayer <%f>', 224 presets => [ 'xine -p <%f>', 'mplayer <%f>', ], 225 rules => "executable-command", 226 }, 227 play_stdin_command => { 228 label => __ "STDIN player command", 229 type => 'string', 230 value => 'mplayer -aid %(%a+128) -', 231 presets => [ 232 'mplayer -aid %(%a+128) -', 'xine stdin://mpeg2 -g -pq -a %a', 233 ], 234 rules => "executable-command", 235 }, 236 rar_command => { 237 label => __ "rar command (for vobsub compression)", 238 type => 'string', 239 value => 'rar', 240 presets => [ 'rar', ], 241 rules => "executable-command", 242 }, 243 base_project_dir => { 244 label => __ "Default data base directory", 245 type => 'dir', 246 value => "$ENV{HOME}/dvdrip-data", 247 }, 248 dvdrip_files_dir => { 249 label => __ "Default directory for .rip project files", 250 type => 'dir', 251 value => "$ENV{HOME}/dvdrip-data", 252 }, 253 ogg_file_ext => { 254 label => __ "OGG file extension", 255 type => 'string', 256 value => 'ogm', 257 presets => [ 'ogg', 'ogm', 'ogv' ], 258 }, 259 cluster_master_local => { 260 label => __ "Start cluster control daemon locally", 261 type => 'switch', 262 value => 1, 263 }, 264 cluster_master_server => { 265 label => __ "Hostname of server with daemon", 266 type => 'string', 267 value => "localhost", 268 }, 269 cluster_master_port => { 270 label => __ "TCP port number of daemon", 271 type => 'number', 272 value => 28646, 273 rules => "positive-integer", 274 }, 275 default_video_codec => { 276 label => __ "Default video codec", 277 type => 'string', 278 value => 'xvid4', 279 presets => [ 280 "SVCD", "VCD", "XSVCD", "XVCD", "CVD", "divx4", 281 "divx5", "xvid", "xvidcvs", "xvid2", "xvid3", "xvid4", 282 "ffmpeg", "fame", "af6" 283 ], 284 }, 285 default_container => { 286 label => __ "Default container format", 287 type => 'popup', 288 value => 'avi', 289 presets => [ [ "avi", "avi" ], [ "ogg", "ogg" ], [ "mpeg", "mpeg" ] ], 290 }, 291 default_bpp => { 292 label => __ "Default BPP value", 293 type => 'number', 294 value => '<none>', 295 presets => \@BPP, 296 tooltip => __ "If this option is set dvd::rip automatically " 297 . "calculates the video bitrate using this BPP value", 298 rules => "positive-float", 299 }, 300 default_subtitle_grab => { 301 label => __ "Grab subtitles while ripping", 302 type => "popup", 303 value => 0, 304 presets => [ 305 [ 'all' => __"Grab all subtitles" ], 306 [ 'lang' => __"Grab subtitles of preferred language" ], 307 [ 0 => __"Don't grab subtitles" ], 308 ], 309 }, 310 default_preset => { 311 label => __"Default Clip & Zoom preset", 312 type => "popup", 313 value => "auto_medium_fast", 314 presets => [], 315 }, 316 preferred_lang => { 317 label => __ "Preferred language", 318 type => 'popup', 319 value => '', 320 presets => \@LANG_POPUP, 321 }, 322 workaround_nptl_bugs => { 323 label => __ "Workaround transcode NPTL bugs", 324 type => 'switch', 325 value => (check_nptl_workaround_possible() ? 1 : 0), 326 avail_method => "check_nptl_workaround_possible", 327 }, 328 nptl_ld_assume_kernel => { 329 label => __ "Set LD_ASSUME_KERNEL to", 330 type => "string", 331 value => "2.4.30", 332 chained => 1, 333 avail_method => "check_nptl_workaround_possible", 334 }, 335 small_screen => { 336 label => __ "Optimize layout for small screens", 337 type => "switch", 338 value => get_default_small_screen_value(), 339 tooltip => 340 __ "With this option the dvd::rip GUI may be tweaked " 341 ."to fit even on small screens by adding scrollbars " 342 ."to the notebook pages. dvd::rip needs to be restarted " 343 ."to take effect" 344 }, 345); 346 347my @CONFIG_ORDER = ( 348 __ "Basic settings" => [ 349 qw( 350 dvd_device 351 base_project_dir dvdrip_files_dir 352 preferred_lang small_screen 353 ) 354 ], 355 __ "Commands" => [ 356 qw( 357 play_dvd_command play_file_command 358 play_stdin_command rar_command 359 ) 360 ], 361 __ "Cluster options" => [ 362 qw( 363 cluster_master_local cluster_master_server 364 cluster_master_port 365 ) 366 ], 367 __ "Miscellaneous options" => [ 368 qw( 369 default_video_codec 370 default_container 371 ogg_file_ext 372 default_bpp 373 default_preset 374 default_subtitle_grab 375 workaround_nptl_bugs nptl_ld_assume_kernel 376 ) 377 ], 378); 379 380sub config_definition { \%CONFIG_PARAMETER } 381 382sub new { 383 my $type = shift; 384 385 my @presets = ( 386 Video::DVDRip::Preset->new( 387 name => "nopreset", 388 title => __ "- No Modifications (anamorph) -", 389 tc_clip1_top => 0, 390 tc_clip1_bottom => 0, 391 tc_clip1_left => 0, 392 tc_clip1_right => 0, 393 tc_zoom_width => undef, 394 tc_zoom_height => undef, 395 tc_clip2_top => 0, 396 tc_clip2_bottom => 0, 397 tc_clip2_left => 0, 398 tc_clip2_right => 0, 399 tc_fast_resize => 0, 400 tc_fast_bisection => 0, 401 ), 402 Video::DVDRip::Preset->new( 403 name => "auto_clip", 404 title => __ "Autoadjust, Clipping only (anamorph)", 405 auto_clip => 1, 406 ), 407 Video::DVDRip::Preset->new( 408 name => "auto_big", 409 title => __ "Autoadjust, Big Frame Size, HQ Resize", 410 tc_fast_resize => 0, 411 auto => 1, 412 frame_size => 'big', 413 ), 414 Video::DVDRip::Preset->new( 415 name => "auto_medium", 416 title => __ "Autoadjust, Medium Frame Size, HQ Resize", 417 tc_fast_resize => 0, 418 auto => 1, 419 frame_size => 'medium', 420 ), 421 Video::DVDRip::Preset->new( 422 name => "auto_small", 423 title => __ "Autoadjust, Small Frame Size, HQ Resize", 424 tc_fast_resize => 0, 425 auto => 1, 426 frame_size => 'small', 427 ), 428 Video::DVDRip::Preset->new( 429 name => "auto_big_fast", 430 title => __ "Autoadjust, Big Frame Size, Fast Resize", 431 tc_fast_resize => 1, 432 auto => 1, 433 frame_size => 'big', 434 ), 435 Video::DVDRip::Preset->new( 436 name => "auto_medium_fast", 437 title => __ "Autoadjust, Medium Frame Size, Fast Resize", 438 tc_fast_resize => 1, 439 auto => 1, 440 frame_size => 'medium', 441 ), 442 Video::DVDRip::Preset->new( 443 name => "auto_small_fast", 444 title => __ "Autoadjust, Small Frame Size, Fast Resize", 445 tc_fast_resize => 1, 446 auto => 1, 447 frame_size => 'small', 448 ), 449 Video::DVDRip::Preset->new( 450 name => "vcd_pal_43", 451 title => __ "VCD 4:3, PAL", 452 tc_clip1_top => 0, 453 tc_clip1_bottom => 0, 454 tc_clip1_left => 0, 455 tc_clip1_right => 0, 456 tc_zoom_width => 352, 457 tc_zoom_height => 288, 458 tc_clip2_top => 0, 459 tc_clip2_bottom => 0, 460 tc_clip2_left => 0, 461 tc_clip2_right => 0, 462 tc_fast_resize => 1, 463 tc_fast_bisection => 0, 464 ), 465 Video::DVDRip::Preset->new( 466 name => "vcd_pal_16_9", 467 title => __ "VCD 16:9, PAL", 468 tc_clip1_top => 0, 469 tc_clip1_bottom => 0, 470 tc_clip1_left => 48, 471 tc_clip1_right => 48, 472 tc_zoom_width => 352, 473 tc_zoom_height => 248, 474 tc_clip2_top => -20, 475 tc_clip2_bottom => -20, 476 tc_clip2_left => 0, 477 tc_clip2_right => 0, 478 tc_fast_resize => 1, 479 tc_fast_bisection => 0, 480 ), 481 Video::DVDRip::Preset->new( 482 name => "svcd_pal_16_9_4_3", 483 title => __ "SVCD 16:9 -> 4:3 letterbox, PAL", 484 tc_clip1_top => 0, 485 tc_clip1_bottom => 0, 486 tc_clip1_left => 0, 487 tc_clip1_right => 0, 488 tc_zoom_width => 480, 489 tc_zoom_height => 432, 490 tc_clip2_top => -72, 491 tc_clip2_bottom => -72, 492 tc_clip2_left => 0, 493 tc_clip2_right => 0, 494 tc_fast_resize => 1, 495 tc_fast_bisection => 0, 496 ), 497 Video::DVDRip::Preset->new( 498 name => "svcd_pal", 499 title => __ "SVCD anamorph, PAL", 500 tc_clip1_top => 0, 501 tc_clip1_bottom => 0, 502 tc_clip1_left => 0, 503 tc_clip1_right => 0, 504 tc_zoom_width => 480, 505 tc_zoom_height => 576, 506 tc_clip2_top => 0, 507 tc_clip2_bottom => 0, 508 tc_clip2_left => 0, 509 tc_clip2_right => 0, 510 tc_fast_resize => 1, 511 tc_fast_bisection => 0, 512 ), 513 Video::DVDRip::Preset->new( 514 name => "xsvcd_pal", 515 title => __ "XSVCD anamorph, PAL", 516 tc_clip1_top => 0, 517 tc_clip1_bottom => 0, 518 tc_clip1_left => 0, 519 tc_clip1_right => 0, 520 tc_zoom_width => 720, 521 tc_zoom_height => 576, 522 tc_clip2_top => 0, 523 tc_clip2_bottom => 0, 524 tc_clip2_left => 0, 525 tc_clip2_right => 0, 526 tc_fast_resize => 1, 527 tc_fast_bisection => 0, 528 ), 529 Video::DVDRip::Preset->new( 530 name => "cvd_pal", 531 title => __ "CVD anamorph, PAL", 532 tc_clip1_top => 0, 533 tc_clip1_bottom => 0, 534 tc_clip1_left => 0, 535 tc_clip1_right => 0, 536 tc_zoom_width => 352, 537 tc_zoom_height => 576, 538 tc_clip2_top => 0, 539 tc_clip2_bottom => 0, 540 tc_clip2_left => 0, 541 tc_clip2_right => 0, 542 tc_fast_resize => 1, 543 tc_fast_bisection => 0, 544 ), 545 Video::DVDRip::Preset->new( 546 name => "vcd_ntsc_43", 547 title => __ "VCD 4:3, NTSC", 548 tc_clip1_top => 0, 549 tc_clip1_bottom => 0, 550 tc_clip1_left => 0, 551 tc_clip1_right => 0, 552 tc_zoom_width => 352, 553 tc_zoom_height => 240, 554 tc_clip2_top => 0, 555 tc_clip2_bottom => 0, 556 tc_clip2_left => 0, 557 tc_clip2_right => 0, 558 tc_fast_resize => 1, 559 tc_fast_bisection => 0, 560 ), 561 Video::DVDRip::Preset->new( 562 name => "vcd_ntsc_16_9", 563 title => __ "VCD 16:9, NTSC", 564 tc_clip1_top => 0, 565 tc_clip1_bottom => 0, 566 tc_clip1_left => 32, 567 tc_clip1_right => 32, 568 tc_zoom_width => 352, 569 tc_zoom_height => 200, 570 tc_clip2_top => -20, 571 tc_clip2_bottom => -20, 572 tc_clip2_left => 0, 573 tc_clip2_right => 0, 574 tc_fast_resize => 1, 575 tc_fast_bisection => 0, 576 ), 577 Video::DVDRip::Preset->new( 578 name => "svcd_ntsc_16_9_4_3", 579 title => __ "SVCD 16:9 -> 4:3 letterbox, NTSC", 580 tc_clip1_top => 0, 581 tc_clip1_bottom => 0, 582 tc_clip1_left => 0, 583 tc_clip1_right => 0, 584 tc_zoom_width => 480, 585 tc_zoom_height => 432, 586 tc_clip2_top => -24, 587 tc_clip2_bottom => -24, 588 tc_clip2_left => 0, 589 tc_clip2_right => 0, 590 tc_fast_resize => 1, 591 tc_fast_bisection => 0, 592 ), 593 Video::DVDRip::Preset->new( 594 name => "svcd_ntsc", 595 title => __ "SVCD anamorph, NTSC", 596 tc_clip1_top => 0, 597 tc_clip1_bottom => 0, 598 tc_clip1_left => 0, 599 tc_clip1_right => 0, 600 tc_zoom_width => 480, 601 tc_zoom_height => 480, 602 tc_clip2_top => 0, 603 tc_clip2_bottom => 0, 604 tc_clip2_left => 0, 605 tc_clip2_right => 0, 606 tc_fast_resize => 1, 607 tc_fast_bisection => 0, 608 ), 609 Video::DVDRip::Preset->new( 610 name => "xsvcd_ntsc", 611 title => __ "XSVCD anamorph, NTSC", 612 tc_clip1_top => 0, 613 tc_clip1_bottom => 0, 614 tc_clip1_left => 0, 615 tc_clip1_right => 0, 616 tc_zoom_width => 720, 617 tc_zoom_height => 480, 618 tc_clip2_top => 0, 619 tc_clip2_bottom => 0, 620 tc_clip2_left => 0, 621 tc_clip2_right => 0, 622 tc_fast_resize => 1, 623 tc_fast_bisection => 0, 624 ), 625 Video::DVDRip::Preset->new( 626 name => "cvd_ntsc", 627 title => __ "CVD anamorph, NTSC", 628 tc_clip1_top => 0, 629 tc_clip1_bottom => 0, 630 tc_clip1_left => 0, 631 tc_clip1_right => 0, 632 tc_zoom_width => 352, 633 tc_zoom_height => 480, 634 tc_clip2_top => 0, 635 tc_clip2_bottom => 0, 636 tc_clip2_left => 0, 637 tc_clip2_right => 0, 638 tc_fast_resize => 1, 639 tc_fast_bisection => 0, 640 ), 641 ); 642 643 my $default_presets_lref = $CONFIG_PARAMETER{"default_preset"}->{presets}; 644 645 foreach my $preset ( @presets ) { 646 push @{$default_presets_lref}, 647 [ $preset->name, $preset->title ]; 648 } 649 650 my %config_parameter = %CONFIG_PARAMETER; 651 my @config_order = @CONFIG_ORDER; 652 653 my $self = { 654 config => \%config_parameter, 655 order => \@config_order, 656 presets => \@presets, 657 }; 658 659 return bless $self, $type; 660} 661 662sub init_nptl_bug_workaround { 663 my $self = shift; 664 665 if ( !check_nptl_workaround_possible() ) { 666 $self->set_value("workaround_nptl_bugs", 0); 667 } 668 669 if ( $self->get_value("workaround_nptl_bugs") ) { 670 $ENV{LD_ASSUME_KERNEL} = $self->get_value('nptl_ld_assume_kernel'); 671 } 672 else { 673 delete $ENV{LD_ASSUME_KERNEL}; 674 } 675 676 1; 677} 678 679sub init_settings { 680 my $self = shift; 681 682 if ( $self->get_value("dvd_device") eq "" ) { 683 $self->set_value( dvd_device => ($self->get_first_dvd_device || "/dev/dvd") ); 684 $self->save; 685 } 686 687 if ( $self->get_value("preferred_lang") eq "" ) { 688 my $lc_messages = POSIX::setlocale("LC_MESSAGES"); 689 my ($lang) = split("_", $lc_messages, 2); 690 $lang = lc($lang); 691 $lang = "en" if $lang eq "c"; 692 $self->set_value( preferred_lang => "<none>" ); 693 foreach my $lang_list ( @LANG ) { 694 if ( $lang_list =~ /$lang -/i ) { 695 $self->set_value( preferred_lang => $lang_list ); 696 last; 697 } 698 } 699 } 700 701 1; 702} 703 704sub load { 705 my $self = shift; 706 707 my $filename = $self->filename; 708 die "filename not set" if $filename eq ''; 709 die "can't read $filename" if not -r $filename; 710 711 my $loaded; 712 $loaded = do $filename; 713 714 if ( $@ or ref $loaded ne 'Video::DVDRip::Config' ) { 715 print "\nCan't load $filename (Preferences)\n$@\n" 716 . "File is probably broken.\n" 717 . "Remove it (Note: your Preferences will be LOST)\n" 718 . "and try again.\n\n"; 719 exit 1; 720 } 721 722 foreach my $par ( keys %{ $self->config } ) { 723 if ( exists $loaded->config->{$par} ) { 724 $self->config->{$par}->{value} = $loaded->config->{$par}->{value}; 725 } 726 if ( exists $self->config->{$par}->{onload} ) { 727 my $onload = $self->config->{$par}->{onload}; 728 &$onload( $self->get_value($par) ); 729 } 730 } 731 732 $self->init_nptl_bug_workaround; 733 734 1; 735} 736 737sub get_save_data { 738 my $self = shift; 739 740 my $last_saved_data = $self->last_saved_data; 741 $self->set_last_saved_data(undef); 742 743 my $dd = Data::Dumper->new( [$self], ['config'] ); 744 $dd->Indent(1); 745 my $data = $dd->Dump; 746 747 $self->set_last_saved_data($last_saved_data); 748 749 return \$data; 750} 751 752sub save { 753 my $self = shift; 754 755 my $filename = $self->filename; 756 die "filename not set" if $filename eq ''; 757 758 my $data_sref = $self->get_save_data; 759 760 my $fh = FileHandle->new; 761 762 open( $fh, "> $filename" ) or die "can't write $filename"; 763 print $fh q{# $Id: Config.pm 2376 2009-02-22 18:49:03Z joern $}, 764 "\n"; 765 print $fh 766 "# This file was generated by Video::DVDRip Version $Video::DVDRip::VERSION\n\n"; 767 768 print $fh ${$data_sref}; 769 close $fh; 770 771 $self->set_last_saved_data($data_sref); 772 773 $self->init_nptl_bug_workaround; 774 775 1; 776} 777 778sub changed { 779 my $self = shift; 780 781 return 1 if not $self->last_saved_data; 782 783 my $actual_data_sref = $self->get_save_data; 784 my $saved_data_sref = $self->last_saved_data; 785 786 my $actual = join( "\n", sort split( /\n/, $$actual_data_sref ) ); 787 my $saved = join( "\n", sort split( /\n/, $$saved_data_sref ) ); 788 789 return $actual ne $saved; 790} 791 792sub get_value { 793 my $self = shift; 794 my ($name) = @_; 795 my $config = $self->config; 796 confess "Unknown config parameter '$name'" 797 if not exists $config->{$name}; 798 return $config->{$name}->{value}; 799} 800 801sub set_value { 802 my $self = shift; 803 my ( $name, $value ) = @_; 804 my $config = $self->config; 805 confess "Unknown config parameter '$name'" 806 if not exists $config->{$name}; 807 return $config->{$name}->{value} = $value; 808} 809 810sub entries_by_type { 811 my $self = shift; 812 my ($type) = @_; 813 814 my %result; 815 my $config = $self->config; 816 my ( $k, $v ); 817 while ( ( $k, $v ) = each %{$config} ) { 818 $result{$k} = $v if $v->{type} eq $type; 819 } 820 821 return \%result; 822} 823 824sub set_temporary { 825 my $self = shift; 826 my ( $name, $value ) = @_; 827 return $self->config->{$name}->{value} = $value; 828} 829 830sub get_preset { 831 my $self = shift; 832 my %par = @_; 833 my ($name) = @par{'name'}; 834 835 my $presets = $self->presets; 836 837 foreach my $preset ( @{$presets} ) { 838 return $preset if $preset->name eq $name; 839 } 840 841 return; 842} 843 844sub copy_values_from { 845 my $self = shift; 846 my ($config) = @_; 847 848 foreach my $par ( keys %CONFIG_PARAMETER ) { 849 $self->set_value( $par, $config->get_value($par) ); 850 } 851 852 1; 853} 854 855sub selected_dvd_device_list { 856 my $self = shift; 857 858 return unless $self->has("hal"); 859 860 #-- scan lshal output for DVD devices 861 my %devices; 862 open (my $fh, "LC_ALL=C lshal |") or die "can't fork lshal"; 863 my $entry; 864 while ( <$fh> ) { 865 if ( /^udi/ ) { 866 $devices{$entry->{device}} = $entry->{model} if $entry && $entry->{dvd}; 867 $entry = {}; 868 } 869 if ( /storage\.model\s+=\s+'([^']+)/ ) { 870 $entry->{model} = $1; 871 } 872 if ( /block\.device\s+=\s+'([^']+)/ ) { 873 $entry->{device} = $1; 874 } 875 if ( /storage\.cdrom\.dvd\s+=\s+true/ ) { 876 $entry->{dvd} = 1; 877 } 878 } 879 close $fh; 880 881 $devices{$entry->{device}} = $entry->{model} if $entry && $entry->{dvd}; 882 883 return \%devices; 884} 885 886sub get_first_dvd_device { 887 my $self = shift; 888 889 my $href = $self->selected_dvd_device_list; 890 891 my $first_name; 892 my $first_device; 893 foreach my $device ( keys %{$href} ) { 894 if ( !$first_name || $first_name gt $href->{$device} ) { 895 $first_device = $device; 896 $first_name = $href->{$device}; 897 } 898 } 899 900 return $first_device; 901} 902 903#--------------------------------------------------------------------- 904# Test methods 905#--------------------------------------------------------------------- 906 907sub test_play_dvd_command { _executable(@_) } 908sub test_play_file_command { _executable(@_) } 909sub test_play_stdin_command { _executable(@_) } 910sub test_rar_command { _executable(@_) } 911sub test_dvd_device { _exists(@_) } 912sub test_writer_device { _exists(@_) } 913sub test_base_project_dir { _abs_and_writable(@_) } 914sub test_dvdrip_files_dir { _abs_and_writable(@_) } 915sub test_burn_writing_speed { _numeric(@_) } 916sub test_burn_cdrecord_device { _cdrecord_device(@_) } 917sub test_burn_cdrecord_cmd { _executable(@_) } 918sub test_burn_cdrdao_cmd { _executable(@_) } 919sub test_burn_mkisofs_cmd { _executable(@_) } 920sub test_burn_vcdimager_cmd { _executable(@_) } 921sub test_burn_cdrdao_buffers { _numeric_or_empty(@_) } 922sub test_cluster_master_port { _numeric(@_) } 923sub test_eject_command { _executable(@_) } 924 925sub _executable { 926 my $self = shift; 927 my ( $name, $value ) = @_; 928 929 $value ||= $self->get_value($name); 930 my ($file) = split( / /, $value ); 931 932 if ( not -f $file ) { 933 foreach my $p ( split( /:/, $ENV{PATH} ) ) { 934 $file = "$p/$file", last if -x "$p/$file"; 935 } 936 } 937 938 if ( -x $file ) { 939 return ( __x( "{file} executable : Ok", file => $file ), 1); 940 } 941 else { 942 return __x( "{file} not found : NOT Ok", file => $file ) 943 if not -e $file; 944 return __x( "{file} not executable : NOT Ok", file => $file ); 945 } 946} 947 948sub _abs_and_writable { 949 my $self = shift; 950 my ($name) = @_; 951 952 my $value = $self->get_value($name); 953 954 return __("has whitespace : NOT Ok") if $value =~ /\s/; 955 return __("is no absolute path : NOT Ok") if $value !~ m!^/!; 956 957 if ( not -w $value ) { 958 return __x( "{file} not found : NOT Ok", file => $value ) 959 if not -e $value; 960 return __x( "{file} not writable : NOT Ok", file => $value ); 961 } 962 else { 963 return (__x( "{file} writable : Ok", file => $value ), 1); 964 } 965} 966 967sub _numeric { 968 my $self = shift; 969 my ($name) = @_; 970 971 my $value = $self->get_value($name); 972 973 if ( $value =~ /^\d+$/ ) { 974 return (__x( "{value} is numeric : Ok", value => $value ), 1); 975 } 976 else { 977 return __x( "{value} isn't numeric : NOT Ok", value => $value ); 978 } 979} 980 981sub _numeric_or_empty { 982 my $self = shift; 983 my ($name) = @_; 984 985 my $value = $self->get_value($name); 986 987 return (__ "is empty : Ok", 1) if $value eq ''; 988 return $self->_numeric($name); 989} 990 991sub _exists { 992 my $self = shift; 993 my ($name) = @_; 994 995 my $value = $self->get_value($name); 996 997 if ( -e $value ) { 998 return (__x( "{value} exists : Ok", value => $value ), 1); 999 } 1000 else { 1001 return __x( "{value} doesn't exist : NOT Ok", value => $value ); 1002 } 1003} 1004 1005sub _one_of_these { 1006 my $self = shift; 1007 my ( $name, $lref ) = @_; 1008 1009 my $value = $self->get_value($name); 1010 1011 foreach my $val ( @{$lref} ) { 1012 return (__x( "'{value}' is known : Ok", value => $value ), 1) 1013 if $val eq $value; 1014 } 1015 1016 return __x( "'{value}' unknown: NOT Ok", value => $value ); 1017} 1018 1019sub check_nptl_workaround_possible { 1020 my $check = qx[ 1021 LD_ASSUME_KERNEL=2.4.30 ls >/dev/null 2>&1 && echo NPTL_OK 1022 ]; 1023 return $check =~ /NPTL_OK/; 1024} 1025 1026sub get_default_small_screen_value { 1027 my $root_info = qx[xwininfo -root]; 1028 my ($width, $height) = $root_info =~ /Width:\s+(\d+).*?Height:\s+(\d+)/si; 1029 return $height < 1024; 1030} 1031 10321; 1033