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