vcrtimer.pl

这个软件的功能同我上次传的那个avifile.也是linux上的一个用于多媒体应用的源码。

#!/usr/bin/perl -w
# vcrtimer.pl: v0.5 (20010601)
#  author: written by David Sobon <[e-mail]>
# license: GPL v2
###
# todo:
#	- date: Thur/2 after XX March 2001 (too non-standard?)
###

use strict;
use POSIX qw(strftime);
use vars qw(%conf $label %day @day %opts $error %sched);
use Time::Local;	# ???
use Getopt::Std;	# argument handling.

#####
##### DATA.
#####

# days in words, english, starting with 0 or sunday.
@day = (
	"sun(day)?",
	"m(on(day)?)?",
	"tue(s(day)?)?",
	"w(ed(nesday)?)?",
	"th(u(r(sday)?)?)?",
	"f(ri(day)?)?",
	"sat(urday)?"
);
# days in month.
my @dom	= (31,28,31,30,31,30, 31,30,31,30,31,30);

my $pidfile	= "/var/run/vcrtimer.pid"; # need root for this :(
my $date	= strftime("%Y%m%d", localtime());
my $now_d	= &get_day( strftime("%a", localtime() ) );
my $now_dom	= (localtime)[3];
my $now_m	= (localtime)[4];
my $now_y	= (localtime)[5];

# help argument handler.
if (grep /^\-\-help$/, @ARGV) {
    @ARGV	= grep !/^\-\-help$/, @ARGV;
    $opts{h}	= 1;
}
# todo: use long args.
&getopts('hlvw', \%opts);
&readConfig();
$opts{w}	= 1;
my $cronint	= &time2sec( $conf{global}{cron_interval} );

# help description.
if ($opts{h}) {
    print "Usage: vcrtimer.pl [opts]\n";
    print "Options:\n";
    print "\t-h | --help\tHelp\n";
    print "\t-l\t\tList programs\n";
    print "\t-v\t\tVerbose\n";
    print "\t-w\t\tShow warnings\n";
    exit 0;
}

### Checking...
if (!exists $conf{global}) {
    print "warn: no global label.\n";
    exit 1;
}

if (! -d $conf{global}{dir}) {
    print "warn: global dir ($conf{global}{dir}) does not exist.\n";
    # todo: attempt to create dir.
    exit 1;
}

