#!/usr/bin/perl
#
#sift.pl - web interface for topfield/sift / T. Rintala 2006
#

#flush output buffer
$|++;

use CGI qw(:standard);
use Device::SerialPort;

chdir("/data/www/cgi-bin/siftdata");

$SER_PORT="/dev/ttyUSB0"; #which is connected to topfield
$ENV{PATH}="";
$VERS="WebSift 0.40";
$OUTPUTF="siftcom.txt";
@weekdays = ('Saturday', 'Sunday', 'Monday', 'Tuesday',
	     'Wednesday', 'Thursday', 'Friday');
#channel list which we are interested in
@channel_list = ('1', '2', '3', '4', '5', '6', '7', '8', '9');

$p_epg = url_param('epg');
$p_cmd = url_param('cmd');
$f_pw = param('password');

#start html page
print header;
print start_html(-title=>$VERS);
print "<pre>";

access_module(0); #newer return if problem with access/password

#logout
if ($p_cmd eq 'logout') { access_module(1); }

#menu
printf "<A HREF=\"sift.pl?cmd=listtimers\">[List Timers]</A> ";
printf "<A HREF=\"sift.pl?cmd=addform\">[Add Timer]</A> ";
printf "<A HREF=\"sift.pl?cmd=listremove\">[Remove Timer]</A> ";
printf "<A HREF=\"sift.pl?cmd=info\">[Info]</A> ";
printf "<A HREF=\"sift.pl?cmd=readepg\">[Read Epg]</A> ";
printf "    <A HREF=\"sift.pl?cmd=logout\">[Logout]</A>\n";

foreach $cl (@channel_list) {
  printf "<A HREF=\"sift.pl?epg=$cl\">[$cl]</A> ";
}

$sf=0;
($sec,$min,$hou,$mda,$mon,$yea,$wday,$yda,$isd) = localtime();
$today=sprintf("%04d%02d%02d", 1900+$yea, $mon+1, $mda);
printf("\nTime %d.%d.%d %d:%02d", 1900+$yea, $mon+1, $mda, $hou, $min);

print hr;

#execute timer add command
if ($p_cmd eq 'addexe' && param('formbutton') eq 'Add') {
  my $a='a:';

  $a = $a . param('tuner') . '|' . param('channel') . '|';
  $a = $a . param('freq') . '|' . param('length') . '|';
  $a = $a . param('year') . '|' . param('month') . '|';
  $a = $a . param('day') . '|' . param('hour') . '|';
  $a = $a . param('min') . '|' . param('name');

  print "string to send:$a\n";
  exe_siftcom("$a", $OUTPUTF);
  @xlist = read_siftcom($OUTPUTF);
  print "<b>Result:</b>\n";
  foreach $i (@xlist) { print $i };
}

#add new timer form
if ($p_cmd eq 'addform') {
  print "<b>Add timer:</b>\n";
  print start_form(-action=>"sift.pl?cmd=addexe");
  print "Tuner: ";
  print radio_group(-name=>'tuner',
		    -values=>['1','2'],
		    -default=>'2',
		    -labels=>{1=>'Tuner 1',2=>'Tuner 2'});
  print "\nFrequency: ";
  print popup_menu(-name=>'freq',
		   -values=>['1','2','3','4','5','6'],
		   -default=>'1',
		   -labels=>{1=>'OneTime',2=>'EveryDay',3=>'WeekEnds',
			     4=>'Weekly',5=>'EveryWeekday',6=>'NoType'});
  print "\nChannel: ";
  print textfield(-name=>'channel',
		  -default=>'' . url_param('ch'),
		  -size=>3,
		  -columns=>3);
  ($fyy, $fmm, $fdd, $fhh, $fmi) = split_date_data(url_param('time'));
  print "\nDate&Time y m d h:m ";
  print textfield(-name=>'year',
		  -default=>$fyy,
		  -size=>4,
		  -columns=>4);
  print textfield(-name=>'month',
		  -default=>$fmm,
		  -size=>2,
		  -columns=>2);
  print textfield(-name=>'day',
		  -default=>$fdd,
		  -size=>2,
		  -columns=>2);
  print " ";
  print textfield(-name=>'hour',
		  -default=>$fhh,
		  -size=>2,
		  -columns=>2);
  print ":";
  print textfield(-name=>'min',
		  -default=>$fmi,
		  -size=>2,
		  -columns=>2);
  print "\nLength: ";
  print textfield(-name=>'length',
		  -default=>'' . url_param('len'),
		  -size=>3,
		  -columns=>3);
  print " min.\nName: ";
  print textfield(-name=>'name',
		  -default=> '' . url_param('name'),
		  -size=>50,
		  -columns=>50);
  print "\n\n";
  print submit(-name=>'formbutton', -label=>'Add');
  print submit(-name=>'formbutton', -label=>'Cancel');
  print end_form;
}

