1# $Id: FilterList.pm 2287 2007-03-17 16:53:44Z 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::FilterList; 12use Locale::TextDomain qw (video.dvdrip); 13 14use base Video::DVDRip::Base; 15 16use Carp; 17use strict; 18use Data::Dumper; 19use FileHandle; 20 21use Video::DVDRip::CPAN::Scanf; 22 23my $DEBUG = 0; 24 25my $FILTER_LIST; 26my %FILTER_SELECTION_CB = ( 27 logo => sub { 28 my %par = @_; 29 my ( $x1, $y1, $x2, $y2, $filter_setting ) 30 = @par{ 'x1', 'y1', 'x2', 'y2', 'filter_setting' }; 31 32 $filter_setting->set_value( 33 option_name => 'pos', 34 idx => 0, 35 value => $x1, 36 ); 37 38 $filter_setting->set_value( 39 option_name => 'pos', 40 idx => 1, 41 value => $y1, 42 ); 43 44 1; 45 }, 46 logoaway => sub { 47 my %par = @_; 48 my ( $x1, $y1, $x2, $y2, $filter_setting ) 49 = @par{ 'x1', 'y1', 'x2', 'y2', 'filter_setting' }; 50 51 $filter_setting->set_value( 52 option_name => 'pos', 53 idx => 0, 54 value => $x1, 55 ); 56 57 $filter_setting->set_value( 58 option_name => 'pos', 59 idx => 1, 60 value => $y1, 61 ); 62 63 $filter_setting->set_value( 64 option_name => 'size', 65 idx => 0, 66 value => $x2 - $x1, 67 ); 68 69 $filter_setting->set_value( 70 option_name => 'size', 71 idx => 1, 72 value => $y2 - $y1, 73 ); 74 75 1; 76 }, 77 mask => sub { 78 my %par = @_; 79 my ( $x1, $y1, $x2, $y2, $filter_setting ) 80 = @par{ 'x1', 'y1', 'x2', 'y2', 'filter_setting' }; 81 82 $filter_setting->set_value( 83 option_name => 'lefttop', 84 idx => 0, 85 value => $x1, 86 ); 87 88 $filter_setting->set_value( 89 option_name => 'lefttop', 90 idx => 1, 91 value => $y1, 92 ); 93 94 $filter_setting->set_value( 95 option_name => 'rightbot', 96 idx => 0, 97 value => $x2, 98 ); 99 100 $filter_setting->set_value( 101 option_name => 'rightbot', 102 idx => 1, 103 value => $y2, 104 ); 105 106 1; 107 }, 108); 109 110sub filters { shift->{filters} } 111sub set_filters { shift->{filters} = $_[1] } 112 113sub get_filter_list { 114 my $class = shift; 115 116 # cache instance per process 117 return $FILTER_LIST if $FILTER_LIST; 118 119 my $dir = "$ENV{HOME}/.dvdrip"; 120 my $filename = "$dir/tc_filter_list"; 121 122 mkdir $dir, 0755 or die "can't create $dir" if not -d $dir; 123 124 my $transcode_modpath = qx[ tcmodinfo -p 2>/dev/null ]; 125 chomp $transcode_modpath; 126 127 $DEBUG && print STDERR "transcode module path: $transcode_modpath\n"; 128 129 # empty list if tcmodinfo not available 130 return $FILTER_LIST = $class->new() if not $transcode_modpath; 131 132 my $filter_mtime = ( stat($filename) )[9]; 133 my $transcode_mtime = ( stat($transcode_modpath) )[9]; 134 my $FilterList_mtime = ( 135 stat( 136 $class->search_perl_inc( 137 rel_path => "Video/DVDRip/FilterList.pm" 138 ) 139 ) 140 )[9]; 141 142 # create new list of no file avaiable or if file 143 # is older than transcode's modpath, or if dvd::rip's 144 # FilterList module is newer. 145 if ( not -f $filename 146 or $filter_mtime < $transcode_mtime 147 or $filter_mtime < $FilterList_mtime ) { 148 $FILTER_LIST = $class->new(); 149 $FILTER_LIST->scan( modpath => $transcode_modpath ); 150 $FILTER_LIST->save( filename => $filename ); 151 return $FILTER_LIST; 152 } 153 154 return $FILTER_LIST = $class->load( filename => $filename ); 155} 156 157sub new { 158 my $class = shift; 159 160 my $self = { filters => {}, }; 161 162 return bless $self, $class; 163} 164 165sub load { 166 my $class = shift; 167 my %par = @_; 168 my ($filename) = @par{'filename'}; 169 170 my $fh = FileHandle->new; 171 open( $fh, $filename ) or croak "can't read $filename"; 172 my $data = join( '', <$fh> ); 173 close $fh; 174 175 my $filter_list; 176 eval($data); 177 croak "can't load $filename. Perl error: $@" if $@; 178 179 return bless $filter_list, $class; 180} 181 182sub save { 183 my $self = shift; 184 my %par = @_; 185 my ($filename) = @par{'filename'}; 186 187 my $data_sref = $self->get_save_data; 188 189 my $fh = FileHandle->new; 190 191 open( $fh, "> $filename" ) or confess "can't write $filename"; 192 print $fh q{# $Id: FilterList.pm 2287 2007-03-17 16:53:44Z joern $}, 193 "\n"; 194 print $fh 195 "# This file was generated by Video::DVDRip Version $Video::DVDRip::VERSION\n\n"; 196 197 print $fh ${$data_sref}; 198 close $fh; 199 200 1; 201} 202 203sub get_save_data { 204 my $self = shift; 205 206 my $dd = Data::Dumper->new( [$self], ['filter_list'] ); 207 $dd->Indent(1); 208 $dd->Purity(1); 209 my $data = $dd->Dump; 210 211 return \$data; 212} 213 214sub scan { 215 my $self = shift; 216 my %par = @_; 217 my ($modpath) = @par{'modpath'}; 218 219 print STDERR 220 "[filterlist] (re)scanning transcode's module path $modpath...\n"; 221 222 my @filter_names = grep !/^(pv|preview)$/, 223 map {m!/filter_([^/]+)\.so$/!} glob("$modpath/filter_*"); 224 225 my %filters; 226 foreach my $filter_name (@filter_names) { 227 my $filter 228 = Video::DVDRip::Filter->new( filter_name => $filter_name ); 229 next if !$filter || !$filter->capabilities; 230 $filters{$filter_name} = $filter; 231 } 232 233 $self->set_filters( \%filters ); 234 235 1; 236} 237 238sub get_filter { 239 my $self = shift; 240 my %par = @_; 241 my ($filter_name) = @par{'filter_name'}; 242 243 $self = $self->get_filter_list if not ref $self; 244 245 croak "Filter '$filter_name' unknown" 246 if not exists $self->filters->{$filter_name}; 247 248 return $self->filters->{$filter_name}; 249} 250 251package Video::DVDRip::Filter; 252use Locale::TextDomain qw (video.dvdrip); 253 254use Carp; 255use Text::Wrap; 256 257sub filter_name { shift->{filter_name} } 258sub desc { shift->{desc} } 259sub version { shift->{version} } 260sub author { shift->{author} } 261sub capabilities { shift->{capabilities} } 262sub frames_needed { shift->{frames_needed} } 263sub options { shift->{options} } 264sub options_by_name { shift->{options_by_name} } 265 266sub can_video { shift->capabilities =~ /V/ } 267sub can_audio { shift->capabilities =~ /A/ } 268sub can_rgb { shift->capabilities =~ /R/ } 269sub can_yuv { shift->capabilities =~ /Y/ } 270sub can_multiple { shift->capabilities =~ /M/ } 271 272sub is_pre { shift->capabilities =~ /E/ } 273sub is_post { shift->capabilities =~ /O/ } 274sub is_pre_post { $_[0]->is_pre and $_[0]->is_post } 275 276sub new { 277 my $class = shift; 278 my %par = @_; 279 my ($filter_name) = @par{'filter_name'}; 280 281 $DEBUG && print STDERR "Scan: tcmodinfo -i $filter_name ... "; 282 283 my $config; 284 eval { 285 local $SIG{ALRM} = sub { die "alarm" }; 286 alarm 2; 287 $config = qx[ tcmodinfo -i $filter_name 2>/dev/null ]; 288 alarm 0; 289 }; 290 291 if ( $@ ) { 292 $DEBUG && print STDERR "TIMEOUT\n"; 293 return; 294 } 295 296 $DEBUG && print STDERR "OK\n------\n$config\n------\n"; 297 298 my $line; 299 my ( %options, @options ); 300 301 my ( $desc, $version, $author, $capabilities, $frames_needed ); 302 my $in_config = 0; 303 304 while ( $config =~ /(.*)/g ) { 305 $line = $1; 306 if ( not $in_config ) { 307 next if $line !~ /^START/; 308 $in_config = 1; 309 } 310 next if $line !~ /^"/; 311 if ( not $desc ) { 312 my @csv_fields = ( $line =~ /"([^"]+)"/g ); 313 shift @csv_fields; 314 $desc = shift @csv_fields; 315 $version = shift @csv_fields; 316 $author = shift @csv_fields; 317 $capabilities = shift @csv_fields; 318 $frames_needed = shift @csv_fields; 319 next; 320 } 321 322 my $option = Video::DVDRip::FilterOption->new( 323 config => $line, 324 filter_name => $filter_name, 325 ); 326 return if $option->option_name !~ /^\w+$/; 327 $options{ $option->option_name } = $option; 328 push @options, $option; 329 } 330 331 $capabilities =~ s/O/E/ if $filter_name eq 'logoaway'; 332 333 my $self = { 334 filter_name => $filter_name, 335 desc => $desc, 336 version => $version, 337 author => $author, 338 capabilities => $capabilities, 339 frames_needed => $frames_needed, 340 options => \@options, 341 options_by_name => \%options, 342 }; 343 344 return bless $self, $class; 345} 346 347sub get_option { 348 my $self = shift; 349 my %par = @_; 350 my ($option_name) = @par{'option_name'}; 351 352 croak "Option '$option_name' unknown for filter '".$self->filter_name."'" 353 if not exists $self->options_by_name->{$option_name}; 354 355 return $self->options_by_name->{$option_name}; 356} 357 358sub get_info { 359 my $self = shift; 360 361 $Text::Wrap::columns = 32; 362 363 my @info = ( 364 [ "Name", wrap( "", "", $self->filter_name ), ], 365 [ "Desc", wrap( "", "", $self->desc ), ], 366 [ "Version", wrap( "", "", $self->version ), ], 367 [ "Author(s)", wrap( "", "", $self->author ), ], 368 ); 369 370 my $info; 371 $info .= "Video, " if $self->can_video; 372 $info .= "Audio, " if $self->can_audio; 373 $info =~ s/, $//; 374 375 push @info, [ "Type", $info ]; 376 377 $info = ""; 378 $info .= "RGB, " if $self->can_rgb; 379 $info .= "YUV, " if $self->can_yuv; 380 $info =~ s/, $//; 381 382 push @info, [ "Color", $info ]; 383 384 $info = ""; 385 $info .= "PRE, " if $self->is_pre; 386 $info .= "POST, " if $self->is_post; 387 $info =~ s/, $//; 388 $info ||= "unknown"; 389 390 push @info, [ "Pre/Post", $info ]; 391 push @info, [ "Multiple", ( $self->can_multiple ? "Yes" : "No" ) ]; 392 393 return \@info; 394} 395 396sub av_type { 397 my $self = shift; 398 399 my $info = ""; 400 $info .= __("Video").", " if $self->can_video; 401 $info .= __("Audio").", " if $self->can_audio; 402 $info =~ s/, $//; 403 404 return $info; 405} 406 407sub colorspace_type { 408 my $self = shift; 409 410 return "--" if !$self->can_video; 411 412 my $info = ""; 413 $info .= "RGB, " if $self->can_rgb; 414 $info .= "YUV, " if $self->can_yuv; 415 $info =~ s/, $//; 416 417 return $info; 418} 419 420sub pre_post_type { 421 my $self = shift; 422 423 my $info = ""; 424 $info .= "PRE, " if $self->is_pre; 425 $info .= "POST, " if $self->is_post; 426 $info =~ s/, $//; 427 $info ||= "unknown"; 428 429 return $info; 430} 431 432sub multiple_type { 433 my $self = shift; 434 return $self->can_multiple ? __"Yes" : __"No"; 435} 436 437sub get_selection_cb { 438 my $self = shift; 439 440 return $FILTER_SELECTION_CB{ $self->filter_name }; 441} 442 443sub get_dummy_instance { 444 my $self = shift; 445 return Video::DVDRip::FilterSettingsInstance->new ( 446 id => -1, 447 filter_name => $self->filter_name 448 ); 449} 450 451package Video::DVDRip::FilterOption; 452use Locale::TextDomain qw (video.dvdrip); 453 454use Carp; 455use Text::Wrap; 456 457sub option_name { shift->{option_name} } 458sub desc { shift->{desc} } 459sub format { shift->{format} } 460sub fields { shift->{fields} } 461sub switch { shift->{switch} } 462 463sub new { 464 my $class = shift; 465 my %par = @_; 466 my ( $config, $filter_name ) = @par{ 'config', 'filter_name' }; 467 468 my @csv_fields = ( $config =~ /"([^"]*)"/g ); 469 470 my $name = shift @csv_fields; 471 my $desc = shift @csv_fields; 472 my $format = shift @csv_fields; 473 my $default = shift @csv_fields; 474 475 my $switch; 476 if ( $format eq '' ) { 477 478 # on/off only, no value 479 push @csv_fields, "0", "1"; 480 $format = "%B"; 481 $switch = 1; 482 } 483 elsif ( $format eq '%s' ) { 484 push @csv_fields, "", ""; 485 } 486 487 # cpaudio reports '%c' - stupid, %c scans ASCII code 488 $format = '%s' if $format eq '%c'; 489 490 # logoaway reports '%2x' - stupid, we get spaces this way 491 $format =~ s/\%2x/\%02x/g; 492 493 my $scan_format = $format; 494 $scan_format =~ s/\%\%//g; # eliminate quoted % 495 my $default_format = $format; 496 $default_format =~ s/\%\%//g; # eliminate quoted % 497 498 my @field_formats = ( $scan_format =~ /\%(.)/g ); 499 my @default_values 500 = Video::DVDRip::CPAN::Scanf::sscanf( $default_format, $default ); 501 502 my @fields; 503 while (@csv_fields) { 504 my $range_from = shift @csv_fields; 505 my $range_to = shift @csv_fields; 506 my $type = shift @field_formats; 507 508 push @fields, 509 Video::DVDRip::FilterOptionField->new( 510 default => shift @default_values, 511 range_from => $range_from, 512 range_to => $range_to, 513 fractional => ( $type eq 'f' ), 514 text => ( $type eq 's' ), 515 ); 516 } 517 518 print "WARNING: [$filter_name] Option $name has fields left!\n" 519 if @default_values; 520 521 my $self = { 522 option_name => $name, 523 desc => $desc, 524 format => $format, 525 fields => \@fields, 526 switch => $switch, 527 }; 528 529 return bless $self, $class; 530} 531 532sub get_wrapped_desc { 533 my $self = shift; 534 535 local($Text::Wrap::columns) = 24; 536 537 return join( "\n", wrap( "", "", $self->desc ) ); 538} 539 540package Video::DVDRip::FilterOptionField; 541use Locale::TextDomain qw (video.dvdrip); 542 543sub default { shift->{default} } 544sub range_from { shift->{range_from} } 545sub range_to { shift->{range_to} } 546sub fractional { shift->{fractional} } 547sub switch { shift->{switch} } 548sub checkbox { shift->{checkbox} } 549sub combo { shift->{combo} } 550sub text { shift->{text} } 551 552#----------------------------------------------------------- 553# checkbox vs. switch 554# =================== 555# 556# Both are checkboxes on the GUI, but the internal 557# parameter code generation differs: 558# 559# switch: the parameter has no option value. It's there or 560# it's not there. 561# 562# checkbox: the parameter has either 0 or 1 as option value. 563#----------------------------------------------------------- 564 565sub new { 566 my $class = shift; 567 my %par = @_; 568 my ($default, $range_from, $range_to, $fractional, $switch) = 569 @par{'default','range_from','range_to','fractional','switch'}; 570 my ($text) = 571 @par{'text'}; 572 573 my ( $checkbox, $combo ); 574 575 $range_to = undef 576 if $range_to eq 'oo' 577 or $range_to < $range_from; 578 579 $range_from = -99999999 580 if $range_from eq '' 581 or $range_from =~ /\D/; 582 583 $range_to = 99999999 584 if $range_to eq '' 585 or $range_to =~ /\D/; 586 587 if ( not $fractional and $range_from !~ /\D/ and $range_to !~ /\D/ ) { 588 if ( $range_from == 0 and $range_to == 1 ) { 589 $checkbox = 1; 590 } 591 elsif ( $range_to ne '' 592 and $range_from ne '' 593 and $range_to - $range_from < 20 ) { 594 $combo = 1; 595 } 596 } 597 598 my $self = { 599 default => $default, 600 range_from => $range_from, 601 range_to => $range_to, 602 fractional => $fractional, 603 switch => $switch, 604 checkbox => $checkbox, 605 combo => $combo, 606 text => $text, 607 }; 608 609 return bless $self, $class; 610} 611 612sub get_range_text { 613 my $self = shift; 614 615 return "Default: " . ( $self->default ? "on" : "off" ) 616 if $self->checkbox 617 or $self->switch; 618 return "Default: " . $self->default if $self->text; 619 620 my $frac = $self->fractional ? " (fractional)" : ""; 621 622 my $range_from = $self->range_from; 623 my $range_to = $self->range_to; 624 625 foreach my $range ( $range_from, $range_to ) { 626 $range = "WIDTH" if $range eq 'W' or $range eq 'width'; 627 $range = "HEIGHT" if $range eq 'H' or $range eq 'height'; 628 } 629 630 $range_from = "-oo" if $range_from == -99999999; 631 $range_to = "oo" if $range_to == 99999999; 632 633 my $default = $self->default; 634 $default = "<empty>" if $default eq ''; 635 636 my $info = "Valid values$frac: $range_from .. $range_to " 637 . "(Default: $default)"; 638 639 return $info; 640} 641 6421; 643