### lets go for it.
foreach $label (keys %conf) {
    next if ($label eq "global");

    my($sec, $min, $hour, $day, $month, $year) = 0;
    my $duration	= 0;
    my $lerror		= 0;
    my @days;

    # disabled.
    if (&get_conf("disabled", $label) or &get_conf("disable", $label)) {
	&do_verb("$label is disabled.");
	next;
    }

    foreach ("time","channel","duration","date") {
	next if (exists $conf{$label}{$_});

	&do_warn("$_ is not defined for $label.");
	$lerror++;	# local error.
    }
    next if ($lerror);

    # handler: date.    
    if ($conf{$label}{date} =~ /^(\d+)\s+(\S+)\s+(\d+)$/) {
	# format: DD MMM YYYY
	$day	= $1;
	$month	= ($2 =~ /^\d+$/) ? $2 : &month2num($2);
	$year	= $3 - 1900;

    } elsif ($conf{$label}{date} =~ /^(\d+)\s+(\S+)$/) {
	# format: DD MMM
	$day	= $1;
	$month	= ($2 =~ /^\d+$/) ? $2 : &month2num($2);
	$year	= $now_y;

    } elsif ($conf{$label}{date} =~ /^(\S+)\s+(\d+)$/) {
	# format: MMM DD
	$month	= ($1 =~ /^\d+$/) ? $1 : &month2num($1);
	$day	= $2;
	$year	= $now_y;

    } else {
	# format: day-of-week.

	foreach ( split /,\s*/, $conf{$label}{date} ) {
	    if (/^(\S+)-(\S+)$/) {
		@days = &get_days($1,$2);
		next;
	    }

	    if (/^(\S+)$/) {
		$day = &get_day($1);
		next if ($day == -1);
		push(@days, $day);
	    }
	}

	if (!@days) {
	    &do_warn("$label: could not interpret date properly. ($conf{$label}{date})");
	    next;
	}
    }

    # handler: time.
    if ($conf{$label}{time} =~ /^(\d+):?(\d{2})(am|pm)$/i) {
	# format: HH:MMzz (12hours)
	$hour	= ($3 eq "am") ? $1 : $1 + 12;
	$hour	= 0 if ($hour == 24);
	$min	= $2;

    } elsif ($conf{$label}{time} =~ /^(\d+)(\d{2})$/)  {
	# format: HHMM, 24hours.
	$hour	= $1;
	$min	= $2;

    } else {
	&do_warn("$label: time $conf{$label}{time} is invalid.");
	next;
    }

    # handler: duration.
    $duration	= &time2sec( $conf{$label}{duration} );
    $conf{$label}{duration} = $duration;

    # sanity checking...
    $month	||= $now_m	unless (defined $month);
    if ($month < 0 or $month > 11) {
	&do_warn("month is invalid ($month)");
	next;
    }

    $year	||= $now_y	unless (defined $year);
    if ($year < 100 or $year > 200) {
	&do_warn("$label: year is invalid ($year)");
	next;
    }

    if ($hour > 23 or $hour < 0) {
	&do_warn("$label: hour is invalid ($hour)");
	next;
    }

    if ($min > 59 or $min < 0) {
	&do_warn("$label: min is invalid ($min)");
	next;
    }

    if ($sec > 59 or $sec < 0) {
	&do_warn("$label: sec is invalid ($sec)");
	next;
    }

    if ($duration < 1 or $duration > 60*60*24) {
	&do_warn("$label: duration is invalid ($duration)");
	next;
    }
    # end of sanity checking.

    # static date.
    if (!@days) {
	# sec, min, hour, day, month, year
	my $time = timelocal($sec, $min, $hour, $day, $month, $year);
	$sched{ $time } = $label;
	next;
    }

    # date checking: relative date.
    foreach (@days) {
	$day = $now_dom + $_ - $now_d;

	# I didn't think that this bug would happen - added after I
	# found that it did happen, heh.
	if ($day > $dom[$month]) {
	    my $was = $day;
	    $day -= $dom[$month];
#	    print "day = $was; now day = $day\n";

	    $month++;
	    if ($month > 11) {
		print "last day of year!\n";
		$month = 0;
		$year++;
	    }
	}

	my $time = timelocal($sec, $min, $hour, $day, $month, $year);
	$time += 60*60*24*7 if ($time - time() < -10*60);
	my $oldtime = $time;

	# evil time hack for conflicting programs.
	# shouldn't we warn about these?
	while (exists $sched{ $time }) {
	    $time += 0.1;
	}

	if ($time != $oldtime) {
	    &do_verb("$sched{$oldtime} overrides $label.");
	}

	if ($conf{$label}{disable}) {
	    &do_verb("hrm... $label is disabled...");
	    next;
	}

	$sched{ $time } = $label;
    }
}

# list the programs, -l flag.
if ($opts{l}) {
    foreach (sort { $a <=> $b } keys %sched) {
	$label		= $sched{$_};
	my $time	= $_;
	my $t		= time();

	if ( &get_conf("miss_if_xawtv",$label) ) {
	    print "$label: (MAYBE! only if xawtv is down)\n";
	} else {
	    print "$label:\n";
	}

	print "\tdate start: ".localtime($time)."\n";
	print "\tdate end  : ".localtime($time + $conf{$label}{duration})."\n";

	my $sleep = int($time - $t);
	if ($sleep < 0) {
		printf "\trecording?: %d s into program (%.01f%%).\n\n", 
			-$sleep, (100*-$sleep/$conf{$label}{duration})
	} else {
	     print "\ttime to go: $sleep s.\n\n";
	}
    }

    exit 0;
}

