#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Proc::Killfam;
use IPC::Open3;
require Tk::ProgressBar;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
$|++;
######### USER SETTINGS ################################# 
#set a default upload $url 
my $url = 'http://zentara.zentara.net/~zentara/cgi-bin/vblog/up.cgi';
# The way I do it, is have 2 directories called vblog, one in public_html, 
# which is where the files are actually deposited (must be mode 777), and 
# one in cgi-bin, which is password protected( by .htaccess ), and holds 
# the uploader cgi script. So you upload to cgi-bin/vblog/up.cgi, and it 
# writes the file to public_html/vblog.  
#working cgi files at 
# http://zentara.net/vblog/cgi.tgz

# if you wisely password protect the upload script directory with 
# an .htaccess file, use these settings for your username and password 
# Otherwise they can be ignored 
my $user = 'zentara';  #for authorization_basic 
my $pass = 'slackwhack';
                                  
#the actual video height and width 
my($width,$height) = (320,240);  #or (640,480) 
#the range inputs for v4l controls are 0 - 65535 
#but the mplayer controls are -100 to 100 
#so 0 is the default and corresponds to the midpoint 32768 
# I havn't messed with realtime changing of the settings, because 
# it must be done AFTER mplayer/mencoder starts with it's settings. 
# So if you don't like the brightness/contrast settings, stop the 
# script and change below. 
my $brightness = 40;
my $contrast = 0;
my $fps = 10;  #29.97 is default frames per second for ntsc video 
               #at 10 fps allow a second before quitting to get last frame 
               #The lower the fps, the more time you must allow before 
               #starting and stopping to allow catching the last frames. 
my $vbr = 100; #800 is HQ, 10 will give small files if you don't  
               #move around much :-) 
               #29.97fps at 100vbr is double size of 10fps, 100vbr      
               # 
#set recording default filename 
my $lt = localtime;
$lt =~ tr/ /_/;
my $mpg_out = $ENV{'USERNAME'}."-$lt.mpg";

####### END SETTINGS ######################################### 

my $filesize = 0;
my $pid; # pid used to control mplayer and mencoder 
my @options; # contains options for running mplayer 
my $timer;  #timer to update filesize while recording 
my $mic_on = 0;  #flag to track whether Mic is on or not  
my $progress = 0; #control for upload 
my $cancel = 0;   #control for upload 

#setup a shell thru IPC to carry out different  
# mixer and v4l2 control commands 
my $pidcon = open3(\*CON,0,0,'/bin/sh');

# the following initializes the v4l card for NTSC 
# this is not needed if the card was initialized 
# by running xawtv or something prior.....otherwise the 
# video is slightly out-of-sync on first run 
print CON "v4lctl setinput Composite1\n";
print CON "v4lctl setnorm NTSC\n";
#------------------------------------------------- 

$SIG{INT} = sub { &close_it_up };
$SIG{PIPE} = 'IGNORE';

my $mw = MainWindow->new(-background =>'black');

$mw->Tk::bind("<q>", sub{&close_it_up});
$mw->Tk::bind("<Escape>", sub{&close_it_up});
$mw->protocol('WM_DELETE_WINDOW' => sub {&close_it_up});

my $cframe0 = $mw->Frame(-background =>'black')
            ->pack( -fill =>'x');
my $cframe1 = $mw->Frame(-background =>'black')
            ->pack( -fill =>'x');
my $cframe2 = $mw->Frame(-background =>'black')
            ->pack( -fill =>'x');
my $cframe3 = $mw->Frame(-background =>'black')
            ->pack( -fill =>'x');

my $canv = $mw->Scrolled('Canvas',
     -bg => 'black',
     -borderwidth => 0,
     -highlightthickness => 0,
     -relief => 'sunken',
     -width =>  $width,
     -height => $height,
     -scrollregion=>[0,0,$width,$height],
     -scrollbars=>'osoe',
     )->pack();

my $contWidth = $width;
my $contHeight = $height;

## this Frame is needed for including the window in Tk::Canvas 
my $Container = $canv->Frame(-container => 1);

my $xtid = $Container->id();
# converting the id from HEX to decimal as xterm requires a decimal Id 
my ($xtId) = sprintf hex $xtid;

my $dcontitem = $canv->createWindow(10,10,
   -anchor=>'nw',
   -window => $Container,
   -width => $contWidth,
   -height => $contHeight,
   -state => 'hidden',
    );

my $rec_but = $cframe0->Button(-text => 'Record',
             -padx => 0,
             -bg=>'hotpink',
             -command => sub{
                 &make_rec;
             })->pack(-side =>'left',-padx=>5 );

