#!/usr/bin/perl

package main;
########################################################################
# Set debug to 1 to enable debug output and suppress sleeping as well
# as calls to the actual devices.  Look for additional print
# statements throughout the code that are commented out if you
# want even more output at stragically important places!
########################################################################
our $debug = 0;
our $RECORDING_DEVICE;
init();

my $henrys_channel_recording_changer =
sub {
  my $what = shift;
  my $where = ("@ARGV" =~ m/directv/) ? 'living' : 'office';
  #print "In $where do $what\n";
  print `/home/henry/tv/chan $where $what`;
};

$RECORDING_DEVICE->run_state
  ( $henrys_channel_recording_changer  );
$RECORDING_DEVICE->run_channel
  ( $henrys_channel_recording_changer  );

########################################################################
########################################################################
#
#            No user servicable parts below this section
#
########################################################################
########################################################################

=head1 NAME control_tv_recording


=head1 SYNOPSIS

 control_tv_recording [filenames]
 default for filenames is shows.txt
 use -d option to turn on debugging
 use -w option to get a weekly summary of the amount of
               recording tape needed for this week

Use the output of the tv_check program in the XMLTV package to run a
satellite receiver and vcr to record your favorite programs.  Minimal
user intervention is required.

=head1 DESCRIPTION

I hate commercials.  I also hate being required to be at a specific place
at a specific time in order to watch one of my favorite TV programs, so I
record everything and watch it later.  Recently I discovered the excellent
XMLTV package at L<http://sourceforge.net/projects/xmltv/>.  This program
uses the ouput of the F<tv_check> program as input to control whatever
devices you have to record what you want to watch.  You will need to write
at least two (hopefully small) programs that change the channel for you and
control the recording device.  Then you should edit the output of
F<tv_check> to only include the lines of the tv programs you want to watch.
Feed that file to control_tv_recording in an xterm window, (or use nohup)
and be sure to remember to change tapes as needed.

Additional wrinkles:

I extended the syntax that you can feed to this program just a little.
If you replace the mmdd field that tv_check outputs with the keyword
B<weekly> then this event will be set to go off at the same time every
week.  Also, if in the program description you put the words B<channel
only> then only the channel will change, the recorder will not be
issued the I<record> and I<stop> commands.  I use this to set up my
weekly recording schedule, and then check out the tv_check output to
see if there are any differences and just include those as an extra
file on the input line.  Here are some examples of input that would be
acceptable to this program:

 Sat 0914 2205/60 Channel 386 ABCB The Practice "Target Practice"

Record on September 14 of this year at 10:05PM for 1 hour on channel 386.
Note that the I<Sat> field is ignored in this case.

 Wed weekly 1800/60 Channel 654 WSBK Enterprise "Shockwave" 2/2

Record every Wednesday from 6-7PM on channel 654

 Mon weekly 1300/60 Channel 387 All my Children channel only
 Tue weekly 1300/60 Channel 387 All my Children channel only
 Wed weekly 1300/60 Channel 387 All my Children channel only
 Thu weekly 1300/60 Channel 387 All my Children channel only
 Fri weekly 1300/60 Channel 387 All my Children channel only

Change the channel to 387 every weekday at 1PM.  Nothing will happen
at 2PM.  The program does not try to I<restore> the previous channel.

My setup:

I have a starchoice receiver in my office and a directv receiver in the
living room.  Both have a Phillips VCR next to them.  I'm using an
B<IRLINC> device, which can be programmed with IR commands from
your existing remotes.  It receives X-10 commands and plays back the
associated IR command.  I'm also using B<Powerlinc> devices with translates
RS-232 input into X-10 output.  The system is contolled by an old laptop that
runs 24 hours a day.  The B<IRLINC> and B<Powerlinc> devices are available
from L<http://www.smarthome.com> for $120 and $33 (September 2002 prices)
respectively.

At this point, let me point you to L<http://www.misterhouse.com>, which has
some great software for controlling X-10 devices.  You will need to write
the programs that send the change channel and start/stop recording commands
to your devices.  In my case, both of these programs are called I<chan> and 
take as parameters the keywords I<office> or I<living>, as well as a
I<number> to change the channel or the words I<record stop play> to control
the vcr.  Once you have written these programs, pass a reference to them to
the methods C<run_state> and C<run_channel> as shown above.

