common.pm

   1 # Author: Martin Matusiak <numerodix@gmail.com>
   2 # Licensed under the GNU Public License, version 3.
   3
   4 package common;
   5
   6 use strict;
   7 use Cwd qw(abs_path);
   8 use Data::Dumper;
   9 use File::Basename;
  10 use File::Path;
  11 use IPC::Open3;
  12 use POSIX qw(:sys_wait_h);
  13
  14 use colors;
  15
  16 use base 'Exporter';
  17 our @EXPORT_OK = qw($suite $defaults $tools);
  18 our @EXPORT = qw(
  19         nonfatal
  20         fatal
  21         trunc
  22         p
  23         resolve_symlink
  24         copy_hashref
  25         init_logdir
  26         run
  27         init_cmds
  28         print_tool_banner
  29         print_version
  30         compute_bpp
  31         set_bpp
  32         compute_vbitrate
  33         ternary_int_str
  34         clone_dd
  35         clone_vobcopy
  36         scan_dvd_for_titledata
  37         examine_dvd_for_titlecount
  38         examine_title
  39         get_crop_eta
  40         crop_title
  41         print_title_line
  42         scale_title
  43         compute_media_size
  44         set_container_opts
  45         set_acodec_opts
  46         set_vcodec_opts
  47         run_encode
  48         remux_container
  49         );
  50
  51
  52 ### DECLARATIONS
  53
  54 # autoflush write buffer globally
  55 $| = 1;
  56
  57 our $suite = {
  58         suite_name => "undvd",
  59         version => "0.7.5",
  60         tool_name => basename(resolve_symlink($0)),
  61 };
  62
  63 our $defaults = {
  64         logdir => "logs",
  65
  66         timer_refresh => 1,
  67
  68         dvd_device => "/dev/dvd",
  69         disc_image => "disc.iso",
  70         disc_dir => "disc",
  71         mencoder_source => "disc.iso",
  72
  73         framesize_baseline => 720*576*(2/3)**2, # in pixels
  74
  75         h264_1pass_bpp => .195,
  76         h264_2pass_bpp => .150,
  77
  78         xvid_1pass_bpp => .250,
  79         xvid_2pass_bpp => .200,
  80
  81         container => "avi",
  82
  83         prescale => "",
  84         postscale => ",harddup",
  85 };
  86
  87
  88 my @videoutils = qw(mencoder mplayer);
  89 my @shellutils = qw(mount);
  90 my @coreutils = qw(dd);
  91 my @extravideoutils = qw(lsdvd mp4creator mkvmerge ogmmerge vobcopy);
  92
  93 my @mencoder_acodecs = qw(copy faac lavc mp3lame);
  94 my @mencoder_vcodecs = qw(copy lavc x264 xvid);
  95
  96 my @mplayer_acodecs = qw(ac3);
  97 my @mplayer_vcodecs = qw(mpeg-2);
  98
  99 our $tools = {};
 100 init_cmds();
 101
 102
 103 ### FUNCTIONS
 104
 105 # non fatal error
 106 sub nonfatal {
 107         my $s = shift;
 108
 109         my $p = \&s_err;
 110         my $em = \&s_it;
 111
 112         my $ms;
 113         while ($s =~ m/(%%%.*?%%%)/g) {
 114                 $ms .= $p->(substr($s, 0, @-[0]));
 115                 $ms .= $em->($&);
 116                 $s = substr($s, @+[0]);
 117         }
 118         $ms .= $p->($s);
 119         $ms =~ s/%%%//g;
 120
 121         print $p->("Error:") . "  $ms\n";
 122 }
 123
 124 # fatal error
 125 sub fatal {
 126         nonfatal($_[0]);
 127         exit 1;
 128 }
 129
 130 # truncate text
 131 sub trunc {
 132         my ($width, $side, $s, $fill) = @_;
 133
 134         my $trunc_len = length($s) - $width;
 135         $s = substr($s, 0, $width);
 136
 137         substr($s, length($s) - length($fill), length($fill), $fill)
 138                 if (($trunc_len > 0) and $fill);
 139
 140         my $pad_len = abs($width - length($s));
 141         my $pad = " " x $pad_len;
 142
 143         $s = $pad . $s if $side == -1;
 144         $s = $s . $pad if $side == 1;
 145
 146         return $s;
 147 }
 148
 149 # replace chomp (broken on cygwin?)
 150 sub mychomp {
 151         my ($s) = @_;
 152
 153         my $c = chop($s);
 154         if ($c =~ /\s/) {
 155                 return $s;
 156         } else {
 157                 return $s.$c;
 158         }
 159 }
 160
 161 # print object
 162 sub p {
 163         my @these = @_;
 164         foreach my $this (@these) {
 165                 if (ref $this eq "ARRAY") {
 166                         print "\ndump:  ".join(" , ", @$this)."\n";
 167                 } else {
 168                         print "\n".Dumper($this);
 169                 }
 170         }
 171 }
 172
 173 # resolve symlink
 174 sub resolve_symlink {
 175         return abs_path($_[0]);
 176 }
 177
 178 # copy hash reference
 179 sub copy_hashref {
 180         my $ref = shift;
 181
 182         my %newhash = %$ref;
 183         my $newref = \%newhash;
 184
 185         return $newref;
 186 }
 187
 188
 189 # create directory for logging
 190 sub init_logdir {
 191         if (! -e $defaults->{logdir} and ! mkdir($defaults->{logdir})) {
 192                 fatal("Could not write to %%%$ENV{PWD}%%%, exiting");
 193         } elsif (-e $defaults->{logdir} and ! -w $defaults->{logdir}) {
 194                 fatal("Logging directory %%%".$defaults->{logdir}."%%% is not writable");
 195         }
 196 }
 197
 198 # replace gnu which
 199 sub which {
 200         my ($bin) = @_;
 201
 202         foreach my $dir (split(":", $ENV{PATH})) {
 203                 return ("$dir/$bin", 0) if (-x "$dir/$bin");
 204         }
 205         return ($bin, 1);
 206 }
 207
 208 # launch command waiting for output and exit
 209 sub run {
 210         my ($args, $nowait) = @_;
 211
 212         print STDERR join(' ', @$args)."\n" if $ENV{"DEBUG"};
 213
 214         # renice to run unprivileged
 215         POSIX::nice(20);
 216
 217         # spawn process
 218         my($writer, $reader);
 219         my $pid = open3(my $writer, $reader, $reader, @$args);
 220
 221         if ($nowait) {
 222                 return ($pid, $reader);
 223         }
 224
 225         # read from pipe as output comes
 226         my $out;
 227         while (my $stdout = <$reader>) {
 228                 $out .= $stdout;
 229         }
 230
 231         # wait for pid and capture exit value
 232         wait;
 233         my $exit = $? >> 8;
 234
 235         chomp($out);
 236
 237         return ($out, $exit);
 238 }
 239
 240 # aggregate invocation results
 241 sub run_agg {
 242         my ($invokes, $logfile) = @_;
 243
 244         my $fh_logfile;
 245         open($fh_logfile, ">", $logfile);
 246
 247         foreach my $args (@$invokes) {
 248                 my ($o, $x) = run($args);
 249                 print $fh_logfile join(" ", @$args)."\n";
 250                 print $fh_logfile $o."\n";
 251                 if ($x) {
 252                         close($fh_logfile);
 253                         return $x;
 254                 }
 255         }
 256
 257         close($fh_logfile);
 258
 259         return 0;
 260 }
 261
 262 # check for missing dependencies
 263 sub init_cmds {
 264         my $verbose = shift;
 265
 266         print " * Checking for tool support...\n" if $verbose;
 267         foreach my $tool (@videoutils, @shellutils, @coreutils, @extravideoutils) {
 268                 my ($tool_path, $exit) = which($tool);
 269                 $tools->{$tool} = $tool_path;
 270                 if (! $exit) {
 271                         print "   " . s_ok("*") . " $tool_path\n" if $verbose;
 272                 } else {
 273                         print "   " . s_wa("*") . " $tool missing\n" if $verbose;
 274                 }
 275         }
 276
 277         sub codec_check {
 278                 my $type = shift;
 279                 my $codecs = shift;
 280                 my $tool = shift;
 281                 my @args = @_;
 282
 283                 print " * Checking for $tool $type codec support...\n";
 284
 285                 unshift(@args, $tools->{$tool});
 286                 my ($out, $exit) = run(\@args);
 287                 foreach my $codec (@$codecs) {
 288                         if ($out =~ /$codec/i) {
 289                                 print "   " . s_ok("*") . " $codec\n";
 290                         } else {
 291                                 print "   " . s_wa("*") . " $codec missing\n";
 292                         }
 293                 }
 294         };
 295
 296         if ($verbose) {
 297                 codec_check("audio", \@mplayer_acodecs, "mplayer", qw(-ac help));
 298                 codec_check("video", \@mplayer_vcodecs, "mplayer", qw(-vc help));
 299                 codec_check("audio", \@mencoder_acodecs, "mencoder", qw(-oac help));
 300                 codec_check("video", \@mencoder_vcodecs, "mencoder", qw(-ovc help));
 301         }
 302 }
 303
 304 # check tool availability
 305 sub have_tool {
 306         my ($tool) = @_;
 307
 308         if ($tool =~ /^\/.*/) {
 309                 return 1;
 310         } else {
 311                 return 0;
 312         }
 313 }
 314
 315 # print standard common banner
 316 sub print_tool_banner {
 317         print "{( --- " . $suite->{tool_name} . " " . $suite->{version} . " --- )}\n";
 318 }
 319
 320 # print package version and versions of tools
 321 sub print_version {
 322         sub check_tool {
 323                 my $tool = shift;
 324                 my $re = shift;
 325                 my @args = @_;
 326
 327                 my ($tool_path, $exit) = which($tool);
 328                 if ($exit) {
 329                         print "  [" . s_err("!") . "] $tool missing\n";
 330                 } else {
 331                         unshift(@args, $tool_path);
 332                         my ($out, $exit) = run(\@args);
 333                         my $version = $1 if ($out) =~ /$re/ms;
 334                         print "  [" . s_ok("*") . "] $tool $version\n";
 335                 }
 336         };
 337         print $suite->{suite_name} . " " . $suite->{version} . "\n";
 338         check_tool("mplayer", "^MPlayer ([^ ]+)", qw());
 339         check_tool("mencoder", "^MEncoder ([^ ]+)", qw(-oac help));
 340         check_tool("lsdvd", "^lsdvd ([^ ]+)", qw(-V));
 341         check_tool("vobcopy", "^Vobcopy ([^ ]+)", qw(--version));
 342         check_tool("mp4creator", ".* version ([^ ]+)", qw(-version));
 343         check_tool("mkvmerge", "^mkvmerge ([^ ]+)", qw(--version));
 344         check_tool("ogmmerge", "^ogmmerge ([^ ]+)", qw(--version));
 345         exit;
 346 }
 347
 348 # compute bits per pixel
 349 sub compute_bpp {
 350         my $width = shift;
 351         my $height = shift;
 352         my $fps = shift;
 353         my $length = shift;
 354         my $video_size = shift;         # in mb
 355         my $bitrate = shift;    # kbps
 356
 357         if ($bitrate) {
 358                 $bitrate = $bitrate * 1024;
 359         } else {
 360                 $video_size = $video_size * 1024 * 1024;
 361                 $bitrate = (8 * $video_size)/( $length != 0 ? $length : 1 );
 362         }
 363         my $bpp = ($bitrate)/( $width*$height*$fps != 0 ? $width*$height*$fps : 1);
 364
 365         return $bpp;
 366 }
 367
 368 # set bpp based on the codec and number of passes
 369 sub set_bpp {
 370         my ($video_codec, $passes) = @_;
 371
 372         my $bpp;
 373         if ($video_codec eq "h264") {
 374                 $bpp = $defaults->{h264_1pass_bpp} if $passes == 1;
 375                 $bpp = $defaults->{h264_2pass_bpp} if $passes > 1;
 376         } else {
 377                 $bpp = $defaults->{xvid_1pass_bpp} if $passes == 1;
 378                 $bpp = $defaults->{xvid_2pass_bpp} if $passes > 1;
 379         }
 380
 381         return $bpp;
 382 }
 383
 384 # set the number of passes based on codec and bpp
 385 sub set_passes {
 386         my ($video_codec, $bpp) = @_;
 387
 388         my $passes = 1;
 389         if ($video_codec eq "h264") {
 390                 $passes = 2 if $bpp < $defaults->{h264_1pass_bpp};
 391         } else {
 392                 $passes = 2 if $bpp < $defaults->{xvid_1pass_bpp};
 393         }
 394
 395         return $passes;
 396 }
 397
 398 # compute video bitrate based on title length
 399 sub compute_vbitrate {
 400         my ($width, $height, $fps, $bpp) = @_;
 401
 402         my $bitrate = int( ($width * $height * $fps * $bpp) / 1024);
 403
 404         return $bitrate;
 405 }
 406
 407 # prepend with int key if int, otherwise with string key
 408 sub ternary_int_str {
 409         my ($value, $int_key, $str_key) = @_;
 410
 411         my @args;
 412         if ($value =~ /^[0-9]+$/) {
 413                 push(@args, $int_key, $value);
 414         } else {
 415                 push(@args, $str_key, $value);
 416         }
 417
 418         return @args;
 419 }
 420
 421 # clone disc to iso image
 422 sub clone_dd {
 423         my ($dvd_device, $img) = @_;
 424
 425         my @args = ($tools->{dd}, "if=$dvd_device", "of=$img.partial");
 426         my @a = (\@args);
 427         my $exit = run_agg(\@a, $defaults->{logdir} . "/clone.log");
 428
 429         if ($exit) {
 430                 return $exit;
 431         } else {
 432                 rename("$img.partial", $img);
 433                 return $exit;
 434         }
 435 }
 436
 437 # clone encrypted disc to directory
 438 sub clone_vobcopy {
 439         my ($dvd_device, $dir) = @_;
 440
 441         $dvd_device = resolve_symlink($dvd_device);
 442
 443         my @args = ($tools->{mount});
 444         my ($mount_table, $exit) = run(\@args);
 445
 446         if ($exit) {
 447                 fatal("Failed to lookup mount table");
 448         }
 449
 450         my $mnt_point = (map { /$dvd_device on ([^ ]+)/ } split('\n', $mount_table))[0];
 451
 452         if (! $mnt_point) {
 453                 print "\n" . s_wa("=>") . " Your dvd device " . s_bb($dvd_device)
 454                         . " has to be mounted for this.\n";
 455                 print s_wa("=>") . " Mount the dvd and supply the device to " .
 456                         $suite->{tool_name} . ", eg:\n";
 457                 print "    " . s_b("sudo mount") . " " . s_bb($dvd_device) . " " .
 458                         s_b("/mnt/dvd") . " " . s_b("-t") . " " . s_b("iso9660") . "\n";
 459                 print "    " . s_b($suite->{tool_name}) . " " . s_b("-d") . " " .
 460                         s_bb($dvd_device) . " [" . s_b("other options") . "]\n";
 461                 exit 1;
 462         }
 463
 464         if (-e $dir) {
 465                 rmtree($dir);
 466         }
 467
 468         my @args = ($tools->{vobcopy}, "-f", "-l", "-m", "-F", "64");
 469         push(@args, "-i", $mnt_point, "-t", $dir);
 470         my @a = (\@args);
 471
 472         my $exit = run_agg(\@a, $defaults->{logdir} . "/clone.log");
 473
 474         return $exit;
 475 }
 476
 477 # extract title data from dvd with lsdvd
 478 sub scan_dvd_for_titledata_lsdvd {
 479         my ($dvd_device) = @_;
 480
 481         my @args = ($tools->{lsdvd}, "-avs", $dvd_device);
 482         my ($out, $exit) = run(\@args);
 483
 484         if ($exit) {
 485                 fatal($out);
 486         }
 487
 488         my @titles;
 489
 490         my @title_numbers = map( { /^Title: ([0-9]*)/ } split(/\n/, $out));
 491         foreach my $titleno (@title_numbers) {
 492                 my ($title, $title_s, $length, @aids, @alangs, @sids, @slangs);
 493
 494                 if ($out =~ /(Title: $titleno.*?\n\n)/s) { $title_s = $1; }
 495
 496                 if ($title_s =~ /Title: $titleno, Length: ([0-9:]+)/) { $length = $1; }
 497
 498                 while ($title_s =~ m/Audio: .*Language: ([a-zA-Z]+)/g) { push(@alangs, $1); }
 499                 while ($title_s =~ m/Audio: .*Stream id: (0x[0-9abcdefABCDEF]+)/g) {
 500                         push(@aids, oct($1)); }
 501
 502                 while ($title_s =~ m/Subtitle: .*Language: ([a-zA-Z]+)/g) { push(@slangs, $1); }
 503                 while ($title_s =~ m/Subtitle: .*Stream id: (0x[0-9abcdefABCDEF]+)/g) {
 504                         push(@sids, oct($1) - 32); }
 505
 506                 $title->{title_number} = $titleno;
 507                 $title->{length_s} = $length;
 508                 $title->{alangs} = \@alangs;
 509                 $title->{aids} = \@aids;
 510                 $title->{slangs} = \@slangs;
 511                 $title->{sids} = \@sids;
 512
 513                 push(@titles, $title);
 514         }
 515
 516         return @titles;
 517 }
 518
 519 # extract title data from dvd with lsdvd
 520 sub scan_dvd_for_titledata_mplayer {
 521         my ($dvd_device) = @_;
 522
 523         my @titles;
 524
 525         my $title_nos = examine_dvd_for_titlecount($dvd_device);
 526
 527         if (! $title_nos) {
 528                 fatal("Failed to read titles from dvd device %%%$dvd_device%%%");
 529         }
 530
 531         for (my $i = 1; $i <= $title_nos; $i++) {
 532                 my $title = examine_title($i, $dvd_device);
 533                 push(@titles, $title);
 534         }
 535
 536         return @titles;
 537 }
 538
 539 # extract title data from dvd
 540 sub scan_dvd_for_titledata {
 541         my ($dvd_device) = @_;
 542
 543         if (have_tool($tools->{lsdvd})) {
 544                 print " * Scanning DVD for titles with lsdvd...\n";
 545                 return scan_dvd_for_titledata_lsdvd($dvd_device);
 546         } elsif (have_tool($tools->{mplayer})) {
 547                 print " * Scanning DVD for titles with mplayer (slow)...\n";
 548                 return scan_dvd_for_titledata_mplayer($dvd_device);
 549         } else {
 550                 fatal("Failed to detect %%%lsdvd%%% or %%%mplayer%%% for dvd scan");
 551         }
 552 }
 553
 554 # extract number of titles from dvd
 555 sub examine_dvd_for_titlecount {
 556         my $source = shift;
 557
 558         my @args = ($tools->{mplayer}, "-ao", "null", "-vo", "null");
 559         push(@args, "-frames", "0", "-identify");
 560         push(@args, "-dvd-device", $source, "dvd://");
 561
 562         my ($out, $exit) = run(\@args);
 563         my $titles = $1 if ($out) =~ /^ID_DVD_TITLES=([^\s]+)/ms;
 564
 565         return $titles;
 566 }
 567
 568 # extract information from file or dvd title
 569 sub examine_title {
 570         my $file = shift;
 571         my $dvd_device = shift;
 572
 573         my @source = ($file);
 574         if ($dvd_device) {
 575                 @source = ("dvd://$file", "-dvd-device", $dvd_device);
 576         }
 577         my @args = ($tools->{mplayer}, "-ao", "null", "-vo", "null");
 578         push(@args, "-frames", "0", "-identify");
 579         push(@args, @source);
 580
 581         my ($s, $exit) = run(\@args);
 582
 583         sub find {
 584                 my $default = shift;
 585                 my $s = shift;
 586                 my $re = shift;
 587
 588                 my @match = map { /^${re}$/ } split('\n', $s);
 589                 if (@match) {
 590                         @match = sort {$b <=> $a} @match;
 591                         return mychomp(shift(@match));
 592                 } else { return $default; }
 593         }
 594
 595         sub findall {
 596                 my $s = shift;
 597                 my $uniq = shift;
 598                 my $re = shift;
 599
 600                 my @match = map { /^${re}$/ } split('\n', $s);
 601                 for (my $i = 0; $i < scalar @match; $i ++) {
 602                         $match[$i] = mychomp($match[$i]); }
 603
 604                 if ($uniq) {
 605                         my %seen = ();
 606                         my @uniqu = grep { ! $seen{$_} ++ } @match;
 607                         @match = @uniqu;
 608                 }
 609
 610                 return \@match;
 611         }
 612
 613         sub fmt_len {
 614                 my ($len) = @_;
 615                 my $h = int($len / 3600);
 616                 my $m = int(($len - ($h * 3600)) / 60);
 617                 my $s = int($len - ($h * 3600) - ($m * 60));
 618                 while (length($h) < 2) { $h = "0$h"; }
 619                 while (length($m) < 2) { $m = "0$m"; }
 620                 while (length($s) < 2) { $s = "0$s"; }
 621                 return "$h:$m:$s";
 622         }
 623
 624         my $data = {
 625                 filename =>    $file,
 626                 title_number=> length($file) < 2 ? "0$file" : $file,
 627                 width =>       find(0, $s, "ID_VIDEO_WIDTH=(.+)"),
 628                 height =>      find(0, $s, "ID_VIDEO_HEIGHT=(.+)"),
 629                 fps =>         find(0, $s, "ID_VIDEO_FPS=(.+)"),
 630                 length =>      find(0, $s, "ID_LENGTH=(.+)"),
 631                 length_s =>    fmt_len(find(0, $s, "ID_LENGTH=(.+)")),
 632                 abitrate =>    find(0, $s, "ID_AUDIO_BITRATE=(.+)"),
 633                 aformat =>  lc(find(0, $s, "ID_AUDIO_CODEC=(.+)")),
 634                 vbitrate =>    find(0, $s, "ID_VIDEO_BITRATE=(.+)"),
 635                 vformat =>  lc(find(0, $s, "ID_VIDEO_FORMAT=(.+)")),
 636                 aids =>        findall($s, 1, "ID_AUDIO_ID=(.+)"),
 637                 alangs =>      findall($s, 0, "ID_AID_[0-9]+_LANG=(.+)"),
 638                 sids =>        findall($s, 1, "ID_SUBTITLE_ID=(.+)"),
 639                 slangs =>      findall($s, 0, "ID_SID_[0-9]+_LANG=(.+)"),
 640         };
 641
 642         $data->{abitrate} = int($data->{abitrate} / 1024);      # to kbps
 643         $data->{vbitrate} = int($data->{vbitrate} / 1024);      # to kbps
 644
 645         if ($dvd_device) {
 646                 $data->{filesize} = int(
 647                         ($data->{abitrate} + $data->{vbitrate}) * $data->{length} / 8 / 1024);
 648         } else {
 649                 $data->{filesize} = int( (stat($file))[7] / 1024 / 1024 );
 650         }
 651
 652         sub fill_bitrates {
 653                 my ($filesize, $length, $abitrate, $vbitrate) = @_;
 654
 655                 if ($length and $filesize) {
 656                         if (       $abitrate and ! $vbitrate) {
 657                                 $vbitrate = int((($filesize*1024/($length > 0 ? $length : 1))
 658                                                 - ($abitrate/8)) * 8);
 659                         } elsif (! $abitrate and   $vbitrate) {
 660                                 $abitrate = int((($filesize*1024/($length > 0 ? $length : 1))
 661                                                 - ($vbitrate/8)) * 8);
 662                         }
 663                 }
 664
 665                 return ($abitrate, $vbitrate);
 666         }
 667
 668         ($data->{abitrate}, $data->{vbitrate}) = fill_bitrates($data->{filesize},
 669                 $data->{length}, $data->{abitrate}, $data->{vbitrate});
 670
 671         $data->{bpp} = compute_bpp($data->{width}, $data->{height}, $data->{fps},
 672                 $data->{len}, 0, $data->{vbitrate});
 673
 674         return $data;
 675 }
 676
 677 # estimate cropdetect duration
 678 sub get_crop_eta {
 679         my ($length, $fps) = @_;
 680
 681         return int($length * $fps / 250 / 60);
 682 }
 683
 684 # figure out how much to crop
 685 sub crop_title {
 686         my ($file, $dvd_device) = @_;
 687
 688         my @source = ($file);
 689         if ($dvd_device) {
 690                 push (@source, "-dvd-device", $dvd_device);
 691         }
 692         my @args = ($tools->{mplayer}, "-quiet", "-ao", "null", "-vo", "null");
 693         push(@args, "-fps", "10000", "-vf", "cropdetect");
 694         push(@args, @source);
 695
 696         my ($out, $exit) = run(\@args);
 697
 698         my @cropdata = map { /^(\[CROP\].*)$/ } split("\n", $out);
 699         my $cropline = pop(@cropdata);
 700
 701         my ($w, $h, $x, $y) =
 702                 map { /-vf crop=([0-9]+):([0-9]+):([0-9]+):([0-9]+)/ } $cropline;
 703
 704         my $cropfilter = "crop=$w:$h:$x:$y,";
 705
 706         return ($w, $h, $cropfilter);
 707 }
 708
 709 # set formatting of bpp output depending on value
 710 sub markup_bpp {
 711         my $bpp = shift;
 712         my $video_codec = shift;
 713
 714         if (($video_codec =~ "(h264|avc)")) {
 715                 if ($bpp      < $defaults->{h264_2pass_bpp}) {
 716                         $bpp = s_err($bpp);
 717                 } elsif ($bpp > $defaults->{h264_1pass_bpp}) {
 718                         $bpp = s_wa($bpp);
 719                 } else {
 720                         $bpp = s_bb($bpp);
 721                 }
 722         } elsif (($video_codec =~ "xvid")) {
 723                 if ($bpp      < $defaults->{xvid_2pass_bpp}) {
 724                         $bpp = s_err($bpp);
 725                 } elsif ($bpp > $defaults->{xvid_1pass_bpp}) {
 726                         $bpp = s_wa($bpp);
 727                 } else {
 728                         $bpp = s_bb($bpp);
 729                 }
 730         } else {
 731                 $bpp = s_b($bpp);
 732         }
 733
 734         return $bpp;
 735 }
 736
 737 # print one line of title display, whether header or not
 738 sub print_title_line {
 739         my $is_header = shift;
 740         my $data = shift;
 741
 742         my ($dim, $fps, $length, $bpp, $passes, $vbitrate, $vformat, $abitrate, $aformat);
 743         my ($filesize, $filename);
 744
 745         if ($is_header) {
 746                 $dim = "dim";
 747                 $fps = "fps";
 748                 $length = "length";
 749                 $bpp = "bpp";
 750                 $passes = "p";
 751                 $vbitrate = "vbitrate";
 752                 $vformat = "vcodec";
 753                 $abitrate = "abitrate";
 754                 $aformat = "acodec";
 755                 $filesize = "size";
 756                 $filename = "title";
 757         } else {
 758                 my $x = $data->{width}  > 0 ? $data->{width}  : "";
 759                 my $y = $data->{height} > 0 ? $data->{height} : "";
 760                 $dim =    $x."x".$y ne "x"     ? $x."x".$y                 : "";
 761                 $fps =    $data->{fps}    > 0  ? $data->{fps}              : "";
 762                 $length = $data->{length} > 0  ? int($data->{length} / 60) : "";
 763                 $bpp =    $data->{bpp}    > 0  ? $data->{bpp}              : "";
 764                 $passes =   $data->{passes}     > 0 ? $data->{passes}   : "";
 765                 $vbitrate = $data->{vbitrate}   > 0 ? $data->{vbitrate} : "";
 766                 $vformat =  $data->{vformat} ne "0" ? $data->{vformat}  : "";
 767                 $abitrate = $data->{abitrate}   > 0 ? $data->{abitrate} : "";
 768                 $aformat =  $data->{aformat} ne "0" ? $data->{aformat}  : "";
 769                 $filesize = $data->{filesize};
 770                 $filename = $data->{filename};
 771         }
 772
 773         $dim =      trunc(9, -1, $dim);
 774         $fps =      trunc(6, -1, $fps);
 775         $length =   trunc(3, -1, $length);
 776         $bpp =      trunc(5,  1, $bpp);
 777         $passes =   trunc(1, -1, $passes);
 778         $vbitrate = trunc(4, -1, $vbitrate);
 779         $vformat =  trunc(4, -1, $vformat);
 780         $abitrate = trunc(4, -1, $abitrate);
 781         $aformat =  trunc(4, -1, $aformat);
 782         $filesize = trunc(4, -1, $filesize);
 783
 784         if ($filename =~ /dvd:\/\//) {
 785                 $filesize = s_est($filesize);
 786         }
 787
 788         $bpp = markup_bpp($bpp, $vformat) unless $is_header;
 789
 790         my $line = "$dim  $fps  $length  $bpp $passes $vbitrate $vformat  "
 791                 . "$abitrate $aformat  $filesize  $filename";
 792         $line = s_b($line) if $is_header;
 793         print "$line\n";
 794 }
 795
 796 # compute title scaling
 797 sub scale_title {
 798         my ($width, $height, $custom_scale) = @_;
 799
 800         my ($nwidth, $nheight) = ($width, $height);
 801
 802         if ($custom_scale ne "off") {   # scaling isn't disabled
 803
 804                 # scale to the width given by user (upscaling permitted)
 805                 if ($custom_scale) {
 806                         undef $nwidth;
 807                         undef $nheight;
 808
 809                         if ($custom_scale =~ /^([0-9]+)$/) {
 810                                 $nwidth = $1;
 811                         } elsif ($custom_scale =~ /^([0-9]*):([0-9]*)$/) {
 812                                 ($nwidth, $nheight) = ($1, $2);
 813                         } else {
 814                                 fatal("Failed to read a pair of positive integers from scaling "
 815                                         . "%%%$custom_scale%%%");
 816                         }
 817
 818                         if (       $nwidth > 0 and ! $nheight > 0) {
 819                                 $nheight = int($height * $nwidth  / ($width  > 0 ? $width  : 1) );
 820                         } elsif (! $nwidth > 0 and   $nheight > 0) {
 821                                 $nwidth =  int($width  * $nheight / ($height > 0 ? $height : 1) );
 822                         }
 823
 824                 # apply default scaling heuristic
 825                 } else {
 826                         # compute scaling factor based on baseline value
 827                         my $framesize = $width*$height > 0 ? $width*$height : 1;
 828                         my $factor = sqrt($defaults->{framesize_baseline}/$framesize);
 829
 830                         # scale by factor, do not upscale
 831                         if ($factor < 1) {
 832                                 $nwidth = int($width*$factor);
 833                                 $nheight = int($height*$factor);
 834                         }
 835                 }
 836
 837                 # dimensions have been changed, make sure they are multiples of 16
 838                 ($nwidth, $nheight) = scale_by_x($width, $height, $nwidth, $nheight);
 839
 840                 # make sure the new dimensions are sane
 841                 if ($nwidth * $nheight <= 0) {
 842                         ($nwidth, $nheight) = ($width, $height);
 843                 }
 844         }
 845
 846         return ($nwidth, $nheight);
 847 }
 848
 849 # scale dimensions to nearest (lower/upper) multiple of 16
 850 sub scale_by_x {
 851         my ($orig_width, $orig_height, $width, $height) = @_;
 852         my $divisor = 16;
 853
 854         # if the original dimensions are not multiples of 16, no amount of scaling
 855         # will bring us to an aspect ratio where the smaller dimensions are
 856         if (($orig_width % $divisor) + ($orig_height % $divisor) != 0) {
 857                 $width = $orig_width;
 858                 $height = $orig_height;
 859         } else {
 860                 my $step = -1;
 861                 my $completed;
 862                 while (! $completed) {
 863                         $step++;
 864
 865                         my $up_step = $width + ($step * $divisor);
 866                         my $down_step = $width - ($step * $divisor);
 867                         foreach my $x_step ($up_step, $down_step) {
 868                                 my $x_width = int($x_step - ($x_step % $divisor));
 869                                 my $x_height = int($x_width *
 870                                         ($orig_height/ ($orig_width > 0 ? $orig_width : 1) ));
 871                                 if (($x_width % $divisor) + ($x_height % $divisor) == 0) {
 872                                         $completed = 1;
 873                                         $width = $x_width;
 874                                         $height = $x_height;
 875                                 }
 876                         }
 877                 }
 878         }
 879
 880         return ($width, $height);
 881 }
 882
 883 # compute size of media given length and bitrate
 884 sub compute_media_size {
 885         my ($length, $bitrate) = @_;
 886         return ($bitrate / 8) * ($length / 1024);
 887 }
 888
 889 # get container options and decide on codecs
 890 sub set_container_opts {
 891         my ($acodec, $vcodec, $container) = @_;
 892
 893         my $audio_codec = "mp3";
 894         my $video_codec = "h264";
 895         my $ext = "avi";
 896         my @opts = ("avi");
 897
 898         if ($container =~ /(avi|mkv|ogm)/) {
 899         } elsif ($container eq "mp4") {
 900                 $audio_codec = "aac";
 901                 $video_codec = "h264";
 902         } else {
 903
 904                 # use lavf muxing
 905                 if ($container =~ "(asf|au|dv|flv|ipod|mov|mpg|nut|rm|swf)") {
 906                         $ext = $container;
 907                         @opts = ("lavf", "-lavfopts", "format=$container");
 908
 909                         if ($container eq "flv") {
 910                                 $audio_codec = "mp3";
 911                                 $video_codec = "flv";
 912                         }
 913                 } else {
 914                         fatal("Unrecognized container %%%$container%%%");
 915                 }
 916         }
 917
 918         $audio_codec = $acodec if $acodec;
 919         $video_codec = $vcodec if $vcodec;
 920
 921         return ($audio_codec, $video_codec, $ext, @opts);
 922 }
 923
 924 # get audio codec options
 925 sub set_acodec_opts {
 926         my ($container, $codec, $orig_bitrate, $get_bitrate) = @_;
 927
 928         my @opts;
 929         if ($container eq "flv"){
 930                 push(@opts, "-srate", "44100");         # flv supports 44100, 22050, 11025
 931         }
 932
 933         my $bitrate;
 934         if ($codec eq "copy") {
 935                 $bitrate = $orig_bitrate;
 936                 unshift(@opts, "copy");
 937         } elsif ($codec eq "mp3") {
 938                 $bitrate = 160;
 939                 unshift(@opts, "mp3lame", "-lameopts", "vbr=3:abr=$bitrate:q=3");
 940         } elsif ($codec eq "aac") {
 941                 $bitrate = 192;
 942                 unshift(@opts, "faac", "-faacopts", "br=$bitrate:mpeg=4:object=2",
 943                         "-channels", "2");
 944
 945         # use lavc codec
 946         } else {
 947                 $bitrate = 224;         # mencoder manpage default
 948                 my $cs = "ac3|flac|g726|libamr_nb|libamr_wb|mp2|roq_dpcm|sonic|sonicls|"
 949                         . "vorbis|wmav1|wmav2";
 950                 if ($codec =~ /($cs)/) {
 951                         unshift(@opts, "lavc", "-lavcopts",
 952                                 "abitrate=$bitrate:acodec=$codec");
 953                 } else {
 954                         fatal("Unrecognized audio codec %%%$codec%%%");
 955                 }
 956         }
 957
 958         if ($get_bitrate) {
 959                 return $bitrate;
 960         } else {
 961                 return @opts;
 962         }
 963 }
 964
 965 # get video codec options
 966 sub set_vcodec_opts {
 967         my ($codec, $passes, $pass, $bitrate) = @_;
 968
 969         my @opts;
 970         if ($codec eq "copy") {
 971                 push(@opts, "copy");
 972
 973         } elsif ($codec eq "h264") {
 974                 my $local_opt = "subq=5:frameref=2";
 975                 if ($passes > 1) {
 976                         if ($pass < $passes) {
 977                                 $local_opt = "pass=$pass:subq=1:frameref=1";
 978                         } else {
 979                                 $local_opt = "pass=$pass:$local_opt";
 980                         }
 981                 }
 982                 push(@opts, "x264", "-x264encopts",
 983                         "$local_opt:partitions=all:weight_b:bitrate=$bitrate:threads=auto");
 984
 985         } elsif ($codec eq "xvid") {
 986                 my $local_opt;
 987                 if ($passes > 1) {
 988                         if ($pass < $passes) {
 989                                 $local_opt = "pass=$pass:";
 990                         } else {
 991                                 $local_opt = "pass=$pass:";
 992                         }
 993                 }
 994                 push(@opts, "xvid", "-xvidencopts",
 995                         "${local_opt}bitrate=$bitrate");
 996
 997         # use lavc codec
 998         } else {
 999                 my $local_opt;
1000                 if ($passes > 1) {
1001                         if ($pass < $passes) {
1002                                 $local_opt = "vpass=$pass:";
1003                         } else {
1004                                 $local_opt = "vpass=$pass:";
1005                         }
1006                 }
1007
1008                 my $cs = "asv1|asv2|dvvideo|ffv1|flv|h261|h263|h263p|huffyuv|libtheora|"
1009                         . "ljpeg|mjpeg|mpeg1video|mpeg2video|mpeg4|msmpeg4|msmpeg4v2|"
1010                         . "roqvideo|rv10|snow|svq1|wmv1|wmv2";
1011                 if ($cs =~ /($cs)/) {
1012                         push(@opts, "lavc", "-lavcopts",
1013                                 "${local_opt}vbitrate=$bitrate:vcodec=$codec");
1014
1015                 } else {
1016                         fatal("Unrecognized video codec %%%$codec%%%");
1017                 }
1018         }
1019
1020         return @opts;
1021 }
1022
1023 # run encode and print updates
1024 sub run_encode {
1025         my ($args, $file, $title_name, $ext, $length, $passes, $pass) = @_;
1026
1027         # Set output and logging depending on number of passes
1028
1029         my $output_file = "$title_name.$ext.partial";
1030         my $base = basename($title_name);
1031         my $logfile = $defaults->{logdir}."/$base.log";
1032
1033         if ($passes > 1) {
1034                 $logfile = "$logfile.pass$pass";
1035                 if ($pass < $passes) {
1036                         $output_file = "/dev/null";
1037                 }
1038         } else {
1039                 $pass = "-";
1040         }
1041
1042         unshift(@$args, $tools->{mencoder}, "-v");
1043         push(@$args, "-o", $output_file, $file);
1044
1045         # Print initial status message
1046
1047         my $status = trunc(19, 1, "[$pass] Encoding");
1048         print "$status\r";
1049
1050         # Execute encoder in the background
1051
1052         my $fh_logfile;
1053         open($fh_logfile, ">", $logfile);
1054         print $fh_logfile join(" ", @$args)."\n";
1055         my ($pid, $reader) = run(\@$args, 1);
1056
1057         # Write mencoder's ETA estimate
1058
1059         my $line = trunc(59, 1, $status);
1060         my $start_time = time();
1061         my ($exit, $perc, $secs, $fps, $size, $ela, $eta);
1062
1063         while ((my $kid = waitpid($pid, WNOHANG)) != -1) {
1064                 sysread($reader, my $s, 1024*1024);
1065                 $exit = $? >> 8;
1066                 print $fh_logfile $s;
1067
1068                 $s = substr($s, length($s) - 1000);
1069                 if (int(time()) % $defaults->{timer_refresh} == 0) {
1070                         $perc = s_it2( trunc(4, -1, $1) )    if ($s =~ /\(([0-9 ]{2}%)\)/);
1071                         $secs =        trunc(6, -1, "$1s")   if ($s =~ /Pos:[ ]*([0-9]+)\.[0-9]*s/);
1072                         $fps  =  s_it( trunc(7, -1, $1) )    if ($s =~ /([0-9]+fps)/);
1073                         $size =        trunc(6, -1, $1)      if ($s =~ /([0-9]+mb)/);
1074                         $ela  = s_ela( "+".int((time() - $start_time) / 60 )."min" ) if $perc;
1075                         $eta  = s_eta(              "-$1" )  if ($s =~ /Trem:[ ]*([0-9]+min)/);
1076                         $line = "$status   $perc   $secs   $fps   $size     " if $perc;
1077                         print "${line}$ela  $eta    \r";
1078                         sleep 1
1079                 }
1080         }
1081
1082         # Flush pipe and close logfile
1083
1084         while (<$reader>) { print $fh_logfile $_; }
1085         close($fh_logfile);
1086
1087         # Report exit code
1088
1089         if ($exit == 0) {
1090                 print $line . "[ " . s_ok("done")    . trunc(14, 1, " ]") . "\n";
1091         } else {
1092                 print $line . "[ " . s_err("failed") . trunc(12, 1, " ] check log") . "\n";
1093         }
1094 }
1095
1096 # run remux and print updates
1097 sub remux_container {
1098         my ($root, $ext, $fps, $container, $acodec, $vcodec) = @_;
1099
1100         if ($container =~ /(mp4|mkv|ogm)/) {
1101
1102                 # Set logging
1103
1104                 my $base = basename($root);
1105                 my $logfile = $defaults->{logdir} . "/$base.remuxlog";
1106
1107                 sub pre {
1108                         my ($root, $container, $ext, $acodec, $vcodec) = @_;
1109
1110                         if (-f "$root.$container") {
1111                                 unlink("$root.$container");
1112                         }
1113                         my @args1 = ($tools->{mplayer}, "$root.$ext",
1114                                 "-dumpaudio", "-dumpfile", "$root.$acodec");
1115                         my @args2 = ($tools->{mplayer}, "$root.$ext",
1116                                 "-dumpvideo", "-dumpfile", "$root.$vcodec");
1117                         return (\@args1, \@args2);
1118                 }
1119
1120                 sub post {
1121                         my ($root, $ext, $acodec, $vcodec) = @_;
1122
1123                         unlink "$root.$acodec";
1124                         unlink "$root.$vcodec";
1125                         unlink "$root.$ext";
1126                 }
1127
1128                 my $remux;
1129
1130                 if ($container eq "mp4") {
1131                         $remux = sub {
1132                                 my ($root, $container, $ext, $acodec, $vcodec) = @_;
1133
1134                                 my @args1 = ($tools->{mp4creator}, "-create", "$root.$acodec",
1135                                         "$root.$container");
1136                                 my @args2 = ($tools->{mp4creator}, "-create", "$root.$vcodec",
1137                                         "-rate=$fps", "$root.$container");
1138                                 my @args3 = ($tools->{mp4creator}, "-hint=1", "$root.$container");
1139                                 my @args4 = ($tools->{mp4creator}, "-hint=2", "$root.$container");
1140                                 my @args5 = ($tools->{mp4creator}, "-optimize", "$root.$container");
1141
1142                                 my @p = pre($root, $container, $ext, $acodec, $vcodec);
1143                                 my @a = (@p, \@args1, \@args2, \@args3, \@args4, \@args5);
1144                                 my ($out, $exit, $err) = run_agg(\@a, $logfile);
1145                                 post($root, $ext, $acodec, $vcodec);
1146                                 return ($out, $exit, $err);
1147                         };
1148                 } elsif ($container eq "mkv") {
1149                         $remux = sub {
1150                                 my ($root, $container, $ext, $acodec, $vcodec) = @_;
1151
1152                                 my @args = ($tools->{mkvmerge}, "-o", "$root.$container",
1153                                         "$root.$ext");
1154
1155                                 my @a = (\@args);
1156                                 my ($out, $exit, $err) = run_agg(\@a, $logfile);
1157                                 unlink("$root.$ext");
1158                                 return ($out, $exit, $err);
1159                         };
1160                 } elsif ($container eq "ogm") {
1161                         $remux = sub {
1162                                 my ($root, $container, $ext, $acodec, $vcodec) = @_;
1163
1164                                 my @args = ($tools->{ogmmerge}, "-o", "$root.$container",
1165                                         "$root.$ext");
1166
1167                                 my @a = (\@args);
1168                                 my ($out, $exit, $err) = run_agg(\@a, $logfile);
1169                                 unlink("$root.$ext");
1170                                 return ($out, $exit, $err);
1171                         };
1172                 }
1173
1174                 # Print initial status message
1175
1176                 my $status = trunc(59, 1, "[.] Remuxing");
1177                 print "$status\r";
1178
1179                 # Execute remux in the background
1180
1181                 my $exit = &$remux($root, $container, $ext, $acodec, $vcodec);
1182
1183                 # Report exit code
1184
1185                 if ($exit == 0) {
1186                         print "${status}[ " . s_ok("done")    . trunc(15, 1, " ]") . "\n";
1187                 } else {
1188                         print "${status}[ " . s_err("failed") . " ] check log" . "\n";
1189                 }
1190         }
1191 }
1192
1193
1194 1;