#!/usr/bin/perl

# (c) 2003 by Struan Bartlett <struan.gpl@praguespringpeople.org>
#
# v1.0-pre1 Released 1/10/2003
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
  
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# TO DO
#  1. Subclass all classes from baseclass that includes New
#  2. Enhance error handling on all calls to MP/ME; on parsing all MP/ME outcomes.
#     Precaching support
#  3. Generalise option support on LAVC, MP3LAME, AVInput
#  4. Rename all packages appropriately
#     Properly object orientate all accessor methods
#     Add help
#     Add command line options
#     Add pre/post cleanup options
#     Add loading standard object properties from: a) Dumper; b) XML;
#  5. Support selecting best scale on basis of AR Error as well as bpp
#     Setup email alias
#     Ensure -ss/seeking is avoided unless index is known to exist
#     On failures in multi-pass encoding, detect when frameno.avi etc are valid and skip steps

package AVInput;

$| = 1;

use POSIX qw( :sys_wait_h floor );
use FileHandle;
use IPC::Open2;

sub New {
    my $Class = shift;
    my $In = shift;
    my $New;
    %$New = %$In;
    return bless $New,$Class;
}

sub MPMap {
    my $Vid = shift;
    my $Map = shift;
    my $In = shift;
    my $Out = shift;
    
    my $Cmd = "mplayer $Vid->{'Input'} ";
    $Cmd .= join(' ', map { "$_ $Map->{$_}" } keys %$Map);
    $main::DEBUG || ($Cmd .= " 2>/dev/null");
    $main::DEBUG && print "$0: MPMap: $Cmd\n";

    return open2($In, $Out, $Cmd) || die "$0 - MPMap: Could not execute: $!\n";
}

sub MEMap {
    my $Vid = shift;
    my $Map = shift;
    my $In = shift;
    my $Out = shift;

    my $Cmd = "mencoder $Vid->{'Input'} ";
    $Cmd .= join(' ', map { "$_ $Map->{$_}" } keys %$Map);
    $main::DEBUG || ($Cmd .= " 2>/dev/null");
    $main::DEBUG && print "$0: MEMap: $Cmd\n";

    return open2($In, $Out, $Cmd) || die "$0 - MEMap: Could not execute: $!\n";
}

# Detect crop, aspect ratio, fps