#list timers or make delete options
if ($p_cmd eq 'listtimers' || $p_cmd eq 'listremove') {
  if ($p_cmd eq 'listremove') {
    print "<b>Select timer to remove:</b>\n";
  }
  exe_siftcom("l", $OUTPUTF);
  @xlist = read_siftcom($OUTPUTF);
  foreach $i (@xlist) {
    if ($i =~ m/^-----/) {
      print hr;
    }
    elsif ($p_cmd eq 'listremove' && $i =~ m/^RecordNumber/) {
      ($text, $number) = split(/=/, $i);
      print "<A HREF=\"sift.pl?cmd=del&rec=$number\">[Delete $number]</A>\n";
    }
    else {
      print "$i\n";
    }
  }
}

#execute timer delete command
if ($p_cmd eq 'del') {
  $p_rec = url_param('rec');
  exe_siftcom("d$p_rec", $OUTPUTF);
  @xlist = read_siftcom($OUTPUTF);
  print "<b>Result:</b>\n";
  foreach $i (@xlist) { print $i };
}

#execute info command
if ($p_cmd eq 'info') {
  print "<b>Result (wait 10 sec):</b>\n";
  exe_siftcom("i", $OUTPUTF);
  @xlist = read_siftcom($OUTPUTF);
  foreach $i (@xlist) { print "$i\n" };
}

#refresh epg data from topfield
if ($p_cmd eq 'readepg') {
  foreach $ch (@channel_list) {
    print "Reading channel $ch epg data.\n";
    exe_siftcom("e$ch", "$ch.epg");
  }
  print "Done.\n";
}

#generate epgdata page
if ($p_epg ne '') {
  @siftlist = read_siftcom("$p_epg.epg");
  $old_dayp='';
  foreach $i (@siftlist) {
    if ($i =~ /^EPGLIST/) {
      print "<b>$i</b>\n";
    }
    else {
      ($edate, $elen, $ename, $edes) = split(/\|/, $i);
      $dayp = substr($edate, 0, 8);
      if ($dayp >= $today) {
	($yy, $mm, $dd, $hh, $mi) = split_date_data($edate);
	$wdt = @weekdays[get_weekday($yy, $mm, $dd)];
	if ($old_dayp ne $dayp) {
	  printf "<b>%s.%s.%s %s</b>\n", $yy, $mm, $dd, $wdt;
	  $old_dayp = $dayp;
	}
	#make hyperlink to fill timer form
	$tref="<A HREF=\"sift.pl?cmd=addform&ch=$p_epg&time=$edate&len=";
	$tref=$tref . sprintf("%i", $elen);
	$prname = $ename;
	$prname =~ s/[\s,.:;]//g;
	$prname = substr($prname, 0, 46);
	$tref=$tref . "&name=$prname.rec\">$hh.$mi</A>";
	printf("%s %s [%s]\n", $tref, $ename, $edes);
	#printf("%s.%s %s [%s]\n", $hh, $mi, $ename, $edes);
      }
    }
  }
}

print "</pre>";
print end_html;


#
# subroutines
#


#will calculate the day number of the week. 0 = saturday
sub get_weekday {
  my ($yyyy, $mm, $dd) = @_;

  my $cc = substr($yyyy, 0, 2);
  my $yy = substr($yyyy, 2, 2);
  my $mod_dd = $dd % 7;

  if ($mm == 1 or $mm ==2) {
    if ((($yy % 4) == 0 && ($yy % 100) != 0) or ($yy % 400) == 0) {
      $mm += 12;
    }
  }
	
  #####  CALCULATING TABLE 1:
  my $h_month =  0;
  $h_month =  0 if $mm ==  8 or ($mm == 14);
  $h_month =  1 if $mm ==  2 or ($mm ==  3) or ($mm == 11);
  $h_month =  2 if $mm ==  6;
  $h_month =  3 if $mm ==  9 or ($mm == 12);
  $h_month =  4 if $mm ==  4 or ($mm ==  7) or ($mm == 13);
  $h_month =  5 if $mm ==  1 or ($mm == 10);
  $h_month =  6 if $mm ==  5;

  $mm -= 12 if $mm > 12;

  my $table1 = $mod_dd + $h_month;
	
  #####  CALCULATING TABLE 2:
  my $year2 = ($yy * 1.25) % 7;
  my $ccTmp = (($cc - 1) % 4) +1;
  my $century2 = 0;
  if ($ccTmp == 4) { $century2 = 2 } else { $century2 = 9 - 2 * $ccTmp }
  my $table2 = $century2 + $year2;
  my $wd = ($table1 + $table2) % 7;

  return ($wd);
}


