#!/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_h
+tml,
# which is where the files are actually deposited (must be mode 777),
+and
# one in cgi-bin, which is password protected( by .htaccess ), and hol
+ds
# 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 f
+rame
#The lower the fps, the more time you must allow before
+
#starting and stopping to allow catching the last frame
+s.
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;
}
|