sub Detect {
    my $Vid = shift;
    
    print "$0: Detecting...\n";
    
    my $VidMap = {
	'-vo' => 'null',
	  '-slave' => undef,
	  '-vop' => 'cropdetect',
	  '-ao' => 'null',
#	  '-ss' => 120
    };
    
    my $PID = $Vid->MPMap($VidMap, *In, *Out);

# *!*!*!* Perhaps preferable to seek to '-ss' position if has been specified.    
    sleep 2;
    print Out "seek 120 2\n";
    
    alarm(3);
    $SIG{ALRM} = sub {
	print Out "quit\n";
    };
    
    my %Crops;
    while(<In>) {
	$main::DEBUG && print STDERR $_;
	if( /^VIDEO:.*?(\d+)x(\d+)\s+.*?(\d+\.\d+) fps/s ) {
	    $Vid->{'Unscaled Width'} = $1;
	    $Vid->{'Unscaled Height'} = $2;
	    $Vid->{'UnscaledAspectRatio'} = $1/$2;
	    $Vid->{'FPS'} = $3;
	}
	elsif( /^Movie-Aspect.*?(\d+\.\d+\:\d+(?:\.\d+)?)/ ) {
	    $Vid->{'AspectRatio'} = $1;
	}
	next unless /-vop (crop=\d+:\d+:\d+:\d+)/s;
	last if $Crops{$1}++ == 20;
    }
    close In;
    close Out;
    
    waitpid($PID,0);
    $main::DEBUG && print STDERR "Returned code: $?\n";

    die "$0 - No crops detected!\n" unless keys %Crops;
    die "$0 - No aspect ratio detected!\n" unless $Vid->{'AspectRatio'} || $Vid->{'UnscaledAspectRatio'};
    die "$0 - No FPS detected!\n" unless $Vid->{'FPS'};

    $Vid->{'AspectRatio'} = $Vid->{'UnscaledAspectRatio'} unless $Vid->{'AspectRatio'};
   
    $main::VERBOSE && print "$0: AspectRatio: $Vid->{'AspectRatio'}\n";
    $main::VERBOSE && print "$0: UnscaledAspectRatio: $Vid->{'UnscaledAspectRatio'}\n";
    $main::VERBOSE && print "$0: UnscaledWidth: $Vid->{'Unscaled Width'}\n";
    $main::VERBOSE && print "$0: UnscaledHeight: $Vid->{'Unscaled Height'}\n";
    $main::VERBOSE && print "$0: FPS: $Vid->{'FPS'}\n";
    
    $main::DEBUG && print '%Crops: "', join(',',%Crops),"\n";
    my @Crops = reverse sort {$a <=> $b} values %Crops;
    $main::DEBUG && print '@Crops: "', join(',',@Crops),"\n";
    my %ReverseCrops = reverse %Crops;
    $main::DEBUG && print '%ReverseCrops: "', join(',',%ReverseCrops),"\n";
    
    ($Vid->{'Crop'}->{'Width'},
     $Vid->{'Crop'}->{'Height'},
     $Vid->{'Crop'}->{'X'},
     $Vid->{'Crop'}->{'Y'})
      = $ReverseCrops{$Crops[0]} =~ /^crop=(\d+):(\d+):(\d+):(\d+)$/s;

    $main::VERBOSE && printf("$0: Crop: %dx%d-%dx%d\n",
			     $Vid->{'Crop'}->{'Width'},
			     $Vid->{'Crop'}->{'Height'},
			     $Vid->{'Crop'}->{'X'},
			     $Vid->{'Crop'}->{'Y'}
			     );
    
    return undef;
}

sub MEOpts {
    my $This = shift;
    my @O;
    push(@O, '-ss' => $This->{'-ss'} ) if $This->{'-ss'};
    push(@O, '-endpos' => $This->{'-endpos'} ) if $This->{'-endpos'};
    return @O;
}

package VMap::Copy;

use POSIX qw( :sys_wait_h floor );

sub New {
    my $Class = shift;
    my $In = shift;
    my $New;
    %$New = %$In;
    return bless $New,$Class;
}

sub MEOpts {
    my $This = shift;
    return ( '-ovc' => 'copy' );
}

package VMap::LAVC;

use POSIX qw( :sys_wait_h floor );

sub New {
    my $Class = shift;
    my $In = shift;
    my $New;
    %$New = %$In;
    return bless $New,$Class;
}

sub get_lavcopts {
    my $This = shift;
    my @O;
    my $That = $This->{'-lavcopts'};
    foreach (sort keys %$That) {
	if(exists($That->{$_})) {
	    push(@O, defined($That->{$_}) ? "$_=$That->{$_}" : $_ );
	}
    }
    return join(':',@O);
}

sub get_vop {
    my $This = shift;
    my @O;
    my $That = $This->{'-vop'};
    foreach (sort keys %$That) {
	if(exists($That->{$_})) {
	    push(@O, defined($That->{$_}) ? "$_=$That->{$_}" : $_ );
	}
    }
    return join(':',@O);
}

sub MEOpts {
    my $This = shift;
    my @O;
    push(@O, '-vop' => $This->get_vop) if $This->{'-vop'};
    return ( '-ovc' => 'lavc', '-lavcopts' => $This->get_lavcopts, @O );
}

sub set_VBitRate {
    my $This = shift;
    $This->{'-lavcopts'}->{'vbitrate'} = $This->{'vbitrate'} = int($_[0]);
}

package AMap::Copy;

use POSIX qw( :sys_wait_h floor );

