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