#splitt string yyyymmddhhmi -> 5 different variables
sub split_date_data {
  my ($ldate) = @_;
  my $yy, $mm, $dd, $hh, $mi;

  if (length($ldate) != 12) {return('','','','','')};
  $yy = substr($ldate, 0, 4);
  $mm = substr($ldate, 4, 2);
  $dd = substr($ldate, 6, 2);
  $hh = substr($ldate, 8, 2);
  $mi = substr($ldate, 10, 2);

  return($yy, $mm, $dd, $hh, $mi);
}


#read sift output file and parse irrelevant data. return list of data.
#parameter: output_file
sub read_siftcom {
  my ($outpf) = @_;
  my @slist = ();
  my @tlist = ();
  my $sf = 0;

  if (!open(DFH,"<$outpf")) { print "Error code: 1",br; }
  @tlist = <DFH>;
  close(DFH);
  chomp @tlist;

  foreach $i (@tlist) {
    $i =~ s/[\r\n]//g;
    $i =~ s/\ce//g;
    if ($i eq '') { next };
    if ($i =~ m/^START/) {$sf = 1; next};
    if ($i =~ m/^READY/) {$sf = 0};
    if ($sf == 1) {
      push @slist, $i;
    }
  }
  return (@slist);
}


#execute command trough serialport to topfield 
#suppose sift daemon is running on topfield
#two params: "command", "output_file"
sub exe_siftcom {
  my ($execmd, $outputf) = @_;
  my $sp;

  $sp = tie(*SPF, 'Device::SerialPort', $SER_PORT) ||
    die "Can't open port $SER_PORT!";
  $sp->baudrate(115200)   || die "fail setting baudrate";
  $sp->parity("none")     || die "fail setting parity";
  $sp->databits(8)        || die "fail setting databits";
  $sp->stopbits(1)        || die "fail setting stopbits";
  $sp->handshake("none")  || die "fail setting handshake";

  $sp->read_char_time(0);
  $sp->read_const_time(500); #if no data after 0.5 second, we are ready
  if ($execmd eq 'i') { #info command, harddisk may be sleep, wait to spinup
    $sp->read_const_time(5000);
  }

  if (!open(DFH,">$outputf")) { print "Error: file create";}
  $sp->write("*\r*\r$execmd\r");
  do {
    ($count,$sdata) = $sp->read(1024);
    syswrite(DFH, $sdata, $count);
  } while ($count != 0);
  $sp->read_const_time(500);
  $sp->write("#\r");
  do {
    ($count,$sdata) = $sp->read(1024);
    syswrite(DFH, $sdata, $count);
  } while ($count != 0);
  close(DFH);
  undef $sp;
}

#access module
#param: 0 = check access, 1 = clean login database
sub access_module() {
  my ($act) = @_;

  #logout
  if ($act == 1) {
    if (!open(DFH,">session.dat")) { print "Error code: 4",br; }
    print DFH "NO-SIFT-SESSION\n";
    close(DFH);

    print "Logged out.\n";
    print "<A HREF=\"sift.pl\">[Login]</A>\n";
    print "</pre>";
    print end_html;
    exit 0;
  }

  #access key is simple the remote ip address
  $seskey=$ENV{REMOTE_ADDR};

  #mayby already login
  if (!open(DFH,"<session.dat")) { print "Error code: 5",br; }
  @seslist = <DFH>;
  close(DFH);
  chomp @seslist;
  foreach $x (@seslist) { if ($x eq $seskey) {return}; }

  #password given, check out is it valid
  if ($f_pw ne '') {
    if (!open(DFH,"<passwd.dat")) { print "Error code: 6",br; }
    @pwlist = <DFH>;
    close(DFH);
    chomp @pwlist;
    foreach $x (@pwlist) {
      if ($x eq $f_pw) {
	if (!open(DFH,">session.dat")) { print "Error code: 3",br; }
	print DFH $seskey,"\n";
	close(DFH);
	return;
      }
    }
    print "Password not valid.\n";
    print "<A HREF=\"sift.pl\">[Login]</A>\n";
    print "</pre>";
    print end_html;
    exit 0;
  }

  #ask password
  print start_form(-action=>"sift.pl");
  print "<b>Login:</b> ";
  print password_field(-name=>"password",
		       -size=>10,
		       -maxlength=>10);
  print "\n";
  print br, submit(-name=>'pwformbutton', -label=>'OK');
  print end_form;
  print "</pre>";
  print end_html;
  exit 0;
}