sub New {
    my $Class = shift;
    my $In = shift;
    my $New;
    %$New = %$In;
    return bless $New,$Class;
}

sub MEOpts {
    my $This = shift;
    return ( '-oac' => 'copy' );
}

package AMap::MP3Lame;
use POSIX qw( :sys_wait_h floor );

# Make this an MP3LAME subclass of AMAP

sub New {
    my $Class = shift;
    my $In = shift;
    my $New;
    %$New = %$In;
    return bless $New,$Class;
}

sub get_lameopts {
    my $That = shift;
    my @O;
    foreach ('cbr','abr','br','vol','mode') {
	if(exists($That->{$_})) {
	    push(@O, defined($That->{$_}) ? "$_=$That->{$_}" : $_ );
	}
    }
    return join(':',@O);
}

sub MEOpts {
    my $This = shift;
    return ( '-oac' => 'mp3lame', '-lameopts' => $This->get_lameopts );
}

sub Bytes {
    my $This = shift;
    return $This->{'Bytes'} if $This->{'Bytes'};
    $main::VERBOSE && print "$0: MP3LAME Audio Bytes calculation defunct because 'br' not specified\n";
    return $This->{'Bytes'} = $This->{'Seconds'} * $This->{'br'}*1000/8;
}

package AVMap;
use Data::Dumper;
use POSIX qw( :sys_wait_h floor );

sub New {
    my $Class = shift;
    my $In = shift;
    my $New;
    %$New = %$In;
    return bless $New,$Class;
}

sub Init {
    my $This = shift;

    unlink "frameno.avi";

    if($This->{'AVInput'}->{'-endpos'}) {
	$This->{'VMap'}->{'Seconds'} = 
	  $This->{'AMap'}->{'Seconds'} = 
	  $This->{'AVInput'}->{'Seconds'}
	= $This->{'AVInput'}->{'-endpos'};
	# - $This->{'AVInput'}->{'-ss'} if format(endpos) is [[hh:]mm:]ss[.ms]
    }
}

sub EncodeAudio {
    my $Map = shift;
    
    print "$0: Encoding Audio...\n";

    my $VidMap = {
	$Map->{'AVInput'}->MEOpts,
	  $Map->{'AMap'}->MEOpts,
	  '-ovc' => 'frameno',
	  '-o' => 'frameno.avi'
    };

    my $PID = $Map->{'AVInput'}->MEMap($VidMap, *In, *Out);

    my %Sizes;
    while(<In>) {
	$main::DEBUG && print STDERR $_;
	if( /Error/i ) {
	    print STDERR $_;
	}

	if( /^(Audio|Video) stream:.*?size:\s*(\d+) bytes.*?(\d+(?:\.\d+)?)\s+secs/ ) {
#	    $Map->{substr($1,0,1) . 'Map'}->{"Bytes"} = $2 unless $1 eq 'Video';
	    $Map->{substr($1,0,1) . 'Map'}->{"Seconds"} = $3;
	}
    }
    close In;
    close Out;
    
    waitpid($PID,0);
    $main::DEBUG && print STDERR "$0 - EncodeAudio: Returned ",$?>>8,"\n";
    if($? >> 8) {
	die "$0 - EncodeAudio: Error!\n";
    }
    
    $Map->{'AMap'}->{'Bytes'} = -s 'frameno.avi';
    $main::DEBUG && print STDERR "$0 - EncodeAudio - Bytes(frameno) = ",int(-s 'frameno.avi'),"\n";
}

# calculdate bpp

sub round {
  my $v = shift;
  
  return floor($v + 0.5) != floor($v) ?
    floor($v + 0.5) :
    floor($v);
}

