#!/usr/bin/perl

use strict;
use CGI;
use CGI::Carp 'fatalsToBrowser';
use LWP::UserAgent;
use HTTP::Request;
use File::Temp qw/ tempfile /;
use URI;

my $MENCODER = "/usr/bin/mencoder";
my $TMP_DIR = "/var/www/html/video";
my $TMP_URL = "http://namonai.slc.ibnads.com/video";

my $cgi = new CGI;
my $ua = LWP::UserAgent->new;

my @src_urls = 
   (
    'http://testfiles.slc.ibnads.com/ads/',
    'http://testfiles.slc.ibnads.com/music/',
    'http://ibnfiles.ibnads.com/ads/',
    'http://ibnfiles.ibnads.com/music/'
    );

my @vcodecs = 
   (
    [ "DivX 3", "msmpeg4" ],
    [ "H263", "h263" ],
    [ "H263+", "h263p" ],
    [ "MPEG-1", "mpeg1video" ],
    [ "MPEG-2 (DVD)", "mpeg2video" ],
    [ "MPEG-4", "mpeg4" ],
    [ "Windows Media v1 (WMV7)", "wmv1" ],
    [ "Windows Media v2 (WMV8)", "wmv2" ]
    );
my $default_v = 6;  # wmv1

my @acodecs = 
   (
    [ "AC3", "ac3" ],
    [ "MP2", "mp2" ],
    [ "MP3", "mp3" ],
    [ "PCM (raw)", "pcm" ],
    [ "PCM (compressed)", "adpcm_ima_wav" ]
    );
my $default_a = 3; # pcm
    
my $file = $cgi->param('file');
my $rotate = $cgi->param('rotated');
my $width = 200;
if (defined ($cgi->param('width'))) {
   $width = 0 + $cgi->param('width');
}
my $vcodec = $cgi->param('vcodec');
if (defined($vcodec)) {
   if (defined $vcodecs[$vcodec]) {
      $default_v = $vcodec;
   } else {
      # illegal value
      $vcodec = undef;
   }
}
my $acodec = $cgi->param('acodec');
if (defined($acodec)) {
   if (defined $acodecs[$acodec]) {
      $default_a = $acodec;
   } else {
      # illegal value
      $acodec = undef;
   }
}

# start HTML
print
   $cgi->header .
   $cgi->start_html('Transmogrifier') .
   $cgi->h2('Video Transmogrifier Extraordinaire') . "\n";

print "<a href='http://en.wikipedia.org/wiki/Transmogrifier'>" .
   "<img src='/transmogrifier.gif' align='right' border='0' /></a>\n";

# convert file?
if (defined ($file) && defined($vcodec) && defined($acodec)) {
   transmogrify($file, $rotate, $width, $vcodecs[$vcodec], $acodecs[$acodec]);
}

# print form
print "<form method='post' action='cardboard_box.pl'>";
print "<table border='0' cellspacing='10'>\n";
print "<tr><td>Filename:</td><td><input type='text' name='file' value='$file' size=40 />" .
   "<i>eg: 12345678910.avi</i> or <i>http://foo.com/video.avi</i></i></td></tr>\n";
print "<tr><td>Rotate:</td><td><input type='checkbox' name='rotated' checked /></td></tr>\n";
print "<tr><td>Max Width:</td><td><input type='text' name='width' value='$width' value='$width' size=10 /></td></tr>\n";
print "<tr><td>Video</td><td><select name='vcodec'>\n";
for (my $i=0; $i<scalar(@vcodecs); $i++) {
   print "<option value='$i'";
   if ($i == $default_v) {
      print " selected";
   }
   print " />$vcodecs[$i]->[0]\n";
}
print "</select></td></tr>\n";
print "<tr><td>Audio</td><td><select name='acodec'>\n";
for (my $i=0; $i<scalar(@acodecs); $i++) {
   print "<option value='$i'";
   if ($i == $default_a) {
      print " selected";
   }
   print " />$acodecs[$i]->[0]\n";
}
print "</select></td></tr>\n";
print "</table>\n";
print "<p><input type='submit' value='Transmogrify!' /></p>\n";
print "</form>\n";