my $send_but = $cframe0->Button(
             -text => 'Send It',
             -background => 'lightblue',
             -state => 'disabled',
             -padx => 0,
            -command => sub{&send_it($url,$mpg_out) } )
             ->pack(-side=>'left', -padx =>5 );

my $can_but = $cframe0->Button(
             -text => 'Cancel/Restart',
             -background => 'yellow',
             -state => 'disabled',
             -padx => 0,
            -command => sub{&restart} )
             ->pack(-side=>'left', -padx =>5 );

$cframe0->Button(-text => "Exit",
             -padx => 0,
            -command => [sub{&close_it_up}] )
             ->pack(-side=>'left', -padx =>5 );

$cframe0->Label(-text => 'Size: ',
                -background => 'black',
                -foreground=>'yellow',
              )->pack(-side=>'left',-padx=>0 );

my $size_lab = $cframe0->Label(
               -textvariable => \$filesize,
               -background => 'black',
               -foreground=>'yellow',
              )->pack(-side=>'left',-padx=>0 );

$cframe1->Label(-text => 'Upload To:',
               -background=>'#e0c3ff',
              )->pack(-side=>'left',-padx=>0 );

my $email_ent = $cframe1->Entry(
               -textvariable => \$url,
               -width => 50,
               -background=>'#e0c3ff',
               )->pack(-side=>'left',-padx=>0 );

$cframe2->Label(-text => ' Filename:',
               -background=>'#eed8e8',
              )->pack(-side=>'left',-padx=>0 );

my $nam_ent = $cframe2->Entry(
               -text => \$mpg_out,
               -width => 50,
               -background=>'#eed8e8',
               )->pack(-side=>'left',-padx=>0 );

my $messsage = $cframe3->Label(
                -text => 'When recording is stopped, looping playback continues until Send/Cancel',
                -background => 'black',
                -foreground => 'lightgreen',
                 )->pack(-expand=>1 );
#################################################### 
#################################################### 
# frame for displaying upload progress  
my $cframe4 = $mw->Frame(-background =>'black');
my $cframe5 = $cframe4->Frame(-background =>'black')
            ->pack();

$cframe5->Label(
         -background => 'black',
         -foreground => 'green',
         -width => 4,
         -textvariable => \$progress,
         )->pack(-side =>'left');

$cframe5->Label(
         -background => 'black',
         -foreground => 'green',
         -text => '%',
         )->pack(-side =>'left');

my $pb = $cframe5->ProgressBar(
          -length => 350,
          -width  => 20,
          -from   => 0,
          -to     => 100,
          -blocks => 100,
          -colors => [ 0, 'green',100 ],
  )->pack( -side => 'left',-padx => 10);
############################################################## 

my $text = $cframe4->Scrolled("Text",
                -height => 5,
                -width => 30,
                -background => 'black',
                -foreground => 'yellow',
         )->pack( -expand => 1, -fill => 'both' );

my $bframe = $cframe4->Frame(
            -background => 'grey45' )->pack( -fill => 'x' );

my $cancel_but;
$cancel_but = $bframe->Button(
         -text       => 'Cancel',
         -background => 'lightgreen',
         -command    => sub {
                           $cancel = 1;
                           $pb->value(0);
                         })->pack(-side => 'left', -padx => 20);


$bframe->Button( -text => 'Close',
             -background => 'lightblue',
             -command  => sub {
                   $cframe4->packForget;
                 }
             )->pack(-side =>'right',-padx => 20);

&start_player;

MainLoop();
######################################################### 
 sub start_player{
  @options = (
                '-slave','-loop 0', '-zoom',
                "-x $contWidth", "-y $contHeight",
                 '-really-quiet',
                 "-wid $xtId",
 "tv:// -tv driver=v4l2:device=/dev/video0:input=1:".
 "brightness=$brightness:contrast=$contrast:".
 "fps=$fps:norm=ntsc:amode=0:".
 "width=$width:height=$height",
               );

  $pid = open(MP, "| mplayer @options >/dev/null 2>&1 ");
  $canv->itemconfigure($dcontitem,-state => 'normal');

}
############################################################## 
sub display_rec {
     #stop mencoder so mplayer can grab stream   
     killfam 9, $pid;
     @options = (
                '-slave','-loop 0', '-zoom',
                "-x $contWidth", "-y $contHeight",
                 '-really-quiet',
                 "-wid $xtId",
               );

 $pid = open(MP, "| mplayer @options $mpg_out >/dev/null 2>&1 ");

 $mw->configure(-title=>$mpg_out);

 $send_but->configure(-state=>'normal');
 $can_but->configure(-state=>'normal');

 }