=head1 REQUIRES

 Class::Date
 Class::MethodMaker
 Getopt::Std;


=head1 AUTHOR

 Henry Laxen <nadine.and.henry@pobox.com>
 http://www.maztravel.com/perl

=head1 SEE ALSO

 http://sourceforge.net/projects/xmltv/
 http://membled.com/work/apps/xmltv/
 http://www.misterhouse.com/


=head1 PACKAGES


=cut

use strict;

package Event;
use Class::Date qw(:errors date now );

=head2

B<The Event package> encapsulates the notion of an tv program event, which
has a start and stop time, a channel number, and perhaps a program
description.

=cut


use Class::MethodMaker
  new_hash_init => 'new',
  get_set => [ qw( start end duration channel program)]; 

=item overlap($event1,$event2) or $event1->overlap($event2)

Return true if the two events overlap.  Events are considered as
intervals which are closed on the left, and open on the right.  In
math notation this is [0,1).  Thus the intervals [0,1) and [1,2)
do B<not> overlap.

=cut

sub overlap {
  my ($first,$second) = $_[0]->start < $_[1]->start ?
    @_[0,1] : @_[1,0];
  return ! ($first->end <= $second->start);
}

=item $event->inside($date)

Return true if the C<$date> argument is inside the start, end
interval of the event.

=cut

sub inside {
  my ($self,$date) = @_;
  return $self->start <= $date && $date < $self->end;
}

=item $event->as_text

Return a string that represent the event in human readable form.

=cut

sub as_text {
  my $self = shift;
  return sprintf("%s - %s on %s:  %s\n ",
	  $self->start,$self->end,$self->channel,$self->program);
}

=item next_event($array_of_events_reference,$time)

The C<array_of_events> must be sorted in start time order.  Does a
binary search on the array and returns the next event to consider.
If the $time is inside the event interval, then that event is
returned, otherwise the event previous to that time is returned.

=cut