# print transmogrified files
my @files;
if (opendir (FILES, $TMP_DIR)) {
   while (my $dirent = readdir(FILES)) {
      next if ($dirent =~ /^\./);
      next unless ($dirent =~ /\.avi$/);
      push @files, $dirent;
   }
   closedir FILES;
} else {
   error ("Unable to readdir '$TMP_DIR': $!");
}
if (scalar(@files) > 0) {
   print "<h4>Recently transmogrified files</h4>\n";
   print "<ul>\n";
   foreach my $file (sort @files) {
      my @stats = stat("$TMP_DIR/$file");
      print "<li /><a href='$TMP_URL/$file'>$file</a> [" . $stats[7] . " bytes]\n";
   }
   print "</ul>\n";
}

print $cgi->end_html;
exit (0);

sub transmogrify {

   my ($file, $rotate, $width, $vcodec, $acodec) = @_;

   # sanity check file
   unless (($file =~ /avi$/i) ||
	   ($file =~ /mpg$/i) ||
	   ($file =~ /wmv$/i) ||
	   ($file =~ /mov$/i) ||
	   ($file =~ /mpeg$/i)) {
      error ("Unrecognized file type for '$file'");
      return;
   }

   # figure out if we have URL, or if we need to find the URL
   my $src = "";
   if ($file =~ /^http/i) {
      # have URL already; test
      $file = URI->new($file)->canonical;  # sanitize URL
      my $req = HTTP::Request->new(HEAD => $file);
      my $res = $ua->request($req);
      unless ($res->is_success) {
	 error("Unable to fetch URL '$file'");
	 return;
      }
      $src = $file;
   } else {
      # search for it
      $file =~ s/[^_0-9A-Za-z\.\-\[\]]//g;  # get rid of dangerous chars (http encode otherwise....)
      $src = find_src($file);
      if (!defined($src)) {
	 error("Unable to find file: $file");
	 return;
      }
   }

   if (defined ($vcodec) && 
       defined ($acodec) &&
       ($width > 0)) {
      $vcodec = $vcodec->[1];
      $acodec = $acodec->[1];

      # audio
      my $oac = "lavc";
      my $lavcopts = "acodec=$acodec:";
      if ($acodec eq "pcm") {
	 # don't use FFMpeg to encode audio...
	 $oac = "pcm";
	 $lavcopts = "";
      }

      print "<h4><i>Encoding '$src'...</i></h4>\n";

      # video
      $lavcopts .= "vcodec=$vcodec";

      # width
      my $vf = "scale=$width:-3";

      # rotation
      if (defined ($rotate)) {
	 $vf = "rotate=1,$vf";
      }

      # tempfile
      my @path_spec = split (/\//, $file);
      my $basename = $path_spec[$#path_spec];
      $basename =~ s/\..*$//;
      my ($fh, $tempfile) = tempfile($basename. "_XXXXXX",
				    DIR => $TMP_DIR, 
				    SUFFIX => ".avi");
      $fh->close();
      unlink $tempfile;

      # command line
      my @cmd = 
	 (
	  $MENCODER,
	  "-quiet",
	  $src,
	  "-vf", $vf,
	  "-oac", $oac,
	  "-ovc", "lavc",
	  "-lavcopts", $lavcopts,
	  "-of", "avi",
	  "-ofps", "3000/100",
	  "-o", $tempfile
	  );
      my $cmd = join (" ", @cmd);
      my $msg = $cmd . "\n" . `$cmd 2>&1`;
      my $exit_value = $? >> 8;
      if ($exit_value != 0) {
	 error("Encoding error", $msg);
	 return;
      }
      unless (-s $tempfile) {
	 unlink $tempfile;
	 error("Unable to transmogrify $file :-(", $msg);
	 return;
      }
      @path_spec = split (/\//, $tempfile);
      print "<h4>Finished encoding '<a href='$TMP_URL/" . $path_spec[$#path_spec] . "'>" . 
	 $path_spec[$#path_spec] . "</a>'</h4>\n";
   }
}

sub find_src {

   my $file = shift;

   use Net::HTTP;

   foreach my $src (@src_urls) {
      my $trial_url = $src . $file;
      my $req = HTTP::Request->new(HEAD => $trial_url);
      my $res = $ua->request($req);
      if ($res->is_success) {
	 return $trial_url;
      }
   }
   return undef;
}

sub error {
   my $msg = shift;
   my $reason = shift;
   print "<h2><font color='red'>$msg</font</h2>\n";
   if (defined $reason) {
      print "<p><pre>$reason</pre></p>\n";
   }
}