################################################################## 
sub make_rec{
 $rec_but->configure(
         -text=>'  Stop ',
         -command => sub{
            $rec_but->configure(-state=>'disabled');
            $timer->cancel;
            &display_rec;
          });

      #pause instead of quit will leave a snapshot on screen 
      syswrite(MP, "pause\n");
      killfam 9, $pid;
      close MP;

 my @enc_opts =(
  # set output file name 
  "-o $mpg_out",
  # set video codec.. "mencoder -ovc help",  
  #vbitrate=800 for minimum compression, 10 is 'pixelized' 
  "-ovc lavc -lavcopts vcodec=mpeg4:vbitrate=$vbr",
  #set recording video source to tv, v4l must have been initialized 
  # input=0 is tv, input=1 is camera(Composite1) 
  "tv:// -tv driver=v4l2:device=/dev/video0:input=1:".
  "brightness=$brightness:contrast=$contrast:".
  "fps=$fps:norm=ntsc:amode=0:".
  "width=$width:height=$height",
  # set audio codec..see "mencoder -oac help" for audio options 
  "-oac lavc");

  $pid = open(MENC, "mencoder @enc_opts  >/dev/null 2>&1  | ");
  sysread MENC,my $buf,0; #avoid warning about MENC used only once 

  &mic_con(1); #turn on Mic 

  #start filesize watcher 
  #only approximate  
  $timer = $mw->repeat(500, sub{
      if(-e $mpg_out){
      $filesize = (sprintf '%d', ((stat($mpg_out))[7])/1024) . 'k'
           }});
}
################################################################### 
sub stop{
       killfam 9, $pid;
}
################################################################# 
sub close_it_up{
&stop;
&mic_con(0); #restore Mic settings 
select(undef,undef,undef,.5); #small delay to allow mixer resetting 
exit;
}
######################################################################## 
sub restart{
  killfam 9, $pid;
  my $lt = localtime;
  $lt =~ tr/ /_/;
  $mpg_out = $ENV{'USERNAME'}."-$lt.mpg";
  $mw->update;
  $send_but->configure(-state=>'disabled');
  $can_but->configure(-state=>'disabled');

  $rec_but->configure(
         -text=>'Record',
         -state=>'normal',
         -command => sub{
                    &make_rec;
           });

 $filesize = 0;
 &start_player;

}
####################################################################### 
sub mic_con{
  my $con = shift;

  if($con == 1){  #turn Mic on to max for recording 
    #turn off playback to avoid feedback squeal 
    print CON "amixer cset name='AC97 Playback Volume', 0\n";
    #switch the capture to Mic 
    print CON "amixer sset Mic Capture cap\n";
    #turn up maximum Mic gain 
    print CON "amixer cset name='Mic Playback Volume', 100\n";
    #turn on Mic +20db boost 
    print CON "amixer cset name='Mic Boost (+20dB)', 1\n";
  }

  if($con == 0){  #restore old Line settings 
    #turn off Mic by changing capture to Line 
    print CON "amixer sset Line Capture cap\n";
    #turn off Mic +20db boost 
    print CON "amixer cset name='Mic Boost (+20dB)', 0\n";
    #restore normal capture volume     
    print CON "amixer cset name='AC97 Playback Volume', 88\n";
  }
}

################################################################### 
sub send_it{
    $cframe4->pack;
    $cancel_but->configure(-state=>'normal');

    my $file = $mpg_out;
    my $size = -s $file;
    my $tot = 0;
    $pb->value(0);
    $progress = 0;
    my $start = time;
    my $starttime = scalar localtime;
    my $message =
    "\n\n\nUploading $file , size $size to\n$url\n  at $starttime\n ";

    $text->insert('end', $message);
    $text->see('end');

    $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
    my $ua = new LWP::UserAgent;

    my $req = POST $url,
      Content_Type => 'multipart/form-data',
      Content      => [ file => [$file] ];

    $req->authorization_basic($user, $pass);

    my $gen = $req->content();
            die unless ref($gen) eq "CODE";

    $req->content(
        sub {
            my $chunk = &$gen();
            if (defined $chunk){ $tot += length($chunk) }
            $progress = int(($tot/$size) *100);

            if($cancel){goto END}

            $pb->value($progress);
            $mw->update;
            return $chunk;
        }
    );

    my $res = $ua->request($req);   #do it 

    if ( $res->is_success ) {
        $text->insert('end', $res->as_string);
    }
    else {
        $text->insert('end',$res->status_line);
    }


END:
$cancel_but->configure(-state=>'disabled');
my $condition = 'Finished';

 if($cancel){
     $condition = 'CANCELLED';
     $cancel = 0;
     $file = '';
 }

 my $diff = time - $start;
 my $endtime = scalar localtime;

 $message =
    "$condition $file, at $endtime  total time = $diff seconds\n\n\n ";

     $text->insert('end', $message);
     $text->see('end');

undef $ua;

}