# lets do the checking...
foreach (sort { $a <=> $b } keys %sched) {
    $label	= $sched{$_};
    my $time	= $_;
    my $t	= time();

    my $sleep = int($time - $t);
    if ($sleep < 0) {
	printf "\trecording?: %d s into program (%.01f%%).\n\n", 
		-$sleep, (100*-$sleep/$conf{$label}{duration});
    }

    # ok, it was done.
    # WARN: race condition may occur here.
    if ($sleep < -60*10) {
	# this causes some minor problems unfortunately.
	&do_verb("over 10mins; skip.");
	next;
    }

    # get filename.
    my $dir	= &get_conf("dir", $label);
    $dir	= &evalstr($dir);
    my $file	= $dir;
    $file	.= "/" unless ($file =~ /\/$/);
    $file	.= $conf{$label}{filename};
    $file	=~ s/#DATE#/$date/g;

    # not sure whether this is safe.
    if (0 and &checkpid() ) {
	&do_verb("ok... it's still going, lets leave it alone.");
	last;
    }

    next if ($opts{v});
    next if ($sleep > $cronint);

    &do_print("$label:");
    &do_print("\t".localtime($time)." ($time) [1]");

    # methinks this exact check is done previously.
    if ( &checkpid() ) {
	print "WARN: PIDFILE ALREADY EXISTS.\n";
	last;
    }

    print "file => $file\n";
    &write_runpid();	# needed?
    if ($sleep > 0) {
	&do_print("ok... lets prepare sleeping ($sleep s)...");
	sleep $sleep;
    } else {
	print "hrm... no sleep required ($sleep s)\n";
    }

    my $z	= &kill_xawtv();
    if ($z) {
	# don't record if xawtv is found and miss_if_xawtv is found.
	print "ok... xawtv pid found... miss_if_xawtv also found.\n";
	unlink $pidfile if ( -f $pidfile);
	next;
    }

    $t	= time();	# lets reuse this var.
    if ($t - $time > 0 and $t - $time < 60*10) {
	if ( -f $file) {
	    print "hrm... already done that ($label)\n" if ($opts{v});
	    next;
	}
	my $miss = $t - $time;
	print "cool... we nearly missed something by $miss secs\n";
    }

    # todo: reimplement this in perl.
    if (! -d $dir and ! -e $dir) {
	system("/bin/mkdir -p --verbose $dir");
    }

    &write_runpid();
    &do_print("date start => ".localtime($t) );

    my $args	= "";
    $args	.= " --preset $conf{$label}{channel}";
    $args	.= " -t $conf{$label}{duration}\s ";
    $args	.= (&get_conf("vcr_args",$label) || "");
    my $x	= &get_conf("codec",$label);
    $args	.= " -P $x" if ($x);

    my $cmd	= &get_conf("pre_cmd", $label);
    if ($cmd) {
	$cmd		.= " >/dev/null" if (&get_conf("quiet", $label));
	system($cmd);		# pre exec.
    }

    &do_print("CMD: vcr $args $file");

    # quiet mode.
    if (&get_conf("quiet", $label)) {
	# sufficient?
	$file .= " >/dev/null";
    }
    system("vcr $args $file");

    $cmd	= &get_conf("post_cmd", $label);
    system($cmd) if ($cmd);	# post exec.

    &do_print("date end => ".localtime(time) );
    unlink $pidfile;

    system("sync");	# just for fun!
}

if ($error) {
    print "Found $error errors\n";
} elsif ($opts{v}) {
    print "no errors detected... cool!\n";
}

print "Done.\n" if ($opts{v});

exit 0;

###
### SUBS.
###

