PageRenderTime 45ms CodeModel.GetById 22ms RepoModel.GetById 0ms app.codeStats 0ms

/tags/v2-22/mh/bin/get_tv_info

#
Perl | 364 lines | 255 code | 49 blank | 60 comment | 48 complexity | 0fbcc8b4cd0a1a567ee06e0a7ae04818 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, GPL-3.0
  1. #!/usr/bin/perl
  2. #---------------------------------------------------------------------------
  3. # File:
  4. # get_tv_info
  5. # Description:
  6. # See help text below
  7. # Author:
  8. # Bruce Winter bruce@misterhouse.net http://misterhouse.net
  9. # Latest version:
  10. # http://misterhouse.net/mh/bin
  11. # Change log:
  12. # 07/04/99 Created.
  13. #
  14. #---------------------------------------------------------------------------
  15. use strict;
  16. my($Pgm_Path, $Pgm_Name, $Version);
  17. BEGIN {
  18. ($Version) = q$Revision: 54 $ =~ /: (\S+)/; # Note: revision number is auto-updated by cvs
  19. ($Pgm_Path, $Pgm_Name) = $0 =~ /(.*)[\\\/](.*)\.?/;
  20. ($Pgm_Name) = $0 =~ /([^.]+)/, $Pgm_Path = '.' unless $Pgm_Name;
  21. eval "use lib '$Pgm_Path/../lib', '$Pgm_Path/../lib/site'"; # So perl2exe works
  22. }
  23. my %parms;
  24. use Getopt::Long;
  25. if (!&GetOptions(\%parms, "h", "help",
  26. "channels=s", "dates=s", "times=s", "lengths=s", "keys=s",
  27. "outfile1=s", "outfile2=s",
  28. "debug") or @ARGV or
  29. !($parms{channels} or $parms{dates} or $parms{times} or $parms{lengths} or $parms{keys}) or
  30. ($parms{h} or $parms{help})) {
  31. print<<eof;
  32. $Pgm_Name returns info about tv programs that match the requested parms.
  33. It uses a database created by the get_tv_grid program.
  34. Version: $Version
  35. Usage:
  36. $Pgm_Name [options]
  37. -h => This help text
  38. -help => This help text
  39. -channels xyz => Will return info only for channel numbers xyz.
  40. Default is all the channels found by get_tv_grid.
  41. -dates xyz => Will return info only for dates xyz.
  42. Default is today. Format: month/day (e.g. 4/22).
  43. -times xyz => Will return info only for shows that start at xyz.
  44. Default is '6pm-10pm'. Use 'all' for all hours.
  45. Valid formats: 1 pm, 1PM, 13, 13:00.
  46. -lengths xyz => Will return info only for shows that are xyz hours long.
  47. Default is any length.
  48. -keys xyz => Will return info only for shows that have keywords
  49. in the xyz list in their title or description.
  50. Note: xyz can be a regular expresion (e.g. -keys "^ER$")
  51. All of the above parms support these formats:
  52. : comma-seperated values (e.g. -dates 7/4,7/5,7/6)
  53. : - delimited ranges (e.g. -dates 7/4-7/6)
  54. : + adder spec (e.g. -dates 7/4+2)
  55. Starting spec is optional (e.g. -dates +2)
  56. -debug => turn on debug info
  57. Examples:
  58. $Pgm_Name -channels "4-12" -lengths 2
  59. $Pgm_Name -channels "4,6,12" -times "7 pm"
  60. $Pgm_Name -dates "7/4-7/11" -keys "star trek, er ,dilbert"
  61. $Pgm_Name -dates +14 -keys computer
  62. eof
  63. exit;
  64. }
  65. # Globals
  66. my (@channels, @dates, @times, @lengths, @keys, %DBM, %DBM2, $match_cnt, $match_list1, $match_list2, $date_today);
  67. my %config_parms;
  68. &setup;
  69. &find_match;
  70. print "\nFound $match_cnt shows from ", @channels + 0, " channels. Detailed results are in $parms{outfile2}\n";
  71. print $match_list1 if $match_cnt < 10;
  72. sub find_match {
  73. $match_cnt = 0;
  74. for my $pgm_date (@dates) {
  75. for my $channel_number (@channels) {
  76. for my $time_start (@times) {
  77. my $db_key = join($;, $channel_number, $pgm_date, $time_start);
  78. print "key=$db_key\n" if $parms{debug};
  79. if (my $db_data = $DBM{$db_key}) {
  80. # Drop HTML tags
  81. $db_data = HTML::FormatText->new(lm => 0, rm => 500)->format(HTML::TreeBuilder->new()->parse($db_data));
  82. my($time_end, $pgm_name, $pgm_desc) = split($;, $db_data);
  83. my $min_start = &hour_to_min($time_start);
  84. my $min_end = &hour_to_min($time_end);
  85. my $time_start2 = &hour24_to_ampm($time_start);
  86. my $time_end2 = &hour24_to_ampm($time_end);
  87. my $pgm_length = ($min_end - $min_start)/60;
  88. my ($match_length, $match_key);
  89. for my $length (@lengths) {
  90. if ($length == $pgm_length) {
  91. $match_length = 1;
  92. last;
  93. }
  94. }
  95. for my $key (@keys) {
  96. if ($pgm_name =~ /$key/i or
  97. $pgm_desc =~ /$key/i) {
  98. $match_key = 1;
  99. last;
  100. }
  101. }
  102. unless (@lengths and !$match_length or
  103. @keys and !$match_key) {
  104. my $channel_name = $DBM2{$channel_number};
  105. if ($parms{debug}) {
  106. print "\nFound a match:\n";
  107. print " Channel: $channel_number $channel_name\n";
  108. print " Time: $pgm_date $time_start2 -> $time_end2\n";
  109. print " Length: $pgm_length hour\n";
  110. print " Title: $pgm_name\n";
  111. print " Desc: $pgm_desc\n";
  112. }
  113. $match_cnt++;
  114. my $temp = "\nShow $match_cnt. Channel $channel_number";
  115. $temp .= ", $channel_name" if $channel_name;
  116. $temp .= ", on $pgm_date" if @dates > 1 or $pgm_date ne $date_today;
  117. # $temp .= "from $time_start2 till $time_end2, $pgm_name.\n";
  118. $temp .= ". $pgm_name. From $time_start2 till $time_end2.\n";
  119. $match_list1 .= $temp;
  120. $match_list2 .= $temp . " $pgm_desc.\n";
  121. }
  122. }
  123. }
  124. }
  125. }
  126. # Do this as quick a possible, so we can use File_Item watch in mh
  127. open (OUT1, ">$parms{outfile1}") or die "Error, could not open output file $parms{outfile1}: $!\n";
  128. open (OUT2, ">$parms{outfile2}") or die "Error, could not open output file $parms{outfile2}: $!\n";
  129. print OUT1 "Found $match_cnt shows.\n$match_list1";
  130. print OUT2 "Found $match_cnt shows.\n$match_list2";
  131. close OUT1;
  132. close OUT2;
  133. # for my $key (keys %DBM) {
  134. # next unless $key =~ /^12$;/;
  135. # print "db key =$key\n value=$DBM{$key}\n";
  136. # }
  137. }
  138. sub setup {
  139. require 'handy_utilities.pl'; # For read_mh_opts funcion
  140. &main::read_mh_opts(\%config_parms, $Pgm_Path);
  141. # These are needed to drop HTML tag data
  142. use HTML::FormatText;
  143. use HTML::Parse;
  144. my $dbm_file = "$config_parms{data_dir}/tv_programs.dbm";
  145. my $dbm_file2 = "$config_parms{data_dir}/tv_channels.dbm";
  146. print "Using dbm file $dbm_file\n";
  147. use Fcntl;
  148. use DB_File;
  149. tie (%DBM, 'DB_File', $dbm_file, O_RDWR|O_CREAT, 0666) or print "\nError, can not open dbm file $dbm_file: $!";
  150. tie (%DBM2, 'DB_File', $dbm_file2, O_RDWR|O_CREAT, 0666) or print "\nError, can not open dbm file $dbm_file2: $!";
  151. my ($day, $month, $year) = (localtime(time))[3,4,5];
  152. $date_today = sprintf("%s/%02d", ++$month, $day);
  153. $parms{times} = '6pm-10pm' unless $parms{times};
  154. $parms{times} = '0+23.5' if lc($parms{times}) eq 'all';
  155. $parms{dates} = $date_today unless $parms{dates};
  156. # Allow for +increment format
  157. if (my ($date_start, $days) = $parms{dates} =~ /(\S*)\+(\d+)/) {
  158. $date_start = $date_today unless $date_start;
  159. $parms{dates} = "$date_start-". &increment_date($date_start, $days);
  160. }
  161. if (my ($time_start, $hours) = $parms{times} =~ /(\S*)\+(\S+)/) {
  162. $time_start = '6pm' unless defined $time_start;
  163. my $time_stop = $hours * 60 + &hour_to_min(&ampm_to_hour24($time_start));
  164. $time_stop = &min_to_hour($time_stop);
  165. $parms{times} = "$time_start-$time_stop";
  166. }
  167. if (my ($channel_start, $adder) = $parms{channels} =~ /(\S*)\+(\S+)/) {
  168. $channel_start = 1 unless defined $channel_start;
  169. $parms{channels} = "$channel_start-" . ($channel_start + $adder);
  170. }
  171. if (my ($length_start, $adder) = $parms{lengths} =~ /(\S*)\+(\S+)/) {
  172. $length_start = 0 unless $length_start;
  173. $parms{lengths} = "$length_start-" . ($length_start + $adder);
  174. }
  175. @channels = split_parm($parms{channels}, 'channels');
  176. @dates = split_parm($parms{dates}, 'dates');
  177. @times = split_parm($parms{times}, 'times');
  178. @lengths = split_parm($parms{lengths}, 'lengths');
  179. @keys = split(/[,]+/, $parms{keys});
  180. @channels = sort{$a <=> $b} keys %DBM2 if !@channels or $channels[0] eq 'all';
  181. $parms{outfile1} = "$config_parms{data_dir}/tv_info1.txt" unless $parms{outfile1};
  182. $parms{outfile2} = "$config_parms{data_dir}/tv_info2.txt" unless $parms{outfile2};
  183. print "\nSearching for:\n channels: @channels\n times: @times\n lengths: @lengths\n dates: @dates\n keys: @keys\n\n";
  184. }
  185. # Allow for ranges in parms (e.g. -channels 2-12 -time 5 PM-9pm)
  186. sub split_parm {
  187. my ($parm, $type) = @_;
  188. my ($i, $j, $low, $high, @parms);
  189. for $i (split(',', $parm)) {
  190. if ($i =~ /-/) {
  191. ($low, $high) = split('-', $i);
  192. if ($type eq 'channels') {
  193. for $j ($low .. $high) {
  194. push(@parms, $j);
  195. }
  196. }
  197. elsif ($type eq 'lengths') {
  198. for ($j = $low; $j <= $high; $j += .5) {
  199. push(@parms, $j);
  200. }
  201. }
  202. elsif ($type eq 'times') {
  203. $low = &ampm_to_hour24($low);
  204. $high = &ampm_to_hour24($high);
  205. push(@parms, $j=$low);
  206. my $loop_count = 0;
  207. while (1) {
  208. print "db time low=$low high=$high j=$j\n" if $parms{debug};
  209. my ($hour, $min, $ampm) = $j =~ /(\d+):?(\d*)/;
  210. if ($min eq '30') {
  211. $hour++;
  212. $hour = 0 if $hour > 23;
  213. $min = '00';
  214. }
  215. else {
  216. $min = '30';
  217. }
  218. $j = "$hour:$min";
  219. push(@parms, $j);
  220. last if $j eq $high or ++$loop_count > 48; # loop count protects us from bad specs
  221. }
  222. }
  223. elsif ($type eq 'dates') {
  224. $low = &format_date($low);
  225. $high = &format_date($high);
  226. push(@parms, $low);
  227. my $loop_count = 0;
  228. while (1) {
  229. $low = &increment_date($low, 1);
  230. push(@parms, $low);
  231. last if $low eq $high or ++$loop_count > 365;
  232. }
  233. }
  234. }
  235. else {
  236. $i = &ampm_to_hour24($i) if $type eq 'times';
  237. $i = &format_date($i) if $type eq 'dates';
  238. push(@parms, $i);
  239. }
  240. }
  241. return @parms;
  242. }
  243. sub increment_date {
  244. my ($date, $days) = @_;
  245. my($month, $day) = split('/', $date);
  246. # Really should use str2time and localtime here, to deal
  247. # with month boundarys accurately.
  248. $day += $days;
  249. ($day = 1, $month++) if $day > 31;
  250. $month = 1 if $month > 12;
  251. return sprintf("%s/%02d", $month, $day);
  252. }
  253. sub format_date {
  254. my ($month, $day) = @_[0] =~ /0?(\d+)\/(\d+)/; # Drop leading 0 from month
  255. return sprintf("%s/%02d", $month, $day); # Add leading 0 to day
  256. }
  257. sub min_to_hour {
  258. my ($min) = @_;
  259. my $hour = int($min / 60);
  260. $min = $min - $hour * 60;
  261. return sprintf("%d:%02d", $hour, $min);
  262. }
  263. sub hour_to_min {
  264. my ($hour, $min) = split(':', @_[0]);
  265. return $hour * 60 + $min;
  266. }
  267. sub hour24_to_ampm {
  268. my ($hour, $min) = split(':', @_[0]);
  269. if ($hour > 12) {
  270. return ($hour - 12) . ":$min PM";
  271. }
  272. else {
  273. return "$hour:$min AM";
  274. }
  275. }
  276. sub ampm_to_hour24 {
  277. my ($hour, $min, $ampm) = @_[0] =~ /(\d+):?(\d*) *(\S*)/;
  278. $hour += 12 if uc($ampm) eq 'PM' and $hour < 12;
  279. $min = "00" unless $min;
  280. $hour .= ":$min";
  281. return $hour;
  282. }
  283. #
  284. # $Log$
  285. # Revision 1.10 2000/04/25 12:43:36 winter
  286. # - add HTML::FormatText to drop html tags
  287. #
  288. # Revision 1.9 2000/04/09 18:03:19 winter
  289. # - 2.13 release
  290. #
  291. # Revision 1.8 2000/03/10 04:09:01 winter
  292. # - Add Ibutton support and more web changes
  293. #
  294. # Revision 1.7 2000/01/27 13:23:00 winter
  295. # - update version number
  296. #
  297. # Revision 1.6 2000/01/02 23:40:38 winter
  298. # - change email address
  299. #
  300. # Revision 1.5 1999/11/08 02:25:16 winter
  301. # - fix data_dir bug
  302. #
  303. # Revision 1.4 1999/10/16 22:46:19 winter
  304. # - added data_dir parm
  305. #
  306. # Revision 1.3 1999/09/12 16:15:38 winter
  307. # - fixed $Version bug
  308. #
  309. # Revision 1.2 1999/08/01 01:19:47 winter
  310. # - minor fixes
  311. #
  312. # Revision 1.1 1999/07/05 16:48:48 winter
  313. # - created
  314. #
  315. #