sub CalcBPP {
    my $Map = shift;
    
    my $cropped_unscaled_width = $Map->{'AVInput'}->{'Crop'}->{'Width'} || die "$0: CalcBPP needs AVInput->Crop->Width\n";
    my $cropped_unscaled_height = $Map->{'AVInput'}->{'Crop'}->{'Height'} || die "$0: CalcBPP needs AVInput->Crop->Height\n";
    my $AspectRatio = $Map->{'AVInput'}->{'AspectRatio'} || die "$0: CalcBPP needs AVInput->AspectRatio\n";
    my $FPS = $Map->{'AVInput'}->{'FPS'} || die "$0: CalcBPP needs AVInput->FPS\n";
    
    my $Kbps = $Map->{'VMap'}->{'vbitrate'} || die "$0: CalcBPP needs VMap->vbitrate\n";

# Corrected for non-DVD sources
    my $raw_aspect = $Map->{'AVInput'}->{'Unscaled Width'}/$Map->{'AVInput'}->{'Unscaled Height'};

    my $encoded_at = $AspectRatio;
    if ($encoded_at =~ /[\/\:]/) {
	my @a = split(/[\/\:]/, $encoded_at);
	$encoded_at = $a[0] / $a[1];
    }

    my $scaled_width = $cropped_unscaled_width * ($encoded_at / ($raw_aspect));
    my $scaled_height = $cropped_unscaled_height;
    
    my $picture_ar = $scaled_width / $scaled_height;
    
    $main::VERBOSE && printf("$0: Prescaled picture: %dx%d, AR %.2f\n", $scaled_width, $scaled_height, $picture_ar);

    my $min_bpp = $Map->{'VMap'}->{'Min BPP'} || 0;
    my $max_bpp = $Map->{'VMap'}->{'Max BPP'} || 1000;
    
    my %Scales;
    for (my $width = $Map->{'AVInput'}->{'Unscaled Width'}; $width >= 16; $width -= 16) {
	my $height = 16 * round($width / $picture_ar / 16);
	last unless $height;
	my $diff = round($width / $picture_ar - $height);
	my $new_ar = $width / $height;
	my $picture_ar_error = abs(1 - ($picture_ar / $new_ar));
	my $bpp = ($Kbps * 1000) / ($width * $height * $FPS);
	my $range = ($bpp > $max_bpp) ? 1 : (
					     ($bpp < $min_bpp) ? -1 : 0
					     );
	
	unshift(@{$Scales{$range}},
	     {
		 'Width' => $width,
		   'Height' => $height,
		   'Diff' => $diff,
		   'New AR' => $new_ar,
		   'AR Error' => $picture_ar_error,
		   'bpp' => $bpp,
		   'Scale' => $range
	     }
		);
    }

# 1. Look for biggest Min < bpp < Max
# 2. Failing that, perhaps all are bigger: look for smallest bpp > Max
# 3. Failing that, perhaps all are smaller: look for largest bpp < Min
    
    my @Scales;
    if(@{$Scales{0}}) {
	@Scales = @{$Scales{0}} = sort {$b->{'bpp'} <=> $a->{'bpp'}} @{$Scales{0}};
    }
    else {
	print STDERR "$0: WARNING - No matching scales.\n";
	if(@{$Scales{1}}) {
	    print STDERR "$0: WARNING - Choosing minimum with larger bpp\n";
	    @Scales = @{$Scales{1}} = sort {$a->{'bpp'} <=> $b->{'bpp'}} @{$Scales{1}};
	}
	elsif(@{$Scales{-1}}) {
	    print STDERR "$0: WARNING - Choosing maximum with smaller bpp\n";
	    @Scales = @{$Scales{-1}} = sort {$b->{'bpp'} <=> $a->{'bpp'}} @{$Scales{-1}};
	}
    }
    

    $Map->{'VMap'}->{'Scales'} = \%Scales;
#    print &Dumper(\%Scales); exit;
# !*!*!*!* Need to select best scale on basis of AR Error as well as bpp
    $Map->{'VMap'}->{'-vop'}->{'scale'} = $Scales[0]->{'Width'} . ':'. $Scales[0]->{'Height'};
   
    $main::VERBOSE && printf("$0: Scaling to %s @ %.2fbpp, %.2f AR & %d%% AR Error\n",
			     $Map->{'VMap'}->{'-vop'}->{'scale'},
			     $Scales[0]->{'bpp'},
			     $Scales[0]->{'New AR'},
			     int($Scales[0]->{'AR Error'}*100)
			     );
    return undef;
}