sub readConfig {
    foreach ("$ENV{HOME}/.vcrtimerrc", "/etc/vcrtimerrc") {
	my $rc = $_;
	next unless ( -f $rc);

	open(RC, $rc) or die "error: cannot open $rc\n";
    }

    if (!fileno RC) {
	print "error: could not find any conf files.\n";
	exit 1;
    }

    while (<RC>) {
	chop;

	next if (/^\s*$/);
	next if (/^\#/);

	if (/^\[(.*)\]$/) {
	    $label	= $1;
	    if (exists $conf{$label}) {
		&do_warn("warn: label $label already exists... skipping.");
		$label	= "";
	    }

	    next;
	}

	if (/^(\S+)[\s\t]+=[\s\t]+(.*)$/) {
	    $conf{$label}{$1} = $2 if ($label);
	    next;
	}

	&do_warn($_);
    }
    close RC;
}

sub month2num {
    # this looks like a mess but atleast it's static/low-level/simple.
    for (lc $_[0]) {
	return  0 if /^j(an(uary)?)?$/;
	return  1 if /^f(eb(ruary)?)?$/;
	return  2 if /^mar(ch)?$/;
	return  3 if /^a(pr(il)?)?$/;
	return  4 if /^may$/;
	return  5 if /^june?$/;
	return  6 if /^july?$/;
	return  7 if /^aug(ust)?$/;
	return  8 if /^sep(t(ember)?)?$/;
	return  9 if /^oct(ober)?$/;
	return 10 if /^nov(ember)$/;
	return 11 if /^dec(ember)$/;
    }

    &do_warn("month2num: should never happen.");
    return -1;
}

sub get_day {
    my($day) = @_;

    if (!defined $day or $day =~ /^\s*$/) {
	&do_warn("get_day: day == NULL.");
	return -1;
    }

    for(my$i=0; $i<=@day; $i++) {
	next unless ($day =~ /^$day[$i]$/i);
	return $i;
    }
    &do_warn("get_day: failed ($day)");

    return -1;
}

sub get_days {
    my($from,$to)	= @_;
    my $sday		= &get_day($from);
    my $eday		= &get_day($to);

    return undef if ($sday == -1 or $eday == -1);

    if ($sday == $eday) {
	&do_warn("sday == eday == $sday");
    }

    if ($eday < $sday) {
	# very nice solution, heh.
	return ($sday..6, 0..$eday);
    } else {
	return ($sday..$eday);
    }
}

sub time2sec {
    my($time)	= @_;
    my $sec	= 0;

    while ($time =~ s/^\s*(\d+|\d+.\d+)\s*(\D*)//) {
	my ($int,$str) = ($1,$2);

	# don't trust user; convert value to seconds for safety, heh.
	$sec += $int       if ($str eq "" or $str =~ /^s(ecs?)?$/i);
	$sec += $int*60    if ($str =~ /^m(in(ute)?s?)?$/i);
	$sec += $int*60*60 if ($str =~ /^h(r|ours?)?$/i);
    }

    return $sec;
}

sub write_runpid {
    if (!open PID, ">$pidfile") {
	print "error: could not open pid.\n";
	exit 1;
    }

    print PID "$$\n";
    close PID;
}

sub evalstr {
    my($str) = @_;
    my $x;

    for ($str) {
	# '#DATE#' => YYYYMMDD
	s/#DATE#/$date/g;

	# '#DAY#' => DDDday
	$x = strftime("%a", localtime() );
	s/#DAY#/$x/g;
    }

    return $str;
}

sub kill_xawtv {
    my $found	= 0;
    my $kill	= 0;
    my $miss	= 0;

    $miss++ if ( &get_conf("miss_if_xawtv",$label) );
    if ( &get_conf("kill_xawtv", $label) ) {
	$kill++;
    }

    return $found unless ($kill or $miss);

    opendir(PROC, "/proc");

    while ($_ = readdir PROC) {
	next unless ( -d "/proc/$_" );
	next unless ( -f "/proc/$_/cmdline" );

	open(CMD, "/proc/$_/cmdline");
	my $line = <CMD>;
	close CMD;

	next unless (defined $line and $line =~ /^xawtv/);

	if ($miss) {
	    print "debug: cmdline => '$line'.\n";
	    $found++;
	    last;
	}

	system("/bin/kill $_");	# -9 not needed?
    }

    closedir PROC;

    return $found;
}

sub do_warn {
    my($text) = @_;
    $error++;

    return unless ($opts{w});
    print "warn: $text\n";
}

sub get_conf {
    my($param, $label) = @_;

    return $conf{$label}{$param} || $conf{global}{$param};
}

sub checkpid {
    return 0 unless ( -f $pidfile );

#    my $t = (stat $pidfile)[9];

    open(PID, $pidfile);
    my $pid = <PID>;
    chomp $pid;
    close PID;

    if ( -d "/proc/$pid/") {
	return 1;
    }

    print "stale pidfile; removing.\n";
    unlink $pidfile;

    return 0;
}

sub do_verb {
    my($str) = @_;
    return unless ($opts{v});
    print "$str\n";
}

sub do_print {
    my($str) = @_;
    return unless (&get_conf("quiet", $label));
    print "$str\n";
}