sub next_event {
  my ($events,$time) = @_;
  return 0 if $time <= $events->[0]->start;
  return $#$events if $time >= $events->[$#$events]->start;
  return if $time >= $events->[$#$events]->end;
  my ($start,$end) = (0,$#$events);
  my $midpoint;
  while (1) {
    last if $start > $end;
    $midpoint = int(($start + $end) / 2);
    last
      if $events->[$midpoint]->start <= $time &&
  	 $time < $events->[$midpoint+1]->start;

    if ($events->[$midpoint]->start <= $time) {
      $start = $midpoint + 1;
      # print " up $start ";
    } else {
      $end = $midpoint - 1;
      # print " down $end "
    }
  }
  die "Binary search failed\n" if $start > $end ;
  return $midpoint;
}


=item $event->sleep_for($time);

Returns the number of seconds to sleep for either the
beginning or end of the the current event, depending on the
time passed as an argument.  Issues a warning if the event
should have already occurred.

=cut

sub sleep_for {
  my ($event,$time) = @_;
  my $sleeptime;
  if ($time < $event->start) {
    $sleeptime = $event->start - $time;
  } elsif ($time <= $event->end ) {
    $sleeptime = $event->end - $time;
  } else {
    warn "Can't sleep: ",$event->end, " is after ", $time, "\n";
    $sleeptime = 0;
  }
  return $sleeptime;
}

=item calculate_tape_needed($array_of_events_reference,$time,$interval,$span)

Calculate the sum of the durations of the events that fall into an
as specified interval (usually 1 day) and for a specified span
of time (usually 1 day or 1 week) and return the result as an array.

=cut

sub calculate_tape_needed {
  my ($events,$time,$interval,$span) = @_;
  $time = now unless defined $time;
  $interval = '1D' unless defined $interval;
  $span = $interval unless defined $span;
  my $next_event_index = next_event($events,$time);
  my @totals;
  my $start_time = $time;
  while ($start_time < $time+$span ) {
    my $end_time = $start_time + $interval;
    my $total = 0;
    for (my $i = $next_event_index; $i<=$#$events; $i++) {
      $total += $events->[$i]->duration
	if $events->[$i]->start >= $start_time &&
	  $events->[$i]->start < $end_time &&
	    $events->[$i]->program !~ /channel only/;
      last if $events->[$i]->start > $end_time;
    }
    $start_time = $end_time;
    push @totals,$total;
  }
  return \@totals;
}



package Schedule;

=head2

B<The Schedule package> reads and parses the file produced by
tv_check and creates an array of events.  Should you wish to
parse a file with a different format, you may only need to
modify the regular expression that describes each line of the
file.  The current regex looks like this:

   ^\s*                # maybe leading whitespace
   (\w+)\s+            # the day of the week
   (weekly | \d{4})\s+ # either weekly or mmdd
   (..)                # the hour
   (..)/               # the minute
   (\d+)\s+            # the duration in minutes
   (?:Channel\s+)?     # maybe the word Channel
   (\d+)\s+            # the channel number
   (.*)$               # the program description


=cut

use Class::Date qw(:errors date now );

my $schedule_re = qr {

   ^\s*                # maybe leading whitespace
   (\w+)\s+            # the day of the week
   (weekly | \d{4})\s+ # either weekly or mmdd
   (..)                # the hour
   (..)/               # the minute
   (\d+)\s+            # the duration in minutes
   (?:Channel\s+)?     # maybe the word Channel
   (\d+)\s+            # the channel number
   (.*)$               # the program description
  }x;

my ($weekday, $month_day, $hour, $minute, $duration, $channel, $program);
my ($month,$day);
my @order = (0,1,2,3,4,5,6);

my %weekdays;
@weekdays{ qw ( sun mon tue wed thu fri sat ) } = (0..6); #)

=item schedule_changed(@array_of_file_names)

Compare the modification times of each of the files in the array
to their previous modification times, and return true if any
of them changed.  Also sets the package global variable
C<$Schedule::changed> to that value.

=cut


my %modification_times;
our $changed;
sub schedule_changed {
  $changed = 0;
  foreach my $file (@_) {
    $changed = 1 if ! exists $modification_times{$file} || 
      -C $file != $modification_times{$file};
    $modification_times{$file} = -C $file;
  }
  return $changed;
}

=item read_schedule

Reads all of the files in @ARGV and returns an array of events
sorted in event starting time order.

=cut


my @events;
sub read_schedule {
  return \@events unless schedule_changed(@ARGV);
  @events = ();
  my @argv = @ARGV;
  my $year = (localtime(time))[5] + 1900;

  while (<>) {
    chomp;
    next unless $_;
    next if m/^#/;
    my @fields = m/$schedule_re/;
    ($weekday, $month_day, $hour, $minute, $duration, $channel, $program) =
      @fields[@order];
    if ($month_day eq 'weekly') {
############################################################################
#
#  This section is a little tricky.  We need to compute the next
#  occurance of a weekly event.  So we need to see if the current
#  time is after the end of this event, and if so, add 7 days to it.
#  Now unless today happens to be the weekday in question, $difference
#  will be non-zero, and hence $then = $now + "$difference D" will
#  be in the future.  However if $difference is 0, then we add the
#  duration of the event to $then, and add another 7 days if it
#  already happened.  This should even handle year boundarys!
#
###########################################################################
      my $now = now;
      my $weekday_now = $now->_wday;
      my $difference = $weekdays{lc($weekday)} - $weekday_now;
      $difference += 7 if $difference < 0;
      my $then = $now + "$difference D";
      $then = date [ $then->year, $then->month, $then->day,
		     $hour,$minute,0];
      $then += $duration * 60;
      $then += '7 D' if $then < $now;
      ($year,$month,$day) = ($then->year, $then->month, $then->day);
    } else {
      $month = substr($month_day,0,2);
      $day = substr($month_day,2,2);
    }
    $program =~ s/\s+/ /;
    #print "$month,$day,$hour,$minute,$duration,$channel,$program\n";
    my $start = date [$year,$month,$day,$hour,$minute,0];
    $duration = new Class::Date::Rel{ min => $duration};
    my $end = $start + $duration;
    my $event = new Event(
			  start => $start,
			  end => $end,
			  duration => $duration,
			  channel => $channel,
			  program => $program);
    push @events, $event;
  }
  @events = sort { $a->start <=> $b->start } @events;
  for (my $i = 0; $i < @events - 1; $i++) {
    my $j = $i+1;
    print "Events $i and $j overlap\n" ,
      $events[$i]->as_text,$events[$j]->as_text,
	'-' x 72,"\n"
      if Event::overlap($events[$i],$events[$j]);
  }
  #map {print $_->start,'--',$_->end,$_->program,"\n"} @events;
  @ARGV = @argv;
  return \@events;
}


package TV_Device;

=head2

B<The TV_Device package> is the interface to the hardware, ie, the actual
program receiver (cable, satellite) and recording device (VCR, DVD-RW) and
this software.

=cut


use Class::MethodMaker
  new_with_init => 'new',
  get_set => [ qw(  run_state run_channel debug )];

sub init {
  my $self = shift;
  $self->{state} = undef;
  $self->{channel} = undef;
  $self->run_state(sub { die "vcr run state undefined\n"});
  $self->run_channel(sub { die "vcr run channel undefined\n"});
  $self->debug($::debug) if defined $::debug;
}

=item $device->valid_states(@array_of_valid_commands)

Set up or return a reference to a hash of valid commands that
can change the state of the device

=cut

sub valid_states {
  my $self = shift;
  return $self->{valid_states} unless @_;
  my %valid;
  @valid{@_} = ();
  $self->{valid_states} = \%valid;
}

=item $device->state($new_state)

Changes the state of the device to the C<$new_state>, or returns
the current state if called without an argument.  The state is only
changed if it is different from the current state.  Sleeps for 1 second
after the state change (X-10 devices like this)

=cut

sub state {
  my ($self,$new_state) = @_;
  if (@_ == 2) {
    warn "Invalid state $new_state\n" 
      unless exists $self->valid_states->{$new_state};
    if (!defined $self->state || $new_state ne $self->state) {
      $self->{state} = $new_state;
      $self->debug ? print "Changing state to $new_state\n" :
	&{$self->run_state}($new_state);
      sleep(1);
    }
  } else {
    return $self->{state};
  }
}

=item $device->channel($new_channel)

Changes the channel of the device to the C<$new_channel>, or returns
the current channel if called without an argument.  Issues a warning if
the channel is not numeric.  The channel is changed unconditionally.

=cut

sub channel {
  my ($self,$new_channel) = @_;
  if (@_ == 2) {
    warn "Invalid channel $new_channel\n" unless $new_channel =~ /^\d+$/;
    $self->{channel} = $new_channel;
    $self->debug ? print "Changing channel to $new_channel\n" :
      &{$self->run_channel}($new_channel);
    sleep(1);
  } else {
    return $self->{channel};
  }
}

package Timer;

=head2

B<The Timer package> isn't really needed, but is very useful for
debugging.  One problem with testing this program is that you don't
really want to wait for events to occur.  By using the Timer package
we can simulate the actual passage of time without waiting for all
the C<sleep> calls to finish.

=cut

use Class::Date qw(:errors date ); #w
use Class::MethodMaker
  new_with_init => 'new',
  get_set => [ qw( time debug )]; 

sub init {
  my $self = shift;
  $self->time(CORE::time);
  $self->debug($::debug) if defined $::debug;
}

=item $timer->sleep($amout)

Go to sleep for the specified amount of time.  Return the current
time after waking up.

=cut

sub sleep {
  my ($self,$amount) = @_;
  CORE::sleep($amount) unless $self->debug;
  print "Sleeping for $amount\n" if $self->debug;
  $self->time($self->time + $amount);
  return $self->now;
}

=item $timer->now

Returns the current time as a Class::Date object.

=cut

sub now {
  my $self = shift;
  return date $self->time if $self->debug;
  $self->time(CORE::time);
  return date $self->time;
}


package main;

=head2

B<The main program> does the job of reading the schedule,
calculating the next event to process, and issue the device
commands to drive the hardware.  There are two parameters that
you can conceivable set to change the behaviour.  These are:

$MIN_GAP_TIME = 3;  # in seconds

Set this to the I<slop factor> that determines when an event
starts and stops.  If your machine happens to be heavily loaded
when a sleep is scheduled to wake up, the actual time we woke
up may not be the exact time of the event.  We thus test if the
current time is within C<$MIN_GAP_TIME> of the start or stop times
of the event to determine if this is the event we need to process.

$MAX_SLEEP_TIME = 60 * 10; # in seconds

Every time this program wakes up, it rereads the Schedule file
to see if anything changed.  Thus to make changes to your schedule,
all you need to do is edit that file.  The problem is that sometimes
the next program you want to record is days away.  Setting the
C<$MAX_SLEEP_TIME> to a non-zero value means the program will wake up
at least that often, and reread the Schedule file for any changes.  Setting
it to zero disables this feature.

=cut

use Class::Date qw(:errors date now );
use Getopt::Std;

our ($opt_d,$opt_w);

sub init {
  getopt('');
  $debug = 1 if defined $opt_d;

  $RECORDING_DEVICE = new TV_Device();
  $RECORDING_DEVICE->valid_states(qw(stop record));

  push @ARGV,'shows.txt' unless @ARGV;
  $|++;
}

=item as_hms($seconds)

Return a string in the hh:mm:ss format
based on the number of seconds

=cut

sub as_hms {
  my $secs = shift;
  my $hour = int($secs/(60*60));
  my $min =  int(($secs - $hour*(60*60))/60);
  my $sec =  $secs % 60;
  return sprintf ("%02u:%02u:%02u",$hour,$min,$sec)
}

if ($opt_w) {
  # print out how much tape will be needed this week
  # make it easy to know when to change tapes
  my $events = Schedule::read_schedule();
  my $time = now;
  my $interval = '1D';
  my $tape =Event::calculate_tape_needed($events,$time,$interval,'7D');
  print "Tape required for this week is\n";
  foreach my $amount (@$tape) {
    printf ("   %-10s %s\n", $time->wdayname,as_hms($amount))
      if $amount;
    $time += $interval;
  }
  exit(0);
}


my $MIN_GAP_TIME = 3;		# in seconds
my $MAX_SLEEP_TIME = 60 * 10;	# in seconds  set to 0 for long naps

my $this_day = -1;
my $TIME = new Timer();
my $previous_event;
while ( 1 ) {
  my $events = Schedule::read_schedule();         # Reread schedule files
  my $now = $TIME->now;
  # Once a day, or when the schedule changes, tell the user how much
  # tape should be in the machine.
  print "Tape required for next 24 hours is: ",
    as_hms(Event::calculate_tape_needed($events,$now,'1D','1D')->[0]),"\n"
    if $Schedule::changed || $this_day != $now->day;
  $this_day = $now->day;
  # print "Now is $now\n";
  my $next = Event::next_event($events,$now);     # get the next one
  last unless defined $next;                      # no more, leave loop
  $next++ if $events->[$next]->end < $now;        # That one is over, get next
  my $event = $events->[$next];
  my $next_start = $event->start - $now;
  my $next_end = $event->end - $now;
  my $channel_only =                              # Are we only changing the channel?
    ($event->program =~ /channel only/i);
  if (abs($next_start) < $MIN_GAP_TIME) {         # This event is starting
    my $message = $channel_only ? 
      "Changing Channels" : "Recording";
    print "$now $message: ",$event->program,"\n";
    $RECORDING_DEVICE->channel($event->channel);  # Change the channel twice
    $RECORDING_DEVICE->state('record')            # because the X-10 system isn't
      unless $channel_only;                       # that reliable!
    $RECORDING_DEVICE->channel($event->channel);
  } elsif (abs($next_end) < $MIN_GAP_TIME) {      # This one is ending
    print "$now Stop\n" unless $channel_only ;    # So stop the VCR
    $RECORDING_DEVICE->state('stop')
      unless $channel_only;
  $next++;                                      # and move on to the next event
  }
  $event = $events->[$next];
  last if $next > $#$events;                      # We might be done now
  $now = $TIME->now;                              # Otherwise figure out how
  my $sleep_time = $events->[$next]->sleep_for($now);  # long to sleep for
  if ($event->as_text ne $previous_event) {
    print "Next event is ", $event->as_text;      # Let user know about
    print ("Sleeping for ",as_hms($sleep_time),"\n");
    $previous_event = $event->as_text;
  }
  print '.';                                      # let user know you're still alive
  if ($MAX_SLEEP_TIME) {
    $sleep_time = $MAX_SLEEP_TIME if $sleep_time > $MAX_SLEEP_TIME;
  }
  $TIME->sleep($sleep_time);
}


__END__