# Kbps = ( TotalMB*1024*1024 - Bytes ) / Seconds * (8 / 1000)
#  [ where Bytes=length(frameno.avi) and Seconds=Video.secs ]

sub settle_MediaSize {
    my $AVMap = shift;

#    if(exists $AVMAP->{'VMAP'}->set_VBitRate) {
    if(1) {
	$AVMap->{'VMap'}->set_VBitRate(
				       (
					( $AVMap->{'Media Size'} - $AVMap->{'AMap'}->Bytes )
					/
					$AVMap->{'VMap'}->{'Seconds'}
					/ 125
					)
				       );
    }
}

sub EncodeAV {
    my $Map = shift;
    
    print "$0: Encoding Video...\n";

    my $VidMap = {
	$Map->{'AVInput'}->MEOpts,
	  $Map->{'AMap'}->MEOpts,
	  $Map->{'VMap'}->MEOpts,
	  '-o' => $Map->{'-o'},
    };

    my $PID = $Map->{'AVInput'}->MEMap($VidMap, *InAV, *Out);

    my %Sizes;
    select(InAV); local $/ = "\r"; select(STDOUT);
    while(<InAV>) {
	next unless /^Pos:/s || $main::DEBUG;
	$main::VERBOSE && print STDERR $_;
    }
    $main::VERBOSE && print STDERR "\n";
    close InAV;
    close Out;
}

sub Encode {
    my $AVMap = shift;
   
    $AVMap->{'AVInput'}->Detect;

    if($AVMap->{'Passes'} == 3) {
	$AVMap->EncodeAudio();
    }

    $AVMap->settle_MediaSize;
    $AVMap->CalcBPP();

    $main::DEBUG && print &Dumper($AVMap),"\n";

    if($AVMap->{'Passes'} == 3) {
	$AVMap->{'VMap'}->{'-lavcopts'}->{'vpass'} = 1;
	$AVMap->{'AMap'} = AMap::Copy->New();
	$AVMap->EncodeAV();

	$AVMap->{'VMap'}->{'-lavcopts'}->{'vpass'} = 2;
    }
    $AVMap->EncodeAV();
}

package main;
use Data::Dumper;

$DEBUG = 1;
$VERBOSE = 1;

use Getopt::Long;

my $AVInput = AVInput->New(
			   {
			       'Input' => '/JFS/MC/MC.avi'
#			       'Input' => '-dvd 1'
#			       '-ss' => 15,
#			       '-endpos' => 5720
			       }
			   );

my $AMap = AMap::MP3Lame->New({ 'cbr' => undef, 'br' => 96, 'vol' => 1, 'mode' => 0});

my $VMap = VMap::LAVC->New(
			   {
			       'Min BPP' => 0.2,
			       'Max BPP' => 0.3,
			       '-lavcopts' => {
				   'psnr' => undef,
				   'vcodec' => 'mpeg4',
				   'vhq' => undef,
				   'v4mv' => undef,
				   'trell' => undef,
				   'vlelim' => -4,
				   'vcelim' => 7,
				   'lumi_mask' => 0.05,
				   'dark_mask' => 0.01
				   }
			   });

my $AVMap = AVMap->New(
		       {
			   'AMap' => $AMap,
			   'AVInput' => $AVInput,
			   'VMap' => $VMap,
			   '-o' => '/NewsNow/MC/MC2.avi',
			   'Media Size' => 737000000,
			   'Passes' => 3
			   }
		       );

print &Dumper($AVMap);

$AVMap->Init;
$AVMap->Encode;
exit;