Mythmail.pl
From MythTV Official Wiki
Note: The correct title of this article is mythmail.pl. It appears incorrectly here due to technical restrictions.
Todo: Script needs to be updated to use Perl bindings for database credentials.
| Author | Hirobumi Shimada |
| Description | Recording order by mail interface for OnTV Japan |
| Supports |
MythTV added new recording order by mail interface mail format require OnTV "net remocon" and TV Guide format
mythmail.pl
#!/usr/bin/perl -w
#
# ATTENTION: this file used utf8 encoding
#
# MythTV added new recording order by mail interface
# mail format require OnTV<www.ontvjapan.com> "net remocon" and TV Guide format
#
# MythMail is distributed under GPL, version 2 only.
# If you don't have a copy of the GPL, get one at:
# http://www.gnu.org/licenses/gpl.txt
#
# Author: Hirobumi Shimada <shimada@systemcreate-inc.com>
#
use MIME::Parser;
use Date::Calc qw(check_time check_date This_Year Add_Delta_Days);
use Encode qw(from_to);
use DBI;
### default settings ###
%settings = (
#
# mythtv's configuration file
# please edit configuration path
'configfile' => '/usr/local/share/mythtv/mysql.txt',
# mail charset
'mailcharset' => 'iso-2022-jp',
# generating new program if does not exist required program
'generate_program' => '1',
# 0 kNotRecording
# 1 kSingleRecord
# 2 kTimeslotRecord
# 3 kChannelRecord
# 4 kAllRecord
# 5 WeekslotRecord
'type' => 1,
# set MythTV recording profile
'profile' => 'Default',
# any settings
'recpriority' => 0,
'recorddups' => 0,
'maxnewest' => 0,
'maxepisodes' => 0,
'autoexpire' => 1,
# searching postfix in mythtconverg.channel.xmltvid, if needed
'idpostfix' => 'ontvjapan.com',
);
my @mail_parser_entry = (
{ ( 'title' => 'OnTV Guide Mail',
'mail_parser' => mail_parser_guide_mail,
'headeritem' => 'subject',
'pattern' => 'TV Program Guide' ) },
{ ( 'title' => 'OnTV Remocon Mail',
'mail_parser' => mail_parser_recording_mail,
'headeritem' => 'return-path',
'pattern' => 'errormail@ontvjapan.com' ) },
);
my %blank_prg = (
'chanid' => '',
'starttime' => '',
'startdate' => '',
'endtime' => '',
'enddate' => '',
'title}' => '',
'subtitle' => '',
'desc' => '',
'category' => '',
);
my $verbose = 1;
my $noupdate = 0;
my $dbprm;
#
# load database connecting parameters from mythtv's config file
#
open(CONF, "< $settings{configfile}") or die "cannot open config file:$settings{configfile}\n";
while(<CONF>)
{
/(.*)=(.*)/;
$dbprm{$1} = $2;
}
close(CONF);
# read mail
my $mail;
{
local $/;
$mail = <>;
# convert encoding to utf8
from_to($mail, $settings{mailcharset}, 'utf8');
}
# parse mail structure
my $parser = new MIME::Parser;
$parser->output_to_core(1);
$parser->tmp_recycling(1);
$parser->tmp_to_core(1);
$parser->use_inner_files(1);
my $ent = $parser->parse_data($mail) or die "cannot parse this mail";
# get mail parser
my $mail_parser = get_mail_parser($ent) or die "no parser for this mail\n";
# connecting db
$dbh = DBI->connect("DBI:mysql:$dbprm{DBName}:$dbprm{DBHostName}",
$dbprm{DBUserName},
$dbprm{DBPassword}) or die $dbh->errstr;
# parsing mail
if (&$mail_parser($dbh, $ent))
{
backend_notify_changes($dbh);
}
$dbh->disconnect;
###
### end of main
###
#
# find parser
#
sub get_mail_parser
{
my ($ent) = @_;
foreach $pi (@mail_parser_entry)
{
if($ent->head->get($pi->{headeritem}) =~ /$pi->{pattern}/)
{
warn "assume:$pi->{title}\n";
return $pi->{mail_parser};
}
}
}
sub format_time {
my ($time) = @_;
my $rc;
($hour, $min) = $time =~/(\d{2})(\d{2})/;
if (check_time($hour, $min, 0)) {
$rc = "$hour:$min:00";
}
return $rc;
}
sub format_date
{
my ($date, $bias) = @_;
my $year = This_Year;
my $rc;
($month, $day) = $date =~ /(\d{2})\/*(\d{2})/;
if (check_date($year, $month, $day))
{
($year, $month, $day) = Add_Delta_Days($year, $month, $day, $bias);
$rc = "$year-$month-$day";
}
return $rc;
}
sub get_chanid
{
my ($dbh, $xmltvid, $callsign) = @_;
my $sql = "SELECT chanid FROM channel";
my $chanid;
if ($xmltvid)
{
$sql .= " WHERE xmltvid='$xmltvid.$settings{idpostfix}'";
}
else
{
$sql .= " WHERE callsign='$callsign'";
};
warn "get_chanid:$sql\n" if ($verbose);
$sth = $dbh->prepare($sql);
if (!$sth->execute)
{
warn "$dbh->errstr\n";
return 0;
}
if ($sth->rows)
{
my @fields = $sth->fetchrow_array;
$chanid = $fields[0];
}
$sth->finish;
return $chanid;
}
sub check_program_existed
{
my ($dbh, %prg) = @_;
my $sql = "SELECT chanid FROM program" .
" WHERE title='$prg{title}'" .
" AND chanid=$prg{chanid}" .
" AND starttime='$prg{startdate} $prg{starttime}'" .
" AND endtime='$prg{enddate} $prg{endtime}'";
warn "check_program:$sql\n" if ($verbose);
my $sth = $dbh->prepare($sql);
if (!$sth->execute)
{
warn "$dbh->errstr\n";
return FALSE;
}
my $existed = $sth->rows > 0 ? TRUE : FALSE;
warn "rows:$existed\n";
$sth->finish;
return $existed;
}
sub generate_program
{
my ($dbh, %prg) = @_;
my $sql = "INSERT INTO program (chanid,starttime,endtime," .
"title,subtitle,description,category,airdate," .
"stars) VALUES(" .
"$prg{chanid}" .
",'$prg{startdate} $prg{starttime}'" .
",'$prg{enddate} $prg{endtime}'" .
",'$prg{title}'" .
",'$prg{subtitle}'" .
",'$prg{desc}'" .
",'$prg{category}'" .
",'0', '0')";
warn "generate_program:$sql\n";
if(!$noupdate && $dbh->do($sql))
{
warn "$dbh->errstr\n";
return FALSE;
}
return TRUE;
}
sub insert_recording_order
{
my ($dbh, %prg) = @_;
if (!($prg{chanid} = get_chanid($dbh, $prg{xmltvid}, $prg{callsign})))
{
warn "not configured channel [$prg{'xmltvid'}]\n";
return;
}
# non alphabet strings required utf8
$prg{subtitle} = '' if (!$prg{subtitle});
$prg{desc} = '' if (!$prg{desc});
$prg{category} = '' if (!$prg{category});
if($settings{generate_program}
&& (!check_program_existed($dbh, %prg)
|| !generate_program($dbh, %prg)))
{
return FALSE;
}
$sql = "INSERT INTO record(type, chanid, starttime, startdate" .
", endtime, enddate, title, subtitle, description" .
", category, profile, recpriority" .
", recorddups, maxnewest, maxepisodes, autoexpire)" .
"VALUES($settings{type}" .
", $prg{chanid}" .
", '$prg{starttime}'" .
", '$prg{startdate}'" .
", '$prg{endtime}'" .
", '$prg{enddate}'" .
", '$prg{title}'" .
", '$prg{subtitle}'" .
", '$prg{desc}'" .
", '$prg{category}'" .
", '$settings{profile}'" .
", '$settings{recpriority}'".
", '$settings{recorddups}'" .
", '$settings{maxnewest}'" .
", '$settings{maxepisodes}'" .
", '$settings{autoexpire}')";
warn "set_recording:$sql\n" if ($verbose);
if (!$noupdate && !$dbh->do($sql))
{
warn "$dbh->errstr\n";
return FALSE;
};
return TRUE;
}
sub backend_notify_changes
{
my ($dbh) = @_;
my $sql = "UPDATE settings SET data='yes' WHERE value='RecordChanged'";
warn "backend_notify_changes:$sql\n" if ($verbose);
if (!$dbh->do($sql))
{
warn "$dbh->errstr";
return FALSE;
};
return TRUE;
}
##
## mail parser define
##
#
# mail parser
# parse remocon mail
#
# mail format are
# open {keyword} {source? tv} {'SC'+channel} {starttime} {endtime} {startdate}
# {program title}
#
sub mail_parser_recording_mail
{
my ($dbh, $ent) = @_;
my %prg = %blank_prg;
$_ = $ent->bodyhandle->as_string;
return FALSE if (!/^(open) (.+) (.+) SC(\d+) (\d{4}) (\d{4}) (\d{4})\n(.*)\n/);
$prg{header} = $1;
$prg{keyword} = $2;
$prg{source} = $3;
$prg{xmltvid} = $4;
$prg{starttime} = $5;
$prg{endtime} = $6;
$prg{startdate} = $7;
$prg{enddate} = $7;
$prg{title} = $8;
# if overlapped 2 days, enddate set tomorrow
my $bias = $prg{starttime} ge $prg{endtime} ? 1: 0;
if(!($prg{startdate} = format_date($prg{startdate}, 0))
|| !($prg{enddate} = format_date($prg{enddate}, $bias))
|| !($prg{starttime} = format_time($prg{starttime}))
|| !($prg{endtime} = format_time($prg{endtime})))
{
warn "broken format\n";
return FALSE;
}
return insert_recording_order($dbh, %prg);
}
#
# mail parser
# parse guide mail
#
# mail format is
# title line
# subtitle lines {optional}
# time info
# description {optional}
# {blank line}
# repeated ...
# ------END--------
#
sub mail_parser_guide_mail
{
my ($dbh, $ent) = @_;
my @lines = $ent->bodyhandle->as_lines;
my %prg;
my $phase = 0;
my $run = 1;
my $affected = FALSE;
while ($run && chop($_ = shift(@lines)))
{
# check end of list
if(/^-+END-+/)
{
$run = 0;
$_ = "";
};
# skip blank line
if(!$_)
{
if($phase < 2)
{
warn "broken format\n";
}
else
{
$affected = TRUE if (insert_recording_order($dbh, %prg));
}
%prg = %blank_prg;
$phase = 0;
next;
}
if($phase == 0)
{
# first line is title
$prg{title} = $_;
$phase++;
}
elsif ($phase == 1)
{
# few subtitle line and time info
if(!/(\d{2}\/\d{2}).+(.*\d{2}:\d{2})..(.*\d{2}:\d{2})\s+(.+)\((.+)\)(.+)/)
{
$prg{subtitle} .= $_;
}
else
{
$prg{startdate} = $1;
$prg{enddate} = $1;
$prg{starttime} = $2;
$prg{endtime} = $3;
$prg{station} = $4;
$prg{callsign} = $5;
$prg{category} = $6;
$prg{startdate} =~ s/\///;
$prg{enddate} =~ s/\///;
$prg{starttime} =~ s/[^\d]//g;
my $sbias = $` =~ /æ·±/ ? 1 : 0;
$prg{endtime} =~ s/[^\d]//g;
my $ebias = $prg{starttime} ge $prg{endtime}
? $sbias+1 : $sbias;
if(($prg{startdate} = format_date($prg{startdate}, $sbias))
&& ($prg{enddate} = format_date($prg{enddate}, $ebias))
&& ($prg{starttime} = format_time($prg{starttime}))
&& ($prg{endtime} = format_time($prg{endtime})))
{
$phase++;
}
else
{
warn "broken format:$_\n";
%prg = ();
$phase = 0;
}
};
}
else
{
# description lines
$prg{desc} .= $_;
};
};
return $affected;
}
# end
