File Coverage

blib/lib/Linux/DVB/DVBT.pm
Criterion Covered Total %
statement 174 1325 13.1
branch 56 728 7.6
condition 4 198 2.0
subroutine 28 66 42.4
pod 38 38 100.0
total 300 2355 12.7


line stmt bran cond sub pod time code
1             package Linux::DVB::DVBT;
2              
3             =head1 NAME
4              
5             Linux::DVB::DVBT - Perl extension for DVB terrestrial recording, epg, and scanning
6              
7             =head1 SYNOPSIS
8              
9             use Linux::DVB::DVBT;
10            
11             # get list of installed adapters
12             my @devices = Linux::DVB::DVBT->device_list() ;
13             foreach (@devices)
14             {
15             printf "%s : adapter number: %d, frontend number: %d\n",
16             $_->{name}, $_->{adapter_num}, $_->{frontend_num} ;
17             }
18            
19             # Create a dvb object using the first dvb adapter in the list
20             my $dvb = Linux::DVB::DVBT->new() ;
21            
22             # .. or specify the device numbers
23             my $dvb = Linux::DVB::DVBT->new(
24             'adapter_num' => 2,
25             'frontend_num' => 1,
26             ) ;
27              
28              
29             # Scan for channels - using frequency file
30             $dvb->scan_from_file('/usr/share/dvb/dvb-t/uk-Oxford') ;
31            
32             # Scan for channels - using country code
33             $dvb->scan_from_file('GB') ;
34            
35             # Scan for channels - if scanned before, use previous frequencies
36             $dvb->scan_from_previous() ;
37            
38             # Set channel
39             $dvb->select_channel("BBC ONE") ;
40            
41             # Get EPG data
42             my ($epg_href, $dates_href) = $dvb->epg() ;
43              
44             # Record 30 minute program (after setting channel using select_channel method)
45             $dvb->record('test.ts', 30*60) ;
46              
47             ## Record multiple programs in parallel (in the same multiplex)
48            
49             # parse arguments
50             my @args = qw/file=itv2.mpeg ch=itv2 len=0:30 event=41140
51             file=five.mpeg ch=five len=0:30 off=0:15 event=11134 max_timeslip=2:00
52             file=itv1.mpeg ch=itv1 len=0:30 off=0:30
53             file=more4.mpeg ch=more4 len=0:05 off=0:15
54             file=e4.mpeg ch=e4 len=0:30 off=0:05
55             file=ch4+1.mpeg ch='channel4+1' len=1:30 off=0:05/ ;
56            
57             my @chan_spec ;
58             $dvb->multiplex_parse(\@chan_spec, @ARGV);
59            
60             # Select the channel(s)
61             $dvb->multiplex_select(\@chan_spec) ;
62            
63             # Get multiplex info
64             my %multiplex_info = $dvb->multiplex_info() ;
65              
66             # Record
67             $dvb->multiplex_record(%multiplex_info) ;
68              
69              
70             ## Release the hardware (to allow a new recording to start)
71             $dvb->dvb_close() ;
72            
73              
74             # show the logical channel numbers
75             my $tuning_href = $dvb->get_tuning_info() ;
76             my $channels_aref = $dvb->get_channel_list() ;
77            
78             print "Chans\n" ;
79             foreach my $ch_href (@$channels_aref)
80             {
81             my $chan = $ch_href->{'channel'} ;
82             printf "%3d : %-40s %5d-%5d $ch_href->{type}\n",
83             $ch_href->{'channel_num'},
84             $chan,
85             $tuning_href->{'pr'}{$chan}{'tsid'},
86             $tuning_href->{'pr'}{$chan}{'pnr'} ;
87             }
88              
89              
90              
91             =head1 DESCRIPTION
92              
93             B is a package that provides an object interface to any installed Freeview
94             tuner cards fitted to a Linux PC. The package supports initial set up (i.e. frequency scanning),
95             searching for the latest electronic program guide (EPG), and selectign a channel for recording
96             the video to disk.
97              
98             =head2 Additional Modules
99              
100             Along with this module, the following extra modules are provided:
101              
102             =over 4
103              
104             =item L
105              
106             Configuration files and data utilities
107              
108             =item L
109              
110             Miscellaneous utilities
111              
112             =item L
113              
114             Helper module that wraps up useful L calls to post-process recorded files.
115              
116             =back
117              
118              
119             =head2 Logical Channel Numbers (LCNs)
120              
121             Where broadcast, the scan function will gather the logical channel number information for all of the channels. The scan() method now stores the LCN information
122             into the config files, and makes the list of channels available through the L method. So you can now get the channel number you
123             see (and enter) on any standard freeview TV or PVR.
124              
125             This is of most interest if you want to use the L method to gather data to create a TV guide. Generally, you'd like the channel listings
126             to be sorted in the order to which we've all become used to through TV viewing (i.e. it helps to have BBC1 appear before channel 4!).
127              
128              
129             =head2 TVAnytime
130              
131             New in this version is the gathering of TV Anytime series and program information by the epg function. Where available, you now have a 'tva_series' and
132             'tva_program' field in the epg HASH that contains the unique TV Anytime number for the series and program respectfully. This is meant to ensure that
133             you can determine the program and series uniquely and allow you to not re-record programs. In reality, I've found that some broadcasters use different
134             series identifiers even when the same series is shown at a different time!
135              
136             At present, I use the series identifier to group recordings within a series (I then rename the series directory something more meaningful!). Within a
137             series, the program identifier seems to be useable to determine if the program has been recorded before.
138              
139              
140             =head2 Multiplex Recording
141              
142             Another new feature in this version is support for multiplex recording (i.e. being able to record multiple streams/programs at the same time, as long as they are all
143             in the same multiplex). As you can imagine, specifying the recording of multiple programs (many of which will be different lengths and start at
144             diffent times) can get quite involved.
145              
146             To simplify these tasks in your scripts, I've written various "helpers" that handle parsing command line arguments, through to optionally running
147             ffmpeg to transcode the recorded files. These are all in addition to the base function that adds a demux filter to the list that will be recorded
148             (see L). Feel free to use as much (or as little) of the helper functions as you like - you can always write
149             your own scripts using add_demux_filter().
150              
151             For details of the ffmpeg helper functions, please see L. Obviously, you need to have ffmpeg installed on your system
152             for any of the functions to work!
153              
154             To record multiple channels (in the same multiplex) at once, you need something like:
155              
156             use Linux::DVB::DVBT;
157              
158             ## Parse command line
159             my @chan_spec ;
160             my $error = $dvb->multiplex_parse(\@chan_spec, @ARGV);
161            
162             ## Select the channel(s)
163             my %options = (
164             'lang' => $lang,
165             'out' => $out,
166             'tsid' => $tsid,
167             ) ;
168             $error = $dvb->multiplex_select(\@chan_spec, %options) ;
169            
170             ## Get multiplex info
171             my %multiplex_info = $dvb->multiplex_info() ;
172              
173             ## Record
174             $dvb->multiplex_record(%multiplex_info) ;
175              
176             ## Release the hardware (to allow a new recording to start)
177             $dvb->dvb_close() ;
178            
179             ## [OPTIONAL] Transcode the recordings (uses ffmpeg helper module)
180             $error = $dvb->multiplex_transcode(%multiplex_info) ;
181              
182             Note, the old L function has been re-written to use the same underlying multiplex functions. This means that,
183             even though you are only recording a single program, you can still use the ffmpeg helper transcode functions after the
184             recording has finished. For example:
185              
186             ## Record
187             $dvb->record("$dir$name$ext", $duration) ;
188            
189             ## Release DVB (for next recording)
190             $dvb->dvb_close() ;
191            
192             ## Get multiplex info
193             my %multiplex_info = $dvb->multiplex_info() ;
194            
195             ## Transcode the recordings (uses ffmpeg helper module)
196             $dvb->multiplex_transcode(%multiplex_info) ;
197            
198             ## Display ffmpeg output / warnings / errors
199             foreach my $line (@{$multiplex_info{'lines'}})
200             {
201             info("[ffmpeg] $line") ;
202             }
203            
204             foreach my $line (@{$multiplex_info{'warnings'}})
205             {
206             info("[ffmpeg] WARN: $line") ;
207             }
208            
209             foreach my $line (@{$multiplex_info{'errors'}})
210             {
211             info("[ffmpeg] ERROR: $line") ;
212             }
213              
214             Since this is a new feature, I've left access to the original recording method but renamed it L. If, for any reason,
215             you wish to use the original recording method, then you need to change your scripts to call the renamed function. But please contact me if you are
216             having problems, and I will do my best to fix them. Future releases will eventually drop the old recording method.
217              
218              
219             =head2 Using UDEV
220              
221             If, like me, you have more than one adapter fitted and find the order in which the adapters are numbered changes with reboots,
222             then you may like to use udev to define rules to fix your adapters to known numbers (see L
223             for further details).
224              
225             To create rules you make a file in /etc/udev/rules.d and call it something like 100-dvb.rules. The rules file then needs to
226             create a rule for each adapter that creates a link for all of the low-level devices (i.e. the frontend0, dvr0 etc). Each line
227             matches information about the device (using rules with "=="), then applies some setting rules (signified by using "=") to create
228             the symlink.
229              
230             For example, the following:
231              
232             SUBSYSTEM=="dvb", ATTRS{manufacturer}=="Hauppauge", ATTRS{product}=="Nova-T Stick", ATTRS{serial}=="4030521975"
233              
234             matches a Hauppage Nova-T adapter with serial number "4030521975". Note that this will match B of the devices (dvr0, frontend0
235             etc) for this adapter. The "set" rule needs to use some variables to create a link for each device.
236              
237             The set rule we use actually calls a "program" to edit some variables and output the final string followed by a rule that creates the
238             symlink:
239              
240             PROGRAM="/bin/sh -c 'K=%k; K=$${K#dvb}; printf dvb/adapter101/%%s $${K#*.}'", SYMLINK+="%c"
241            
242             The PROGRAM rule runs the sh shell and manipulates the kernel name string (which will be something like dvb/adapter0/dvr0) and creates
243             a string with a new adapter number (101 in this case). The SYMLINK rule uses this output (via the %c variable).
244              
245             Putting this together in a file:
246              
247             # /etc/udev/rules.d/100-dvb.rules
248             #
249             # To Ientify serial nos etc for a Device call
250             # udevadm info -a -p $(udevadm info -q path -n /dev/dvb/adapter0/frontend0)
251             #
252            
253             # Locate 290e at 100
254             SUBSYSTEM=="dvb", ATTRS{manufacturer}=="PCTV Systems", ATTRS{product}=="PCTV 290e", PROGRAM="/bin/sh -c 'K=%k; K=$${K#dvb}; printf dvb/adapter100/%%s $${K#*.}'", SYMLINK+="%c"
255            
256             # Locate Nova-T at 101
257             SUBSYSTEM=="dvb", ATTRS{manufacturer}=="Hauppauge", ATTRS{product}=="Nova-T Stick", PROGRAM="/bin/sh -c 'K=%k; K=$${K#dvb}; printf dvb/adapter101/%%s $${K#*.}'", SYMLINK+="%c"
258              
259             On my system this locates my PCTV DVB-T2 stick at /dev/dvb/adapter100 and my Nova-T stick at /dev/dvb/adapter101.
260              
261             You can then refer to these devices using the 'adapter_num' field as 100 and 101 (or via the 'adapter' field as '100:0' and '101:0').
262              
263              
264              
265              
266             =head2 Example Scripts
267              
268             Example scripts have been provided in the package which illustrate the expected use of the package (and
269             are useable programs in themeselves). To see the full man page of each script, simply run it with the '-man' option.
270              
271             =over 4
272              
273             =item L
274              
275             Shows information about fited DVB-T tuners
276              
277             =item L
278              
279             Run this by providing the frequency file (usually stored in /usr/share/dvb/dvb-t). If run as root, this will set up the configuration
280             files for all users. For example:
281              
282             $ dvbt-scan /usr/share/dvb/dvb-t/uk-Oxford
283              
284             NOTE: Frequency files are provided by the 'dvb' rpm package available for most distros
285              
286             =item L
287              
288             Use to display the current list of tuned channels. Shows them in logical channel number order. The latest version shows information on
289             the PID numbers for the video, audio, teletext, and subtitle streams that make up each channel.
290              
291             It also now has the option (-multi) to display the channels grouped into their multiplexes (i.e. their transponder or TSIDs). This becomes
292             really useful if you want to schedule a multiplex recording and need to check which channels you can record at the same time.
293              
294              
295             =item L
296              
297             When run, this grabs the latest EPG information and prints out the program guide:
298              
299             $ dvbt-epg
300              
301             NOTE: This process can take quite a while (it takes around 30 minutes on my system), so please be patient.
302              
303             =item L
304              
305             Specify the channel, the duration, and the output filename to record a channel:
306              
307             $ dvbt-record "bbc1" spooks.ts 1:00
308            
309             Note that the duration can be specified as an integer (number of minutes), or in HH:MM format (for hours and minutes)
310              
311             =item L
312              
313             Similar to dvbt-record, but pipes the transport stream into ffmpeg and uses that to transcode the data directly into an MPEG file (without
314             saving the transport stream file).
315              
316             Specify the channel, the duration, and the output filename to record a channel:
317              
318             $ dvbt-ffrec "bbc1" spooks.mpeg 1:00
319            
320             Note that the duration can be specified as an integer (number of minutes), or in HH:MM format (for hours and minutes)
321              
322             It's worth mentioning that this relies on ffmpeg operating correctly. Some versions of ffmpeg are fine; others have failed reporting:
323              
324             "error, non monotone timestamps"
325              
326             which appear to be related to piping the in via stdin (running ffmpeg on a saved transport stream file always seems to work)
327              
328             =item L
329              
330             Record multiple channels at the same time (as long as they are all in the same multiplex).
331              
332             Specify each recording with a filename, duration, and optional offset start time. Then specify the channel name, or a list of the pids you
333             want to record. Repeat this for every file you want to record.
334              
335             For example, you want to record some programs starting at 13:00. The list of programs are:
336              
337             =over 4
338              
339             =item * ITV2 start 13:00, duration 0:30
340              
341             =item * FIVE start 13:15, duration 0:30
342              
343             =item * ITV1 start 13:30, duration 0:30
344              
345             =item * More 4 start 13:15, duration 0:05
346              
347             =item * E4 start 13:05, duration 0:30
348              
349             =item * Channel 4+1 start 13:05, duration 1:30
350              
351             =back
352              
353             To record these (running the script at 13:00) use:
354              
355             $ dvbt-multirec file=itv2.mpeg ch=itv2 len=0:30 \
356             file=five.mpeg ch=five len=0:30 off=0:15 \
357             file=itv1.mpeg ch=itv1 len=0:30 off=0:30 \
358             file=more4.mpeg ch=more4 len=0:05 off=0:15 \
359             file=e4.mpeg ch=e4 len=0:30 off=0:05 \
360             file=ch4+1.mpeg ch='channel4+1' len=1:30 off=0:05
361            
362              
363             =back
364              
365              
366             =head2 HISTORY
367              
368             I started this package after being lent a Hauppauge WinTV-Nova-T usb tuner (thanks Tim!) and trying to
369             do some command line recording. After I'd failed to get most applications to even talk to the tuner I discovered
370             xawtv (L), started looking at it's source code and started reading the DVB-T standards.
371              
372             This package is the result of various expermients and is being used for my web TV listing and program
373             record scheduling software.
374              
375             =cut
376              
377              
378             #============================================================================================
379             # USES
380             #============================================================================================
381 10     10   168762 use strict;
  10         16  
  10         262  
382 10     10   34 use warnings;
  10         10  
  10         228  
383 10     10   35 use Carp ;
  10         10  
  10         959  
384              
385 10     10   38 use Cwd qw/realpath/ ;
  10         12  
  10         359  
386 10     10   34 use File::Basename ;
  10         9  
  10         691  
387 10     10   39 use File::Path ;
  10         16  
  10         409  
388 10     10   37 use File::Spec ;
  10         10  
  10         216  
389 10     10   4189 use POSIX qw(strftime);
  10         49784  
  10         50  
390              
391 10     10   12988 use Linux::DVB::DVBT::Config ;
  10         22  
  10         325  
392 10     10   4523 use Linux::DVB::DVBT::Utils ;
  10         31  
  10         303  
393 10     10   4633 use Linux::DVB::DVBT::Ffmpeg ;
  10         18  
  10         284  
394 10     10   4237 use Linux::DVB::DVBT::Freq ;
  10         18  
  10         377  
395 10     10   3550 use Linux::DVB::DVBT::Constants ;
  10         16  
  10         100588  
396              
397             #============================================================================================
398             # EXPORTER
399             #============================================================================================
400             require Exporter;
401             our @ISA = qw(Exporter);
402              
403             #============================================================================================
404             # GLOBALS
405             #============================================================================================
406             our $VERSION = '2.20';
407             our $AUTOLOAD ;
408              
409             #============================================================================================
410             # XS
411             #============================================================================================
412             require XSLoader;
413             XSLoader::load('Linux::DVB::DVBT', $VERSION);
414              
415             #============================================================================================
416             # CLASS VARIABLES
417             #============================================================================================
418              
419             my $DEBUG=0;
420             my $VERBOSE=0;
421             my $devices_aref ;
422              
423             ## New device "list"
424             my $devices_href ;
425              
426             #============================================================================================
427              
428              
429             =head2 FIELDS
430              
431             All of the object fields are accessed via an accessor method of the same name as the field, or
432             by using the B method where the field name and value are passed as key/value pairs in a HASH
433              
434             =over 4
435              
436             =item B - DVB adapter number
437              
438             Number of the DVBT adapter. When multiple DVBT adapters are fitted to a machine, they will be numbered from 0 onwards. Use this field to select the adapter.
439              
440             =item B - DVB frontend number
441              
442             A single adapter may have multiple frontends. If so then use this field to select the frontend within the selected adapter.
443              
444             =item B - DVB adapter
445              
446             Instead of supplying an individual adapter number and frontend number, you can use this field to supply both using the syntax:
447              
448             :
449              
450             If no frontend number is specified then the firast valid frontend number for that adapter is used.
451              
452              
453             =item B - Device path for frontend (set multiplex)
454              
455             Once the DVBT adapter has been selected, read this field to get the device path for the frontend. It will be of the form: /dev/dvb/adapter0/frontend0
456              
457             =item B - Device path for demux (select channel within multiplex)
458              
459             Once the DVBT adapter has been selected, read this field to get the device path for the demux. It will be of the form: /dev/dvb/adapter0/demux0
460              
461             =item B - Device path for dvr (video record access)
462              
463             Once the DVBT adapter has been selected, read this field to get the device path for the dvr. It will be of the form: /dev/dvb/adapter0/dvr0
464              
465             =item B - Set debug level
466              
467             Set this to the required debug level. Higher values give more verbose information.
468              
469             =item B - Fitted DVBT adapter list
470              
471             Read this ARRAY ref to get the list of fitted DVBT adapters. This is equivalent to running the L class method (see L for array format)
472              
473             =item B - Merge scan results
474              
475             Set this flag before running the scan() method. When set, the scan will merge the new results with any previous scan results (read from the config files)
476              
477             By default this flag is set (so each scan merge with prvious results). Clear this flag to re-start from fresh - useful when broadcasters change the frequencies.
478              
479             =item B - Last used frontend settings
480              
481             This is a HASH ref containing the parameters used in the last call to L (either externally or internally by this module).
482              
483             =item B - Search path for configuration files
484              
485             Set to ':' separated list of directories. When the module wants to either read or write configuration settings (for channel frequencies etc) then it uses this field
486             to determine where to read/write those files from.
487              
488             By default this is set to:
489              
490             /etc/dvb:~/.tv
491              
492             Which means that the files are read from /etc/dvb if it has been created (by root); or alternatively it uses ~/.tv (which also happens to be where xawtv stores it's files).
493             Similarly, when writing files these directories are searched until a writeable area is found (so a user won't be able to write into /etc/dvb).
494              
495             =item B - Channel tuning information
496              
497             Use this field to read back the tuning parameters HASH ref as scanned or read from the configuration files (see L method for format)
498              
499             This field is only used internally by the object but can be used for debug/information.
500              
501             =item B - Set error handling mode
502              
503             Set this field to one of 'die' (the default), 'return', or 'message' and when an error occurs that error mode action will be taken.
504              
505             If the mode is set to 'die' then the application will terminate after printing all of the errors stored in the errors list (see L field).
506             When the mode is set to 'return' then the object method returns control back to the calling application with a non-zero status (which is actually the
507             current count of errors logged so far). Similalrly, if the mode is set to 'message' then the object method simply returns the error message.
508             It is the application's responsibility to handle the errors (stored in L) when setting the mode to 'return' or 'message'.
509              
510             =item B - Timeout
511              
512             Set hardware timeout time in milliseconds. Most hardware will be ok using the default (900ms), but you can use this field to increase
513             the timeout time.
514              
515             =item B - Automatically add SI tables
516              
517             By default, recorded files automatically have the SI tables (the PAT & PMT for the program) recorded along with the
518             usual audio/video streams. This is the new default since the latest version of ffmpeg refuses to understand the
519             encoding of any video streams unless this information is added.
520              
521             If you really want to, you can change this flag to 0 to prevent SI tables being added in all cases.
522              
523             NOTE: You still get the tables whenever you add subtitles.
524              
525              
526             =item B - List of errors
527              
528             This is an ARRAY ref containing a list of any errors that have occurred. Each error is stored as a text string.
529              
530             =back
531              
532             =cut
533              
534             # List of valid fields
535             my @FIELD_LIST = qw/dvb
536             adapter
537             adapter_num frontend_num
538             frontend_name demux_name dvr_name
539             debug
540             devices
541             channel_list
542             frontend_params
543             config_path
544             tuning
545             errmode errors
546             merge
547             timeout
548             prune_channels
549             add_si
550            
551             scan_allow_duplicates
552             scan_prefer_more_chans
553            
554             scan_cb_start
555             scan_cb_end
556             scan_cb_loop_start
557             scan_cb_loop_end
558            
559             _scan_freqs
560             _device_index
561             _device_info
562             _demux_filters
563             _multiplex_info
564             _scan_info
565             / ;
566             my %FIELDS = map {$_=>1} @FIELD_LIST ;
567              
568             # Default settings
569             my %DEFAULTS = (
570             'adapter' => undef,
571             'adapter_num' => undef,
572             'frontend_num' => 0,
573            
574             'frontend_name' => undef,
575             'demux_name' => undef,
576             'dvr_name' => undef,
577            
578             'dvb' => undef,
579            
580             # List of channels of the form:
581             'channel_list' => undef,
582              
583             # parameters used to tune the frontend
584             'frontend_params' => undef,
585            
586             # Search path for config dir
587             'config_path' => $Linux::DVB::DVBT::Config::DEFAULT_CONFIG_PATH,
588              
589             # tuning info
590             'tuning' => undef,
591            
592             # Information
593             ## 'devices' => [],
594            
595             # Error log
596             'errors' => [],
597             'errmode' => 'die',
598            
599             # merge scan results with existing
600             'merge' => 1,
601            
602             # scan callback
603             'scan_cb_start' => undef,
604             'scan_cb_end' => undef,
605             'scan_cb_loop_start' => undef,
606             'scan_cb_loop_end' => undef,
607            
608             # timeout period ms
609             'timeout' => 900,
610              
611             # remove un-tuneable channels
612             'prune_channels' => 1,
613            
614             # Automatically add SI tables to recording
615             'add_si' => 1,
616              
617             # scan merge options
618             'scan_allow_duplicates' => 0,
619             'scan_prefer_more_chans' => 0,
620            
621             ######################################
622             # Internal
623            
624             # scanning driven by frequency file
625             '_scan_freqs' => 0,
626            
627             # which device in the device list are we
628             '_device_index' => undef,
629            
630             # ref to this device's info from the device list
631             '_device_info' => undef,
632            
633             # list of demux filters currently active
634             '_demux_filters' => [],
635            
636             # list of multiplex recordings scheduled
637             '_multiplex_info' => {},
638            
639             # reasons for scan choosing the freq it does for each chan
640             '_scan_info' => {},
641             ) ;
642              
643             # Frequency must be at least 100 MHz
644             # The Stockholm agreement of 1961 says:
645             # Band III : 174 MHz - 230 MHz
646             # Band IV/V : 470 MHz - 826 MHz
647             #
648             # Current dvb-t files range: 177.5 MHz - 858 MHz
649             #
650             # So 100 MHz allows for country "variations"!
651             #
652             my $MIN_FREQ = 100000000 ;
653              
654             # Maximum PID value
655             my $MAX_PID = 0x2000 ;
656              
657             # code value to use 'auto' setting
658             my $AUTO = 999 ;
659              
660             #typedef enum fe_code_rate {
661             # FEC_NONE = 0,
662             # FEC_1_2,
663             # FEC_2_3,
664             # FEC_3_4,
665             # FEC_4_5,
666             # FEC_5_6,
667             # FEC_6_7,
668             # FEC_7_8,
669             # FEC_8_9,
670             # FEC_AUTO
671             #} fe_code_rate_t;
672             #
673             # static char *ra_t[8] = { ???
674             # [ 0 ] = "12",
675             # [ 1 ] = "23",
676             # [ 2 ] = "34",
677             # [ 3 ] = "56",
678             # [ 4 ] = "78",
679             # };
680             my %FE_CODE_RATE = (
681             'NONE' => 0,
682             '1/2' => 12,
683             '2/3' => 23,
684             '3/4' => 34,
685             '4/5' => 45,
686             '5/6' => 56,
687             '6/7' => 67,
688             '7/8' => 78,
689             '8/9' => 89,
690             'AUTO' => $AUTO,
691             ) ;
692              
693             #
694             #typedef enum fe_modulation {
695             # QPSK,
696             # QAM_16,
697             # QAM_32,
698             # QAM_64,
699             # QAM_128,
700             # QAM_256,
701             # QAM_AUTO,
702             # VSB_8,
703             # VSB_16
704             #} fe_modulation_t;
705             #
706             # static char *co_t[4] = {
707             # [ 0 ] = "0",
708             # [ 1 ] = "16",
709             # [ 2 ] = "64",
710             # };
711             #
712             my %FE_MOD = (
713             'QPSK' => 0,
714             'QAM16' => 16,
715             'QAM32' => 32,
716             'QAM64' => 64,
717             'QAM128' => 128,
718             'QAM256' => 256,
719             'AUTO' => $AUTO,
720             ) ;
721              
722              
723             #typedef enum fe_transmit_mode {
724             # TRANSMISSION_MODE_2K,
725             # TRANSMISSION_MODE_8K,
726             # TRANSMISSION_MODE_AUTO
727             #} fe_transmit_mode_t;
728             #
729             # static char *tr[2] = {
730             # [ 0 ] = "2",
731             # [ 1 ] = "8",
732             # };
733             my %FE_TRANSMISSION = (
734             '2k' => 2,
735             '8k' => 8,
736             'AUTO' => $AUTO,
737             ) ;
738              
739             #typedef enum fe_bandwidth {
740             # BANDWIDTH_8_MHZ,
741             # BANDWIDTH_7_MHZ,
742             # BANDWIDTH_6_MHZ,
743             # BANDWIDTH_AUTO
744             #} fe_bandwidth_t;
745             #
746             # static char *bw[4] = {
747             # [ 0 ] = "8",
748             # [ 1 ] = "7",
749             # [ 2 ] = "6",
750             # };
751             my %FE_BW = (
752             '8MHz' => 8,
753             '7MHz' => 7,
754             '6MHz' => 6,
755             'AUTO' => $AUTO,
756             ) ;
757              
758             #
759             #typedef enum fe_guard_interval {
760             # GUARD_INTERVAL_1_32,
761             # GUARD_INTERVAL_1_16,
762             # GUARD_INTERVAL_1_8,
763             # GUARD_INTERVAL_1_4,
764             # GUARD_INTERVAL_AUTO
765             #} fe_guard_interval_t;
766             #
767             # static char *gu[4] = {
768             # [ 0 ] = "32",
769             # [ 1 ] = "16",
770             # [ 2 ] = "8",
771             # [ 3 ] = "4",
772             # };
773             my %FE_GUARD = (
774             '1/32' => 32,
775             '1/16' => 16,
776             '1/8' => 8,
777             '1/4' => 4,
778             'AUTO' => $AUTO,
779             ) ;
780              
781             #typedef enum fe_hierarchy {
782             # HIERARCHY_NONE,
783             # HIERARCHY_1,
784             # HIERARCHY_2,
785             # HIERARCHY_4,
786             # HIERARCHY_AUTO
787             #} fe_hierarchy_t;
788             #
789             # static char *hi[4] = {
790             # [ 0 ] = "0",
791             # [ 1 ] = "1",
792             # [ 2 ] = "2",
793             # [ 3 ] = "4",
794             # };
795             #
796             my %FE_HIER = (
797             'NONE' => 0,
798             '1' => 1,
799             '2' => 2,
800             '4' => 4,
801             'AUTO' => $AUTO,
802             ) ;
803              
804             my %FE_INV = (
805             'NONE' => 0,
806             '0' => 0,
807             '1' => 1,
808             'AUTO' => $AUTO,
809             ) ;
810              
811             ## All FE params
812             my %FE_PARAMS = (
813             bandwidth => \%FE_BW,
814             code_rate_high => \%FE_CODE_RATE,
815             code_rate_low => \%FE_CODE_RATE,
816             modulation => \%FE_MOD,
817             transmission => \%FE_TRANSMISSION,
818             guard_interval => \%FE_GUARD,
819             hierarchy => \%FE_HIER,
820             inversion => \%FE_INV,
821             ) ;
822              
823             my %FE_CAPABLE = (
824             bandwidth => 'FE_CAN_BANDWIDTH_AUTO',
825             code_rate_high => 'FE_CAN_FEC_AUTO',
826             code_rate_low => 'FE_CAN_FEC_AUTO',
827             modulation => 'FE_CAN_QAM_AUTO',
828             transmission => 'FE_CAN_TRANSMISSION_MODE_AUTO',
829             guard_interval => 'FE_CAN_GUARD_INTERVAL_AUTO',
830             hierarchy => 'FE_CAN_HIERARCHY_AUTO',
831             inversion => 'FE_CAN_INVERSION_AUTO',
832             ) ;
833              
834              
835             ## ETSI 300 468 SI TABLES
836             my %SI_TABLES = (
837             # MPEG-2
838             'PAT' => 0x00,
839             'CAT' => 0x01,
840             'TSDT' => 0x02,
841            
842             # DVB
843             'NIT' => 0x10,
844             'SDT' => 0x11,
845             'EIT' => 0x12,
846             'RST' => 0x13,
847             'TDT' => 0x14,
848             ) ;
849              
850             my %SI_LOOKUP = reverse %SI_TABLES ;
851              
852             my %EPG_FLAGS = (
853             'AUDIO_MONO' => (1 << 0),
854             'AUDIO_STEREO' => (1 << 1),
855             'AUDIO_DUAL' => (1 << 2),
856             'AUDIO_MULTI' => (1 << 3),
857             'AUDIO_SURROUND' => (1 << 4),
858             'AUDIO_HEAAC' => (1 << 5),
859              
860             'VIDEO_4_3' => (1 << 8),
861             'VIDEO_16_9' => (1 << 9),
862             'VIDEO_HDTV' => (1 << 10),
863             'VIDEO_H264' => (1 << 11),
864              
865             'SUBTITLES' => (1 << 16),
866             ) ;
867              
868              
869             ## Service type codings (i.e. program types)
870             my %SERVICE_TYPE = (
871             'tv' => 0x01,
872             'radio' => 0x02,
873             'hd-tv' => 0x19,
874             ) ;
875              
876             ## Service type name
877             my %SERVICE_NAME = map { $SERVICE_TYPE{$_} => $_ } keys %SERVICE_TYPE ;
878              
879              
880             #============================================================================================
881              
882             =head2 CONSTRUCTOR
883              
884             =over 4
885              
886             =cut
887              
888             #============================================================================================
889              
890             =item B
891              
892             Create a new object.
893              
894             The %args are specified as they would be in the B method, for example:
895              
896             'adapter_num' => 0
897              
898             The full list of possible arguments are as described in the L section
899              
900             =cut
901              
902             sub new
903             {
904 5     5 1 253 my ($obj, %args) = @_ ;
905              
906 5   33     32 my $class = ref($obj) || $obj ;
907              
908             # Create object
909 5         172 my $self = {} ;
910 5         11 bless ($self, $class) ;
911              
912             # Initialise object
913 5         26 $self->_init(%args) ;
914              
915             # Set devices list
916 5         24 $self->device_list() ; # ensure list has been created
917              
918             # Initialise hardware
919             # Special case - allow for dvb being preset (for testing)
920 5 50       16 unless($self->{dvb})
921             {
922 0         0 $self->hwinit() ;
923             }
924              
925 5         22 return($self) ;
926             }
927              
928              
929             #-----------------------------------------------------------------------------
930             # Object initialisation
931             sub _init
932             {
933 5     5   10 my $self = shift ;
934 5         14 my (%args) = @_ ;
935              
936             # Defaults
937 5         14 foreach (@FIELD_LIST)
938             {
939 155         180 $self->{$_} = undef ;
940 155 100       287 $self->{$_} = $DEFAULTS{$_} if (exists($DEFAULTS{$_})) ;
941             }
942              
943             # Set fields from parameters
944 5         27 $self->set(%args) ;
945             }
946              
947              
948              
949             #-----------------------------------------------------------------------------
950             # Object destruction
951             sub DESTROY
952             {
953 5     5   6426 my $self = shift ;
954              
955 5         26 $self->dvb_close() ;
956             }
957              
958              
959             #-----------------------------------------------------------------------------
960              
961             =item B
962              
963             Close the hardware down (for example, to allow another script access), without
964             destroying the object.
965              
966             =cut
967              
968             sub dvb_close
969             {
970 5     5 1 10 my $self = shift ;
971              
972 5 50       441 if (ref($self->{dvb}))
973             {
974             ## Close any open demux filters
975 0         0 $self->close_demux_filters() ;
976              
977             ## Free up hardware
978 0         0 dvb_fini($self->dvb) ;
979            
980 0         0 $self->{dvb} = undef ;
981             }
982             }
983              
984              
985              
986             #============================================================================================
987              
988             =back
989              
990             =head2 CLASS METHODS
991              
992             Use as Linux::DVB::DVBT->method()
993              
994             =over 4
995              
996             =cut
997              
998             #============================================================================================
999              
1000             #-----------------------------------------------------------------------------
1001              
1002             =item B
1003              
1004             Set new debug level. Returns setting.
1005              
1006             =cut
1007              
1008             sub debug
1009             {
1010 3     3 1 707 my ($obj, $level) = @_ ;
1011              
1012 3 100       7 if (defined($level))
1013             {
1014 2         47 $DEBUG = $level ;
1015            
1016             ## Set utility module debug levels
1017 2         3 $Linux::DVB::DVBT::Config::DEBUG = $DEBUG ;
1018 2         2 $Linux::DVB::DVBT::Utils::DEBUG = $DEBUG ;
1019 2         3 $Linux::DVB::DVBT::Ffmpeg::DEBUG = $DEBUG ;
1020             }
1021              
1022 3         32 return $DEBUG ;
1023             }
1024              
1025             #-----------------------------------------------------------------------------
1026              
1027             =item B
1028              
1029             Set new debug level for dvb XS code
1030              
1031             =cut
1032              
1033             sub dvb_debug
1034             {
1035 0     0 1 0 my ($obj, $level) = @_ ;
1036              
1037 0   0     0 dvb_set_debug($level||0) ;
1038             }
1039              
1040             #-----------------------------------------------------------------------------
1041              
1042             =item B
1043              
1044             Set new verbosity level. Returns setting.
1045              
1046             =cut
1047              
1048             sub verbose
1049             {
1050 0     0 1 0 my ($obj, $level) = @_ ;
1051              
1052 0 0       0 if (defined($level))
1053             {
1054 0         0 $VERBOSE = $level ;
1055             }
1056              
1057 0         0 return $VERBOSE ;
1058             }
1059              
1060             #-----------------------------------------------------------------------------
1061              
1062             =item B
1063              
1064             Return list of available hardware as an array of hashes. Each hash entry is of the form:
1065              
1066              
1067             {
1068             'device' => device name (e.g. '/dev/dvb/adapter0')
1069             'name' => Manufacturer name
1070             'adpater_num' => Adapter number
1071             'frontend_num' => Frontend number
1072             'flags' => Adapter capability flags
1073              
1074             'capabilities' => HASH (see below)
1075             'fe_type' => Frontend type (e.g. 'FE_OFDM')
1076             'type' => adapter type (e.g. 'DVB-T')
1077              
1078             'frequency_max' => Maximum supported frequency
1079             'frequency_min' => Minimum supported frequency
1080             'frequency_stepsize' => Frequency stepping
1081             }
1082              
1083            
1084             The 'flags' field is split into a HASH under the 'capabilities' field, each capability a flag that is set or cleared:
1085            
1086             'capabilities' => {
1087             'FE_CAN_QAM_16' => 1,
1088             'FE_CAN_TRANSMISSION_MODE_AUTO' => 1,
1089             'FE_IS_STUPID' => 0,
1090             'FE_CAN_QAM_AUTO' => 1,
1091             'FE_CAN_FEC_1_2' => 1,
1092             'FE_CAN_QAM_32' => 0,
1093             'FE_CAN_FEC_5_6' => 1,
1094             'FE_CAN_FEC_6_7' => 0,
1095             'FE_CAN_HIERARCHY_AUTO' => 1,
1096             'FE_CAN_RECOVER' => 1,
1097             'FE_CAN_FEC_3_4' => 1,
1098             'FE_CAN_FEC_7_8' => 1,
1099             'FE_CAN_FEC_2_3' => 1,
1100             'FE_CAN_QAM_128' => 0,
1101             'FE_CAN_FEC_4_5' => 0,
1102             'FE_CAN_FEC_AUTO' => 1,
1103             'FE_CAN_QPSK' => 1,
1104             'FE_CAN_QAM_64' => 1,
1105             'FE_CAN_QAM_256' => 0,
1106             'FE_CAN_8VSB' => 0,
1107             'FE_CAN_GUARD_INTERVAL_AUTO' => 1,
1108             'FE_CAN_BANDWIDTH_AUTO' => 0,
1109             'FE_CAN_INVERSION_AUTO' => 1,
1110             'FE_CAN_MUTE_TS' => 0,
1111             'FE_CAN_16VSB' => 0
1112             }
1113            
1114              
1115             Where a device is actually a link to a real device, there is the additonal field:
1116              
1117             'symlink' => {
1118            
1119             'adpater_num' => Adapter number
1120             'frontend_num' => Frontend number
1121            
1122             }
1123              
1124             which details the real device the link points to.
1125              
1126             By default, this routine will only return details of DVB-T/T2 adapters. To return the list of all adapters
1127             discovered (including DVB-C etc) add the optional arguments:
1128              
1129             'show' => 'all'
1130              
1131             for example:
1132              
1133             my @devices = $dvb->device_list('show' => 'all') ;
1134              
1135              
1136             Note that this information is also available via the object instance using the 'devices' method, but this
1137             returns an ARRAY REF (rather than an ARRAY)
1138              
1139             =cut
1140              
1141             sub device_list
1142             {
1143 5     5 1 11 my ($class, %args) = @_ ;
1144              
1145 5 50 33     25 if ( !$devices_href || (keys %args) )
1146             {
1147 5         6 my $showall = 0 ;
1148 5 50       15 if (exists($args{'show'}))
1149             {
1150 0         0 ++$showall ;
1151             }
1152            
1153             # Get list of available devices & information for those devices
1154 5         240 foreach my $adap_d (glob("/dev/dvb/adapter*"))
1155             {
1156 0 0 0     0 if ( (-d $adap_d) && ($adap_d =~ /adapter(\d+)/) )
1157             {
1158 0         0 my $adap = $1 ;
1159 0         0 foreach my $fe_f (glob("$adap_d/frontend*"))
1160             {
1161 0 0       0 if ( $fe_f =~ /frontend(\d+)/ )
1162             {
1163 0         0 my $fe = $1 ;
1164            
1165             # get info
1166 0         0 my $info_href = dvb_device_probe($adap, $fe, $DEBUG) ;
1167            
1168 0 0       0 prt_data("dvb_device_probe(adap=$adap, fe=$fe)=", $info_href) if $DEBUG >= 10 ;
1169            
1170             # skip non DVB-T adapters unless we're displaying all adapters
1171 0   0     0 my $type = $info_href->{'type'} || "" ;
1172 0 0 0     0 next if ($type ne 'DVB-T') && !$showall ;
1173 0 0       0 next unless $type ;
1174            
1175             # check for this being a link (i.e. using udev to fix the adapaters to known identifiers)
1176 0 0       0 if ( -l $fe_f )
1177             {
1178 0         0 my $target = readlink $fe_f ;
1179 0         0 $target = realpath( File::Spec->rel2abs($target, $adap_d) ) ;
1180 0 0       0 if ($target =~ m%/dev/dvb/adapter(\d+)/frontend(\d+)%)
1181             {
1182 0         0 $info_href->{'symlink'} = {
1183             'adapter_num' => int($1),
1184             'frontend_num' => int($2),
1185             } ;
1186             }
1187             else
1188             {
1189 0         0 $fe_f = "" ;
1190             }
1191             }
1192            
1193 0 0       0 $devices_href->{$fe_f} = $info_href if $fe_f ;
1194             }
1195             }
1196             }
1197             }
1198             }
1199            
1200             # sort by adapter/frontend
1201 5         17 my $devices_aref = [] ;
1202 5         23 foreach my $key (sort {
1203             $devices_href->{$a}{'adapter_num'} <=> $devices_href->{$b}{'adapter_num'}
1204             ||
1205 0 0       0 $devices_href->{$a}{'frontend_num'} <=> $devices_href->{$b}{'frontend_num'}
1206             } keys %$devices_href)
1207             {
1208 0         0 push @$devices_aref, $devices_href->{$key} ;
1209             }
1210              
1211 5 50       20 prt_data("DEVICE LIST=", $devices_aref) if $DEBUG >= 10 ;
1212              
1213 5         12 return @$devices_aref ;
1214             }
1215              
1216             #----------------------------------------------------------------------------
1217              
1218             =item B
1219              
1220             If there was an error during one of the function calls, returns the error string; otherwise
1221             returns "".
1222              
1223             =cut
1224              
1225             sub is_error
1226             {
1227 0     0 1 0 my ($class) = @_ ;
1228 0         0 my $error_str = dvb_error_str() ;
1229            
1230 0 0       0 if ($error_str =~ /no error/i)
1231             {
1232 0         0 $error_str = "" ;
1233             }
1234 0         0 return $error_str ;
1235             }
1236              
1237              
1238             #============================================================================================
1239              
1240             =back
1241              
1242             =head2 OBJECT METHODS
1243              
1244             =over 4
1245              
1246             =cut
1247              
1248             #============================================================================================
1249              
1250             #----------------------------------------------------------------------------
1251              
1252             =item B
1253              
1254             Set one or more settable parameter.
1255              
1256             The %args are specified as a hash, for example
1257              
1258             set('frequency' => 578000)
1259              
1260             The full list of possible arguments are as described in the L section
1261              
1262             =cut
1263              
1264             sub set
1265             {
1266 5     5 1 8 my $self = shift ;
1267 5         18 my (%args) = @_ ;
1268              
1269             # Args
1270 5         11 foreach my $field (@FIELD_LIST)
1271             {
1272 155 100       222 if (exists($args{$field}))
1273             {
1274 31         146 $self->$field($args{$field}) ;
1275             }
1276             }
1277              
1278             }
1279              
1280             #-----------------------------------------------------------------------------
1281             # Return the list of devices (kept for backward compatibility)
1282             sub devices
1283             {
1284 0     0 1 0 my $self = shift ;
1285            
1286 0         0 my @devices = $self->device_list() ;
1287            
1288 0         0 return \@devices ;
1289             }
1290              
1291              
1292              
1293             #----------------------------------------------------------------------------
1294              
1295             =item B
1296              
1297             Add the error message to the error log and then handle the error depending on the setting of the 'errmode' field.
1298              
1299             Get the log as an ARRAY ref via the 'errors()' method.
1300              
1301             =cut
1302              
1303             sub handle_error
1304             {
1305 6     6 1 8 my $self = shift ;
1306 6         6 my ($error_message) = @_ ;
1307              
1308             # Log message
1309 6         14 $self->log_error($error_message) ;
1310              
1311             # Handle error
1312 6         17 my $mode = $self->errmode ;
1313            
1314 6 50       24 if ($mode =~ m/return/i)
    50          
    0          
1315             {
1316             # return number of errors logged so far
1317 0         0 return scalar(@{$self->errors()}) ;
  0         0  
1318             }
1319             elsif ($mode =~ m/message/i)
1320             {
1321             # return this error message
1322 6         19 return $error_message ;
1323             }
1324             elsif ($mode =~ m/die/i)
1325             {
1326             # Die showing all logged errors
1327 0         0 croak join ("\n", @{$self->errors()}) ;
  0         0  
1328             }
1329             }
1330              
1331              
1332             #============================================================================================
1333              
1334             =back
1335              
1336             =head3 SCANNING
1337              
1338             =over 4
1339              
1340             =cut
1341              
1342             #============================================================================================
1343              
1344             #----------------------------------------------------------------------------
1345              
1346             =item B
1347              
1348             Starts a channel scan using previously set tuning. On successful completion of a scan,
1349             saves the results into the configuration files.
1350              
1351             Returns the discovered channel information as a HASH:
1352              
1353             'pr' =>
1354             {
1355             $channel_name =>
1356             {
1357             'audio' => "407",
1358             'audio_details' => "eng:407 und:408",
1359             'ca' => "0",
1360             'name' => "301",
1361             'net' => "BBC",
1362             'pnr' => "19456",
1363             'running' => "4",
1364             'teletext' => "0",
1365             'tsid' => "16384",
1366             'type' => "1",
1367             'video' => "203",
1368             'lcn' => 301
1369             },
1370             ....
1371             },
1372            
1373             'ts' =>
1374             {
1375             $tsid =>
1376             {
1377             'bandwidth' => "8",
1378             'code_rate_high' => "23",
1379             'code_rate_low' => "12",
1380             'frequency' => "713833330",
1381             'guard_interval' => "32",
1382             'hierarchy' => "0",
1383             'modulation' => "64",
1384             'net' => "Oxford/Bexley",
1385             'transmission' => "2",
1386             },
1387             ...
1388             }
1389              
1390             Normally this information is only used internally.
1391              
1392             =cut
1393              
1394             sub scan
1395             {
1396 0     0 1 0 my $self = shift ;
1397              
1398 0         0 my $scan_info_href = $self->_scan_info() ;
1399 0 0       0 prt_data("scan() : Scan info [$scan_info_href]=", $scan_info_href) if $DEBUG>=5 ;
1400 0   0     0 $scan_info_href->{'chans'} ||= {} ;
1401 0   0     0 $scan_info_href->{'tsids'} ||= {} ;
1402 0   0     0 $scan_info_href->{'tsid_order'} ||= [] ;
1403              
1404 0         0 my %scan_merge_options = (
1405             'duplicates' => $self->scan_allow_duplicates(),
1406             'num_chans' => $self->scan_prefer_more_chans(),
1407             ) ;
1408              
1409             # Get any existing info
1410 0         0 my $tuning_href = $self->get_tuning_info() ;
1411              
1412 0 0       0 prt_data("Current tuning info=", $tuning_href) if $DEBUG>=5 ;
1413              
1414             # hardware closed
1415 0 0       0 if ($self->dvb_closed())
1416             {
1417             # Raise an error
1418 0         0 return $self->handle_error("DVB tuner has been closed") ;
1419             }
1420              
1421             # if not tuned by now then we have to raise an error
1422 0 0       0 if (!$self->frontend_params())
1423             {
1424             # Raise an error
1425 0         0 return $self->handle_error("Frontend must be tuned before running scan()") ;
1426             }
1427              
1428             ## Initialise for scan
1429 0 0       0 dvb_scan_new($self->{dvb}, $VERBOSE) unless $self->_scan_freqs ;
1430 0         0 dvb_scan_init($self->{dvb}, $VERBOSE) ;
1431              
1432              
1433             ## Do scan
1434             #
1435             # Scan results are returned in arrays:
1436             #
1437             # freqs =>
1438             # { # HASH(0x844d76c)
1439             # 482000000 =>
1440             # { # HASH(0x8448da4)
1441             # 'seen' => 1,
1442             # 'strength' => 0,
1443             # 'tuned' => 0,
1444             # },
1445             #
1446             # '177500000' => {
1447             # 'guard_interval' => 2,
1448             # 'transmission' => 4,
1449             # 'code_rate_high' => 16,
1450             # 'tuned' => 1,
1451             # 'strength' => 49420,
1452             # 'modulation' => 2,
1453             # 'seen' => 1,
1454             # 'bandwidth' => 7,
1455             # 'code_rate_low' => 16,
1456             # 'hierarchy' => 0,
1457             # 'inversion' => 2
1458             # }
1459             #readback tuning:
1460             # __u32 frequency=177500000
1461             # fe_spectral_inversion_t inversion=2 (auto)
1462             # fe_bandwidth_t bandwidthy=1 (7 MHz)
1463             # fe_code_rate_t code_rate_HPy=3 (3/4)
1464             # fe_code_rate_t code_rate_LP=1 (1/2)
1465             # fe_modulation_t constellation=3 (64)
1466             # fe_transmit_mode_t transmission_mod=1 (8k)
1467             # fe_guard_interval_t guard_interval=0 (1/32)
1468             # fe_hierarchy_t hierarchy_information=0 (none)
1469             #
1470             # 'pr' =>
1471             # [
1472             # {
1473             # 'audio' => "407",
1474             # 'audio_details' => "eng:407 und:408",
1475             # 'ca' => "0",
1476             # 'name' => "301",
1477             # 'net' => "BBC",
1478             # 'pnr' => "19456",
1479             # 'running' => "4",
1480             # 'teletext' => "0",
1481             # 'tsid' => "16384",
1482             # 'type' => "1",
1483             # 'video' => "203",
1484             # 'lcn' => 301
1485             # 'freqs' => [
1486             # 57800000,
1487             # ],
1488             # },
1489             # ....
1490             # ],
1491             #
1492             # 'ts' =>
1493             # [
1494             # {
1495             # 'tsid' => 4107,
1496             # 'bandwidth' => "8",
1497             # 'code_rate_high' => "23",
1498             # 'code_rate_low' => "12",
1499             # 'frequency' => "713833330", # reported centre freq
1500             # 'guard_interval' => "32",
1501             # 'hierarchy' => "0",
1502             # 'modulation' => "64",
1503             # 'net' => "Oxford/Bexley",
1504             # 'transmission' => "2",
1505             # 'lcn' =>
1506             # {
1507             # $pnr => {
1508             # 'lcn' => 305,
1509             # 'service_type' => 24,
1510             # 'visible' => 1,
1511             # }
1512             # }
1513             # },
1514             # ...
1515             # ]
1516             #
1517             # these results need to analysed and converted into the expected format:
1518             #
1519             # 'pr' =>
1520             # {
1521             # $channel_name =>
1522             # {
1523             # 'audio' => "407",
1524             # ...
1525             # },
1526             # ....
1527             # },
1528             #
1529             # 'ts' =>
1530             # {
1531             # $tsid =>
1532             # {
1533             # 'bandwidth' => "8",
1534             # ...
1535             # },
1536             # ...
1537             # }
1538             #
1539             # lcn =>
1540             # { # HASH(0x83d2608)
1541             # $tsid =>
1542             # { # HASH(0x8442524)
1543             # $pnr =>
1544             # { # HASH(0x8442578)
1545             # lcn => 20,
1546             # service_type => 2,
1547             # visible => 1,
1548             # },
1549             # },
1550             # 16384 =>
1551             # { # HASH(0x8442af4)
1552             # 18496 =>
1553             # { # HASH(0x8442b48)
1554             # lcn => 700,
1555             # service_type => 4,
1556             # visible => 1,
1557             # },
1558             # },
1559             #
1560 0         0 my $raw_scan_href = dvb_scan($self->{dvb}, $VERBOSE) ;
1561              
1562 0 0       0 prt_data("Raw scan results=", $raw_scan_href) if $DEBUG>=5 ;
1563 0 0       0 print STDERR "dvb_scan_end()...\n" if $DEBUG>=5 ;
1564              
1565             ## Clear up after scan
1566 0         0 dvb_scan_end($self->{dvb}, $VERBOSE) ;
1567 0 0       0 dvb_scan_new($self->{dvb}, $VERBOSE) unless $self->_scan_freqs ;
1568              
1569 0 0       0 print STDERR "process raw...\n" if $DEBUG>=5 ;
1570              
1571             ## Process the raw results for programs
1572             my $scan_href = {
1573 0         0 'freqs' => $raw_scan_href->{'freqs'},
1574             'lcn' => {},
1575             } ;
1576              
1577 0 0       0 prt_data("initial scan results=", $scan_href) if $DEBUG>=5 ;
1578              
1579             ## Collect together LCN info and map TSIDs to transponder settings
1580 0         0 my %tsids ;
1581 0         0 foreach my $ts_href (@{$raw_scan_href->{'ts'}})
  0         0  
1582             {
1583 0         0 my $tsid = $ts_href->{'tsid'} ;
1584            
1585             # handle LCN
1586 0         0 my $lcn_href = delete $ts_href->{'lcn'} ;
1587 0         0 foreach my $pnr (keys %$lcn_href)
1588             {
1589 0         0 $scan_href->{'lcn'}{$tsid}{$pnr} = $lcn_href->{$pnr} ;
1590             }
1591              
1592             # set TSID
1593 0         0 $tsids{$tsid} = $ts_href ;
1594 0         0 $tsids{$tsid}{'frequency'} = undef ;
1595             }
1596              
1597 0 0       0 if ($VERBOSE >= 3)
1598             {
1599 0         0 print STDERR "\n========================================================\n" ;
1600 0         0 foreach my $ts_href (@{$raw_scan_href->{'ts'}})
  0         0  
1601             {
1602 0         0 my $tsid = $ts_href->{'tsid'} ;
1603 0         0 print STDERR "--------------------------------------------------------\n" ;
1604 0         0 print STDERR "TSID $tsid\n" ;
1605 0         0 print STDERR "--------------------------------------------------------\n" ;
1606            
1607 0         0 foreach my $prog_href (@{$raw_scan_href->{'pr'}})
  0         0  
1608             {
1609 0         0 my $ptsid = $prog_href->{'tsid'} ;
1610 0 0       0 next unless $ptsid eq $tsid ;
1611            
1612 0         0 my $name = $prog_href->{'name'} ;
1613 0         0 my $pnr = $prog_href->{'pnr'} ;
1614 0         0 my $lcn = $scan_href->{'lcn'}{$tsid}{$pnr} ;
1615 0 0       0 $lcn = $lcn ? sprintf("%2d", $lcn) : "??" ;
1616            
1617 0         0 my $freqs_aref = $prog_href->{'freqs'} ;
1618            
1619 0         0 print STDERR " $lcn : [$pnr] $name - " ;
1620 0         0 foreach my $freq (@$freqs_aref)
1621             {
1622 0         0 print STDERR "$freq Hz " ;
1623             }
1624 0         0 print STDERR "\n" ;
1625              
1626             }
1627             }
1628 0         0 print STDERR "\n========================================================\n" ;
1629             }
1630              
1631             ## Use program info to map TSID to freq (choose strongest signal where necessary)
1632 0         0 foreach my $prog_href (@{$raw_scan_href->{'pr'}})
  0         0  
1633             {
1634 0         0 my $tsid = $prog_href->{'tsid'} ;
1635 0         0 my $name = $prog_href->{'name'} ;
1636 0         0 my $pnr = $prog_href->{'pnr'} ;
1637            
1638 0   0     0 $scan_info_href->{'chans'}{$name} ||= {
1639             'comments' => [],
1640             } ;
1641 0   0     0 $scan_info_href->{'tsids'}{$tsid} ||= {
1642             'comments' => [],
1643             } ;
1644              
1645 0 0       0 print STDERR "scan info:: CHAN $name\n" if $DEBUG >= 10 ;
1646            
1647 0         0 my $freqs_aref = delete $prog_href->{'freqs'} ;
1648 0 0       0 unless (@$freqs_aref)
1649             {
1650 0         0 push @{$scan_info_href->{'chans'}{$name}{'comments'}}, "no freqs : TSID $tsid" ;
  0         0  
1651 0 0       0 print STDERR "scan info:: + add comment 'no freqs : TSID $tsid' - CHAN $name\n" if $DEBUG >= 10 ;
1652             }
1653 0 0       0 next unless @$freqs_aref ;
1654 0         0 my $freq = @{$freqs_aref}[0] ;
  0         0  
1655            
1656             # handle multiple freqs
1657 0 0       0 if (@$freqs_aref >= 2)
1658             {
1659 0         0 push @{$scan_info_href->{'chans'}{$name}{'comments'}}, "multiple freqs : TSID $tsid" ;
  0         0  
1660 0         0 foreach my $new_freq (@$freqs_aref)
1661             {
1662 0 0       0 if ($new_freq != $freq)
1663             {
1664             # check strengths
1665 0         0 my $new_strength = $raw_scan_href->{'freqs'}{$freq}{'strength'} ;
1666 0         0 my $old_strength = $raw_scan_href->{'freqs'}{$new_freq}{'strength'} ;
1667 0 0       0 if ($new_strength > $old_strength)
1668             {
1669 0 0       0 print STDERR " Program \"$name\" ($pnr) with multiple freqs : using new signal $new_strength (old $old_strength) change freq from $freq to $new_freq\n" if $VERBOSE ;
1670 0         0 $freq = $new_freq ;
1671              
1672 0         0 push @{$scan_info_href->{'chans'}{$name}{'comments'}}, "multiple freqs : TSID $tsid : using new signal $new_strength (old $old_strength) change freq from $freq to $new_freq" ;
  0         0  
1673 0         0 push @{$scan_info_href->{'tsids'}{$tsid}{'comments'}}, "multiple freqs : using new signal $new_strength (old $old_strength) change freq from $freq to $new_freq" ;
  0         0  
1674             }
1675             }
1676             }
1677             }
1678            
1679             # save program data
1680 0         0 my $hdtv = 0 ;
1681 0         0 $scan_href->{'pr'}{$name} = $prog_href ;
1682 0 0 0     0 if (exists($scan_href->{'lcn'}{$tsid}) && exists($scan_href->{'lcn'}{$tsid}{$pnr}))
1683             {
1684 0         0 $scan_href->{'pr'}{$name}{'lcn'} = $scan_href->{'lcn'}{$tsid}{$pnr}{'lcn'} ;
1685              
1686 0 0       0 if ($scan_href->{'pr'}{$name}{'type'}==$SERVICE_TYPE{'hd-tv'})
1687             {
1688             # set flag for this TSID
1689 0         0 $hdtv = 1 ;
1690             }
1691             }
1692            
1693             # Set transponder freq
1694 0 0 0     0 if ( (!defined($tsids{$tsid}{'frequency'})) || ($tsids{$tsid}{'frequency'} != $freq) )
1695             {
1696 0         0 push @{$scan_info_href->{'tsids'}{$tsid}{'comments'}}, "set freq $freq" ;
  0         0  
1697             }
1698 0         0 $tsids{$tsid}{'frequency'} = $freq ;
1699 0         0 $scan_href->{'ts'}{$tsid} = $tsids{$tsid} ;
1700            
1701             # hd-tv flag (set if *any* program in it's multiplex is HD)
1702 0         0 $scan_href->{'ts'}{$tsid}{'hd-tv'} = $hdtv ;
1703              
1704 0         0 push @{$scan_info_href->{'chans'}{$name}{'comments'}}, "set freq $freq : TSID $tsid" ;
  0         0  
1705              
1706 0 0       0 print STDERR "scan info:: + add comment 'set freq $freq : TSID $tsid' - CHAN $name\n" if $DEBUG >= 10 ;
1707             }
1708            
1709              
1710 0 0       0 prt_data("Scan info=", $scan_info_href) if $DEBUG>=5 ;
1711 0 0       0 prt_data("Scan results=", $scan_href) if $DEBUG>=5 ;
1712 0 0       0 print STDERR "process rest...\n" if $DEBUG>=5 ;
1713            
1714             ## Post-process to weed out undesirables!
1715 0         0 my %tsid_map ;
1716             my @del ;
1717 0         0 foreach my $chan (keys %{$scan_href->{'pr'}})
  0         0  
1718             {
1719             # strip out chans with no names (or just spaces)
1720 0 0       0 if ($chan !~ /\S+/)
1721             {
1722 0         0 push @del, $chan ;
1723 0         0 next ;
1724             }
1725 0         0 my $tsid = $scan_href->{'pr'}{$chan}{'tsid'} ;
1726 0         0 my $pnr = $scan_href->{'pr'}{$chan}{'pnr'} ;
1727 0         0 $tsid_map{"$tsid-$pnr"} = $chan ;
1728             }
1729            
1730 0         0 foreach my $chan (@del)
1731             {
1732 0 0       0 print STDERR " + del chan \"$chan\"\n" if $DEBUG>=5 ;
1733              
1734 0         0 delete $scan_href->{'pr'}{$chan} ;
1735             }
1736              
1737 0 0       0 prt_data("!!POST-PROCESS tsid_map=", \%tsid_map) if $DEBUG>=5 ;
1738            
1739             ## Post-process based on logical channel number iff we have this data
1740            
1741             # lcn =>
1742             # { # HASH(0x83d2608)
1743             # 12290 =>
1744             # { # HASH(0x8442524)
1745             # 12866 =>
1746             # { # HASH(0x8442578)
1747             # service_type => 2,
1748             # },
1749             # },
1750             # 16384 =>
1751             # { # HASH(0x8442af4)
1752             # 18496 =>
1753             # { # HASH(0x8442b48)
1754             # lcn => 700,
1755             # service_type => 4,
1756             # visible => 1,
1757             # },
1758             # },
1759 0 0       0 if (keys %{$scan_href->{'lcn'}})
  0         0  
1760             {
1761 0         0 foreach my $tsid (keys %{$scan_href->{'lcn'}})
  0         0  
1762             {
1763 0         0 foreach my $pnr (keys %{$scan_href->{'lcn'}{$tsid}})
  0         0  
1764             {
1765 0         0 my $lcn_href = $scan_href->{'lcn'}{$tsid}{$pnr} ;
1766 0         0 my $chan = $tsid_map{"$tsid-$pnr"} ;
1767            
1768 0 0       0 next unless $chan ;
1769 0 0       0 next unless exists($scan_href->{'pr'}{$chan}) ;
1770            
1771 0 0       0 if ($DEBUG>=5)
1772             {
1773 0 0       0 my $lcn = defined($lcn_href->{'lcn'}) ? $lcn_href->{'lcn'} : 'undef' ;
1774 0 0       0 my $vis = defined($lcn_href->{'visible'}) ? $lcn_href->{'visible'} : 'undef' ;
1775 0 0       0 my $type = defined($lcn_href->{'service_type'}) ? $lcn_href->{'service_type'} : 'undef' ;
1776            
1777 0         0 print STDERR " : $tsid-$pnr - $chan : lcn=$lcn, vis=$vis, service type=$type type=$scan_href->{'pr'}{$chan}{'type'}\n" ;
1778             }
1779            
1780             ## handle LCN if set
1781 0         0 my $delete = 0 ;
1782 0 0 0     0 if ($lcn_href && $lcn_href->{'lcn'} )
1783             {
1784             ## Set entry channel number
1785 0         0 $scan_href->{'pr'}{$chan}{'lcn'} = $lcn_href->{'lcn'} ;
1786            
1787 0 0       0 print STDERR " : : set lcn for $chan : vid=$scan_href->{'pr'}{$chan}{'video'} aud=$scan_href->{'pr'}{$chan}{'audio'}\n" if $DEBUG>=5 ;
1788            
1789 0 0       0 if (!$lcn_href->{'visible'})
1790             {
1791 0         0 push @{$scan_info_href->{'chans'}{$chan}{'comments'}}, "LCN not visible - deleting chan" ;
  0         0  
1792 0         0 ++$delete ;
1793             }
1794             }
1795              
1796             # skip delete if pruning not required
1797 0 0       0 $delete = 0 unless $self->prune_channels ;
1798            
1799             ## See if need to delete
1800 0 0       0 if ($delete)
1801             {
1802             ## Remove this entry
1803 0 0       0 delete $scan_href->{'pr'}{$chan} if (exists($scan_href->{'pr'}{$chan})) ;
1804            
1805 0 0       0 print STDERR " : : REMOVE $chan\n" if $DEBUG>=5 ;
1806             }
1807            
1808             }
1809             }
1810            
1811             }
1812              
1813             ## Fallback to standard checks
1814 0         0 @del = () ;
1815 0         0 foreach my $chan (keys %{$scan_href->{'pr'}})
  0         0  
1816             {
1817             ## check for valid channel
1818 0         0 my $delete = 0 ;
1819              
1820 0         0 my ($service_video, $service_audio) = (0, 0) ;
1821 0 0 0     0 if (
1822             ($scan_href->{'pr'}{$chan}{'type'}==$SERVICE_TYPE{'tv'}) ||
1823             ($scan_href->{'pr'}{$chan}{'type'}==$SERVICE_TYPE{'hd-tv'})
1824             )
1825             {
1826 0         0 ++$service_video ;
1827             }
1828 0 0       0 if (
1829             ($scan_href->{'pr'}{$chan}{'type'}==$SERVICE_TYPE{'radio'})
1830             )
1831             {
1832 0         0 ++$service_audio ;
1833             }
1834 0 0       0 print STDERR " : : $chan : type=$scan_href->{'pr'}{$chan}{'type'} service vid? $service_video, audio? $service_audio\n" if $DEBUG >=5;
1835              
1836 0 0 0     0 if ( $service_video || $service_audio )
1837             {
1838              
1839 0 0       0 print STDERR " : : $chan : vid=$scan_href->{'pr'}{$chan}{'video'} aud=$scan_href->{'pr'}{$chan}{'audio'}\n" if $DEBUG >=5;
1840              
1841             ## check that this type has the required streams
1842 0 0       0 if ($service_video)
1843             {
1844             ## video
1845 0 0 0     0 if (!$scan_href->{'pr'}{$chan}{'video'} || !$scan_href->{'pr'}{$chan}{'audio'})
1846             {
1847 0         0 push @{$scan_info_href->{'chans'}{$chan}{'comments'}}, "no video/audio pids - deleting chan" ;
  0         0  
1848 0         0 ++$delete ;
1849             }
1850             }
1851             else
1852             {
1853             ## audio
1854 0 0       0 if (!$scan_href->{'pr'}{$chan}{'audio'})
1855             {
1856 0         0 push @{$scan_info_href->{'chans'}{$chan}{'comments'}}, "no audio pids - deleting chan" ;
  0         0  
1857 0         0 ++$delete ;
1858             }
1859             }
1860              
1861             }
1862             else
1863             {
1864             # remove none video/radio types
1865 0         0 ++$delete ;
1866 0         0 push @{$scan_info_href->{'chans'}{$chan}{'comments'}}, "non-video/radio - deleting chan" ;
  0         0  
1867             }
1868              
1869             # skip delete if pruning not required
1870 0 0       0 $delete = 0 unless $self->prune_channels ;
1871              
1872 0 0       0 push @del, $chan if $delete;
1873             }
1874              
1875 0         0 foreach my $chan (@del)
1876             {
1877 0 0       0 print STDERR " + del chan \"$chan\"\n" if $DEBUG>=5 ;
1878              
1879 0         0 delete $scan_href->{'pr'}{$chan} ;
1880             }
1881              
1882 0 0       0 prt_data("Scan before tsid fix=", $scan_href) if $DEBUG>=5 ;
1883              
1884              
1885             ## Set transponder params
1886            
1887             # sadly there are lies, damn lies, and broadcast information! You can't rely on the broadcast info and
1888             # have to fall back on either readback from the tuner device for it's settings (if it supports readback),
1889             # using the values specified in the frequency file (i.e. the tuning params), or defaulting params to 'AUTO'
1890             # where the tuner will permit it.
1891            
1892             # this is what we used to set the frontend with
1893 0         0 my $frontend_params_href = $self->frontend_params() ;
1894            
1895             # NOTE: Only really expect there to be at most 1 entry in the 'ts' record. It should be the single TSID at this frequency
1896 0         0 foreach my $tsid (keys %{$scan_href->{'ts'}})
  0         0  
1897             {
1898 0         0 my $freq = $tsids{$tsid}{'frequency'} ;
1899            
1900 0 0       0 if (exists($scan_href->{'freqs'}{$freq}))
    0          
1901             {
1902             # Use readback info for preference
1903 0         0 foreach (keys %{$scan_href->{'freqs'}{$freq}} )
  0         0  
1904             {
1905 0         0 $tsids{$tsid}{$_} = $scan_href->{'freqs'}{$freq}{$_} ;
1906             }
1907            
1908 0         0 push @{$scan_info_href->{'tsid_order'}}, " + Got TSID $tsid at $freq Hz" ;
  0         0  
1909             }
1910             elsif ($freq == $frontend_params_href->{'frequency'})
1911             {
1912             # Use specified settings
1913 0         0 foreach (keys %{$frontend_params_href} )
  0         0  
1914             {
1915 0         0 $tsids{$tsid}{$_} = $frontend_params_href->{$_} ;
1916             }
1917              
1918 0         0 push @{$scan_info_href->{'tsid_order'}}, " + Got TSID $tsid at $freq Hz" ;
  0         0  
1919             }
1920             else
1921             {
1922             # device info
1923 0         0 my $dev_info_href = $self->_device_info ;
1924 0         0 my $capabilities_href = $dev_info_href->{'capabilities'} ;
1925              
1926             # Use AUTO where possible
1927 0         0 foreach my $param (keys %{$frontend_params_href} )
  0         0  
1928             {
1929 0 0       0 next unless exists($FE_CAPABLE{$param}) ;
1930              
1931             ## check to see if we are capable of using auto
1932 0 0       0 if ($capabilities_href->{$FE_CAPABLE{$param}})
1933             {
1934             # can use auto
1935 0         0 $tsids{$tsid}{$param} = $AUTO ;
1936             }
1937             }
1938             }
1939             }
1940            
1941            
1942 0 0       0 printf STDERR "Merge flag=%d\n", $self->merge if $DEBUG>=5 ;
1943 0 0       0 prt_data("FE params=", $frontend_params_href, "Scan before merge=", $scan_href) if $DEBUG>=5 ;
1944 0 0       0 prt_data("before merge - Scan info [$scan_info_href]=", $scan_info_href) if $DEBUG>=5 ;
1945              
1946              
1947             ## Merge results
1948 0 0       0 if ($self->merge)
1949             {
1950 0 0       0 if ($self->_scan_freqs)
1951             {
1952             ## update the old information with the new iff new has better signal
1953 0         0 $scan_href = Linux::DVB::DVBT::Config::merge_scan_freqs($scan_href, $tuning_href, \%scan_merge_options, $VERBOSE, $scan_info_href) ;
1954             }
1955             else
1956             {
1957             ## just update the old information with the new
1958 0         0 $scan_href = Linux::DVB::DVBT::Config::merge($scan_href, $tuning_href, $scan_info_href) ;
1959             }
1960 0 0       0 prt_data("Merged=", $scan_href) if $DEBUG>=5 ;
1961             }
1962            
1963             ## Keep track of frequencies tuned to
1964             # $scan_href->{'freqfile'} = { map { $_->{'frequency'} => $_ } @{$scan_info_href->{'freqs'}} } ;
1965 0         0 $scan_href->{'freqfile'} = {} ;
1966 0         0 foreach my $freq (keys %{$scan_href->{'freqs'}})
  0         0  
1967             {
1968             # only keep frequencies we could tune to
1969 0 0       0 next unless $scan_href->{'freqs'}{$freq}{'tuned'} ;
1970             $scan_href->{'freqfile'}{$freq} = {
1971 0         0 %{$scan_href->{'freqs'}{$freq}},
  0         0  
1972             'frequency' => $freq,
1973             } ;
1974             }
1975              
1976              
1977 0 0       0 prt_data("Scan with freqfile=", $scan_href) if $DEBUG>=5 ;
1978            
1979             # Save results
1980 0         0 $self->tuning($scan_href) ;
1981 0         0 Linux::DVB::DVBT::Config::write($self->config_path, $scan_href) ;
1982              
1983 0 0       0 prt_data("scan() end - Scan info [$scan_info_href]=", $scan_info_href) if $DEBUG>=5 ;
1984 0 0       0 print STDERR "DONE\n" if $DEBUG>=5 ;
1985              
1986 0         0 return $self->tuning() ;
1987             }
1988              
1989             #----------------------------------------------------------------------------
1990              
1991             =item B
1992              
1993             Reads the DVBT frequency file (usually stored in /usr/share/dvb/dvb-t) and uses the contents to
1994             set the frontend to the initial frequency. Then starts a channel scan using that tuning.
1995              
1996             $freq_file must be the full path to the file. The file contents should be something like:
1997              
1998             # Oxford
1999             # T freq bw fec_hi fec_lo mod transmission-mode guard-interval hierarchy
2000             T 578000000 8MHz 2/3 NONE QAM64 2k 1/32 NONE
2001              
2002             NOTE: Frequency files are provided by the 'dvb' rpm package available for most distros
2003              
2004             Returns the discovered channel information as a HASH (see L)
2005              
2006             =cut
2007              
2008             sub scan_from_file
2009             {
2010 0     0 1 0 my $self = shift ;
2011 0         0 my ($freq_file) = @_ ;
2012              
2013             ## Need a file
2014 0 0       0 return $self->handle_error( "Error: No frequency file specified") unless $freq_file ;
2015              
2016             # hardware closed?
2017 0 0       0 if ($self->dvb_closed())
2018             {
2019             # Raise an error
2020 0         0 return $self->handle_error("DVB tuner has been closed") ;
2021             }
2022              
2023 0 0       0 print STDERR "scan_from_file() : Linux::DVB::DVBT version $VERSION\n\n" if $DEBUG ;
2024              
2025 0         0 my @tuning_list ;
2026              
2027             # device info
2028 0         0 my $dev_info_href = $self->_device_info ;
2029 0         0 my $capabilities_href = $dev_info_href->{'capabilities'} ;
2030              
2031 0 0       0 prt_data("Capabilities=", $capabilities_href, "FE Cap=", \%FE_CAPABLE) if $DEBUG>=2 ;
2032              
2033              
2034             # $freqs_href =
2035             # { # HASH(0x844d76c)
2036             # 482000000 =>
2037             # { # HASH(0x8448da4)
2038             # 'seen' => 1,
2039             # 'strength' => 0,
2040             # 'tuned' => 0,
2041             # },
2042             #
2043 0         0 my $freqs_href = {} ;
2044            
2045              
2046             ## parse file
2047 0 0       0 open my $fh, "<$freq_file" or return $self->handle_error( "Error: Unable to read frequency file $freq_file : $!") ;
2048 0         0 my $line ;
2049 0         0 while (defined($line=<$fh>))
2050             {
2051 0         0 chomp $line ;
2052             ## # T freq bw fec_hi fec_lo mod transmission-mode guard-interval hierarchy
2053             ## T 578000000 8MHz 2/3 NONE QAM64 2k 1/32 NONE
2054              
2055 0 0       0 if ($line =~ m%^\s*T\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)%i)
2056             {
2057 0         0 my $freq = dvb_round_freq($1) ;
2058            
2059 0 0       0 if (exists($freqs_href->{$freq}))
2060             {
2061 0         0 print STDERR "Note: frequency $freq Hz already seen, skipping\n" ;
2062 0         0 next ;
2063             }
2064 0         0 $freqs_href->{$freq} = {
2065             'seen' => 0,
2066             'strength' => 0,
2067             'tuned' => 0,
2068             } ;
2069            
2070              
2071             ## setting all params doesn't necessarily work since the freq file is quite often out of date!
2072 0         0 my %params = (
2073             bandwidth => $2,
2074             code_rate_high => $3,
2075             code_rate_low => $4,
2076             modulation => $5,
2077             transmission => $6,
2078             guard_interval => $7,
2079             hierarchy => $8,
2080             inversion => 0,
2081             ) ;
2082            
2083             # convert file entry into a frontend param
2084 0         0 my %tuning_params ;
2085 0         0 foreach my $param (keys %params)
2086             {
2087             ## convert freq file value into VDR format
2088 0 0       0 if (exists($FE_PARAMS{$param}{$params{$param}}))
2089             {
2090 0         0 $tuning_params{$param} = $FE_PARAMS{$param}{$params{$param}} ;
2091             }
2092             }
2093 0         0 $tuning_params{'frequency'} = $freq ;
2094              
2095 0 0       0 prt_data("Tuning params=", \%tuning_params) if $DEBUG>=2 ;
2096              
2097             ## add to tuning list
2098 0         0 push @tuning_list, \%tuning_params ;
2099             }
2100             }
2101 0         0 close $fh ;
2102            
2103             # exit on failure
2104 0 0       0 return $self->handle_error( "Error: No tuning parameters found") unless @tuning_list ;
2105              
2106             ## do scan
2107 0         0 $self->_scan_frequency_list($freqs_href, @tuning_list) ;
2108              
2109             ## return tuning settings
2110 0         0 return $self->tuning() ;
2111             }
2112              
2113              
2114             #----------------------------------------------------------------------------
2115              
2116             =item B
2117              
2118             Given a 2 letter country code (as defined by ISO 3166-1) attempts to scan those
2119             frequencies to produce a scan list.
2120              
2121             Note that this routine relies on the adapter supporting auto settings for most of the parameters. Older
2122             adapters may not work properly.
2123              
2124             Returns the discovered channel information as a HASH (see L)
2125              
2126             =cut
2127              
2128             sub scan_from_country
2129             {
2130 0     0 1 0 my $self = shift ;
2131 0         0 my ($iso3166) = @_ ;
2132              
2133             ## Need a country name
2134 0 0       0 return $self->handle_error( "Error: No valid country code specified") unless Linux::DVB::DVBT::Freq::country_supported($iso3166) ;
2135              
2136             # hardware closed?
2137 0 0       0 if ($self->dvb_closed())
2138             {
2139             # Raise an error
2140 0         0 return $self->handle_error("DVB tuner has been closed") ;
2141             }
2142              
2143 0 0       0 print STDERR "scan_from_country($iso3166) : Linux::DVB::DVBT version $VERSION\n\n" if $DEBUG ;
2144              
2145 0         0 my @tuning_list ;
2146              
2147             # device info
2148 0         0 my $dev_info_href = $self->_device_info ;
2149 0         0 my $capabilities_href = $dev_info_href->{'capabilities'} ;
2150              
2151 0 0       0 prt_data("Capabilities=", $capabilities_href, "FE Cap=", \%FE_CAPABLE) if $DEBUG>=2 ;
2152              
2153              
2154             # $freqs_href =
2155             # { # HASH(0x844d76c)
2156             # 482000000 =>
2157             # { # HASH(0x8448da4)
2158             # 'seen' => 1,
2159             # 'strength' => 0,
2160             # 'tuned' => 0,
2161             # },
2162             #
2163 0         0 my $freqs_href = {} ;
2164            
2165            
2166             ## Get frequencies
2167 0         0 my @frequencies = Linux::DVB::DVBT::Freq::chan_freq_list($iso3166) ;
2168              
2169             ## process list
2170 0         0 foreach my $href (@frequencies)
2171             {
2172 0         0 my $bw = $href->{'bw'} ;
2173 0         0 my $frequency = $href->{'freq'} ;
2174            
2175 0         0 my $freq = dvb_round_freq($frequency) ;
2176            
2177 0 0       0 if (exists($freqs_href->{$freq}))
2178             {
2179 0         0 print STDERR "Note: frequency $freq Hz already seen, skipping\n" ;
2180 0         0 next ;
2181             }
2182 0         0 $freqs_href->{$freq} = {
2183             'seen' => 0,
2184             'strength' => 0,
2185             'tuned' => 0,
2186             } ;
2187            
2188              
2189 0         0 my %tuning_params = (
2190             frequency => $freq,
2191             bandwidth => $bw,
2192             code_rate_high => $AUTO,
2193             code_rate_low => $AUTO,
2194             modulation => $AUTO,
2195             transmission => $AUTO,
2196             guard_interval => $AUTO,
2197             hierarchy => $AUTO,
2198             inversion => $AUTO,
2199             ) ;
2200            
2201 0 0       0 prt_data("Tuning params=", \%tuning_params) if $DEBUG>=2 ;
2202              
2203             ## add to tuning list
2204 0         0 push @tuning_list, \%tuning_params ;
2205              
2206             }
2207            
2208             # exit on failure
2209 0 0       0 return $self->handle_error( "Error: No tuning parameters found") unless @tuning_list ;
2210              
2211             ## do scan
2212 0         0 $self->_scan_frequency_list($freqs_href, @tuning_list) ;
2213            
2214              
2215             ## return tuning settings
2216 0         0 return $self->tuning() ;
2217             }
2218              
2219             #----------------------------------------------------------------------------
2220              
2221             =item B
2222              
2223             Uses the last scan frequencies to re-scan. This assumes that a scan was completed
2224             and saved to the configuration file (see L).
2225              
2226             Note: this will only work for scans completed with version 2.11 (and later) of this module.
2227              
2228             Returns the discovered channel information as a HASH (see L)
2229              
2230             =cut
2231              
2232             sub scan_from_previous
2233             {
2234 0     0 1 0 my $self = shift ;
2235              
2236             ## Check to ensure we really have a list
2237 0         0 my $tuning_href = $self->get_tuning_info() ;
2238 0 0 0     0 if (!exists($tuning_href->{'freqfile'}) && keys %{$tuning_href->{'freqfile'}})
  0         0  
2239             {
2240 0         0 return $self->handle_error( "Error: No saved frequency list is found in configuration") ;
2241             }
2242              
2243 0 0       0 prt_data("Tuning freqfile=", $tuning_href->{'freqfile'}) if $DEBUG>=2 ;
2244              
2245              
2246             # hardware closed?
2247 0 0       0 if ($self->dvb_closed())
2248             {
2249             # Raise an error
2250 0         0 return $self->handle_error("DVB tuner has been closed") ;
2251             }
2252              
2253 0 0       0 print STDERR "scan_from_previous() : Linux::DVB::DVBT version $VERSION\n\n" if $DEBUG ;
2254              
2255 0         0 my @tuning_list ;
2256              
2257             # device info
2258 0         0 my $dev_info_href = $self->_device_info ;
2259 0         0 my $capabilities_href = $dev_info_href->{'capabilities'} ;
2260              
2261 0 0       0 prt_data("Capabilities=", $capabilities_href, "FE Cap=", \%FE_CAPABLE) if $DEBUG>=2 ;
2262              
2263              
2264             # $freqs_href =
2265             # { # HASH(0x844d76c)
2266             # 482000000 =>
2267             # { # HASH(0x8448da4)
2268             # 'seen' => 1,
2269             # 'strength' => 0,
2270             # 'tuned' => 0,
2271             # },
2272             #
2273 0         0 my $freqs_href = {} ;
2274            
2275             ## Get frequencies
2276 0         0 foreach my $frequency (keys %{$tuning_href->{'freqfile'}} )
  0         0  
2277             {
2278 0         0 my $freq = dvb_round_freq($frequency) ;
2279            
2280 0 0       0 if (exists($freqs_href->{$freq}))
2281             {
2282 0         0 print STDERR "Note: frequency $freq Hz already seen, skipping\n" ;
2283 0         0 next ;
2284             }
2285 0         0 $freqs_href->{$freq} = {
2286             'seen' => 0,
2287             'strength' => 0,
2288             'tuned' => 0,
2289             } ;
2290            
2291             my %tuning_params = (
2292 0         0 %{$tuning_href->{'freqfile'}{$frequency}},
  0         0  
2293             'frequency' => $freq,
2294             ) ;
2295            
2296 0 0       0 prt_data("Tuning params=", \%tuning_params) if $DEBUG>=2 ;
2297              
2298             ## add to tuning list
2299 0         0 push @tuning_list, \%tuning_params ;
2300              
2301             }
2302            
2303             # exit on failure
2304 0 0       0 return $self->handle_error( "Error: No tuning parameters found") unless @tuning_list ;
2305              
2306             ## do scan
2307 0         0 $self->_scan_frequency_list($freqs_href, @tuning_list) ;
2308            
2309              
2310             ## return tuning settings
2311 0         0 return $self->tuning() ;
2312             }
2313              
2314              
2315              
2316             #----------------------------------------------------------------------------
2317             sub _scan_frequency_list
2318             {
2319 0     0   0 my $self = shift ;
2320 0         0 my ($freqs_href, @tuning_list) = @_ ;
2321              
2322             # device info
2323 0         0 my $dev_info_href = $self->_device_info ;
2324 0         0 my $capabilities_href = $dev_info_href->{'capabilities'} ;
2325              
2326             # callback
2327 0         0 my %callback_info = (
2328             'tuning_list' => \@tuning_list,
2329             'estimated_percent' => 0,
2330             'total_freqs' => scalar(@tuning_list),
2331             'current_freq' => 0,
2332             'done_freqs' => 0,
2333             'scan_info' => {},
2334             ) ;
2335 0 0       0 if ($self->scan_cb_start)
2336             {
2337 0         0 my $cb = $self->scan_cb_start() ;
2338 0         0 &$cb(\%callback_info) ;
2339             }
2340              
2341             ## prep for scan
2342 0         0 dvb_scan_new($self->{dvb}, $VERBOSE) ;
2343            
2344             ## Info
2345 0         0 my $scan_info_href = $self->_scan_info() ;
2346 0         0 $scan_info_href->{'file_freqs'} = [ @tuning_list ] ; # save original tuning list
2347 0         0 $scan_info_href->{'freqs'} = [ ] ; # list of frequencies seen
2348 0         0 $scan_info_href->{'chans'} = { } ; # channel info
2349 0   0     0 $scan_info_href->{'tsid_order'} ||= [] ; # tsid info
2350              
2351             ## tune into each frequency & perform the scan
2352 0         0 my %freq_list ;
2353 0         0 my $saved_merge = $self->merge ;
2354 0         0 while (@tuning_list)
2355             {
2356 0         0 my $tuned = 0 ;
2357              
2358 0 0       0 print STDERR "Loop start: ".scalar(@tuning_list)." freqs\n" if $DEBUG>=2 ;
2359              
2360             # update frequencies
2361 0         0 @tuning_list = sort {$a->{'frequency'} <=> $b->{'frequency'}} @tuning_list ;
  0         0  
2362 0         0 foreach my $href (@tuning_list)
2363             {
2364 0         0 my $freq_round = dvb_round_freq($href->{'frequency'}) ;
2365 0 0       0 $freq_list{$freq_round} = 0 if !exists($freq_list{$freq_round}) ;
2366             }
2367 0 0       0 prt_data("Loop start freq list=", \%freq_list) if $DEBUG>=3 ;
2368              
2369             # callback
2370 0 0       0 if ($self->scan_cb_loop_start)
2371             {
2372 0         0 my $total_freqs = scalar(keys %freq_list) ;
2373 0         0 my $done_freqs = 0 ;
2374 0         0 foreach my $f (keys %freq_list)
2375             {
2376 0 0       0 ++$done_freqs if $freq_list{$f} ;
2377             }
2378 0         0 $callback_info{'estimated_percent'} = int( $done_freqs * 100.0 / $total_freqs + 0.5)+1 ;
2379 0 0       0 $callback_info{'estimated_percent'} = 97 if $callback_info{'estimated_percent'}>97 ;
2380 0         0 $callback_info{'total_freqs'} = $total_freqs ;
2381 0         0 $callback_info{'done_freqs'} = $done_freqs ;
2382 0         0 $callback_info{'scan_info'} = $self->tuning() ;
2383 0         0 $callback_info{'tuning_list'} = \@tuning_list ;
2384            
2385 0         0 my $cb = $self->scan_cb_loop_start() ;
2386 0         0 &$cb(\%callback_info) ;
2387             }
2388              
2389              
2390              
2391             ## keep trying to tune while we've got something to try
2392 0         0 my $frequency = 0 ;
2393 0   0     0 while (!$tuned && @tuning_list)
2394             {
2395 0         0 my $rc = -1 ;
2396 0         0 my %tuning_params ;
2397 0         0 my $tuning_params_href = shift @tuning_list ;
2398 0         0 $frequency = dvb_round_freq($tuning_params_href->{'frequency'}) ;
2399 0         0 $freq_list{$frequency} = 1 ;
2400            
2401             # make sure frequency is valid
2402 0 0       0 if ($frequency >= $MIN_FREQ)
2403             {
2404             # convert file entry into a frontend param
2405 0         0 foreach my $param (keys %$tuning_params_href)
2406             {
2407 0 0       0 next unless exists($FE_CAPABLE{$param}) ;
2408 0 0       0 print STDERR " +check param $param\n" if $DEBUG>=2 ;
2409            
2410             ## check to see if we are capable of using auto
2411 0 0       0 unless ($capabilities_href->{$FE_CAPABLE{$param}})
2412             {
2413             # can't use auto so we have to set it
2414 0         0 $tuning_params{$param} = $tuning_params_href->{$param} ;
2415             }
2416             }
2417 0         0 $tuning_params{'frequency'} = $frequency ;
2418 0         0 $tuning_params{'timeout'} = $self->timeout() ;
2419            
2420             # set tuning
2421 0 0       0 print STDERR "Setting frequency: $frequency Hz\n" if $self->verbose ;
2422 0         0 $rc = dvb_scan_tune($self->{dvb}, {%tuning_params}) ;
2423             }
2424            
2425             ## If tuning went ok, then save params
2426 0 0       0 if ($rc == 0)
2427             {
2428 0         0 $self->frontend_params( {%tuning_params} ) ;
2429 0         0 $tuned = 1 ;
2430 0         0 $freq_list{$frequency} = 2 ;
2431              
2432 0         0 push @{$scan_info_href->{'freqs'}}, $tuning_params_href ;
  0         0  
2433 0         0 push @{$scan_info_href->{'tsid_order'}}, "Set freq to $frequency Hz" ;
  0         0  
2434             }
2435             else
2436             {
2437 0   0     0 my $freq = $frequency || "0" ;
2438 0         0 print STDERR " Failed to set the DVB-T tuner to $freq Hz ... skipping\n" ;
2439              
2440             # try next frequency
2441 0 0       0 last unless @tuning_list ;
2442             }
2443              
2444 0 0       0 print STDERR "Attempt tune: ".scalar(@tuning_list)." freqs\n" if $DEBUG>=2 ;
2445              
2446             } # while !$tuned
2447            
2448 0 0       0 last if !$tuned ;
2449              
2450              
2451             # callback
2452 0 0       0 if ($self->scan_cb_loop_start)
2453             {
2454 0         0 my $total_freqs = scalar(keys %freq_list) ;
2455 0         0 my $done_freqs = 0 ;
2456 0         0 foreach my $f (keys %freq_list)
2457             {
2458 0 0       0 ++$done_freqs if $freq_list{$f} ;
2459             }
2460 0         0 $callback_info{'estimated_percent'}++ ;
2461 0 0       0 $callback_info{'estimated_percent'} = 98 if $callback_info{'estimated_percent'}>98 ;
2462 0         0 $callback_info{'total_freqs'} = $total_freqs ;
2463 0         0 $callback_info{'done_freqs'} = $done_freqs ;
2464 0         0 $callback_info{'scan_info'} = $self->tuning() ;
2465 0         0 $callback_info{'current_freq'} = $frequency ;
2466            
2467 0         0 my $cb = $self->scan_cb_loop_start() ;
2468 0         0 &$cb(\%callback_info) ;
2469             }
2470              
2471              
2472 0 0       0 print STDERR "Scan merge : ", $self->merge(),"\n" if $DEBUG>=2 ;
2473            
2474             # Scan
2475 0         0 $self->_scan_freqs(1) ;
2476 0         0 $self->scan() ;
2477 0         0 $self->_scan_freqs(0) ;
2478            
2479             # ensure next results are merged in
2480 0         0 $self->merge(1) ;
2481            
2482             # update frequency list
2483 0         0 my $tuning_href = $self->tuning ;
2484 0 0       0 $freqs_href = $tuning_href->{'freqs'} if exists($tuning_href->{'freqs'}) ;
2485              
2486 0 0       0 prt_data("Loop end freqs=", $freqs_href) if $DEBUG>=3 ;
2487            
2488             # update frequencies
2489 0         0 foreach my $freq (sort {$a <=> $b} keys %$freqs_href)
  0         0  
2490             {
2491 0 0       0 next if $freqs_href->{$freq}{'seen'} ;
2492            
2493 0         0 my $freq_round = dvb_round_freq($freq) ;
2494 0 0       0 if (!exists($freq_list{$freq_round}) )
2495             {
2496             push @tuning_list, {
2497             'frequency' => $freq_round,
2498 0         0 %{$freqs_href->{$freq}},
  0         0  
2499             } ;
2500 0 0       0 print STDERR " + adding freq $freq_round\n" if $DEBUG>=2 ;
2501             }
2502             }
2503              
2504 0 0       0 prt_data("Loop end Tuning list=", \@tuning_list) if $DEBUG>=2 ;
2505              
2506             # callback
2507 0 0       0 if ($self->scan_cb_loop_end)
2508             {
2509 0         0 my $total_freqs = scalar(keys %freq_list) ;
2510 0         0 my $done_freqs = 0 ;
2511 0         0 foreach my $f (keys %freq_list)
2512             {
2513 0 0       0 ++$done_freqs if $freq_list{$f} ;
2514             }
2515 0         0 $callback_info{'estimated_percent'} = int( $done_freqs * 100.0 / $total_freqs + 0.5) ;
2516 0 0       0 $callback_info{'estimated_percent'} = 99 if $callback_info{'estimated_percent'}>99 ;
2517 0         0 $callback_info{'total_freqs'} = $total_freqs ;
2518 0         0 $callback_info{'done_freqs'} = $done_freqs ;
2519 0         0 $callback_info{'scan_info'} = $self->tuning() ;
2520            
2521 0         0 my $cb = $self->scan_cb_loop_end() ;
2522 0         0 &$cb(\%callback_info) ;
2523             }
2524              
2525              
2526 0 0       0 print STDERR "Loop end: ".scalar(@tuning_list)." freqs\n" if $DEBUG>=2 ;
2527              
2528             } # while @tuning_list
2529              
2530             ###############################
2531 0 0       0 if ($DEBUG)
2532             {
2533             # check to ensure each tsid has some programs. If not then we can delete that tsid
2534              
2535 0         0 my %tsids ;
2536 0         0 my $scan_href = $self->tuning() ;
2537 0         0 foreach my $prog (keys %{$scan_href->{'pr'}})
  0         0  
2538             {
2539 0         0 my $prog_href = $scan_href->{'pr'}{$prog} ;
2540 0         0 my $tsid = $prog_href->{'tsid'} ;
2541 0         0 $tsids{$tsid} = 1 ;
2542             }
2543 0         0 foreach my $tsid (keys %{$scan_href->{'ts'}})
  0         0  
2544             {
2545 0 0       0 if (!exists($tsids{$tsid}))
2546             {
2547 0         0 print STDERR " * TSID $tsid has no progs\n" ;
2548             }
2549             }
2550             }
2551             ###############################
2552              
2553              
2554             ## restore flag
2555 0         0 $self->merge($saved_merge) ;
2556              
2557             ## clear ready for next scan
2558 0         0 dvb_scan_new($self->{dvb}, $VERBOSE) ;
2559              
2560 0 0       0 prt_data("## Scan Info ##", $scan_info_href) if $DEBUG>=2 ;
2561              
2562 0 0       0 if ($VERBOSE)
2563             {
2564 0         0 print "\n\n" ;
2565 0         0 print "SCANNING INFORMATION\n" ;
2566 0         0 print "====================\n\n" ;
2567            
2568 0         0 print "Frequency Scan\n" ;
2569 0         0 print "--------------\n" ;
2570 0         0 my $set=0 ;
2571 0         0 foreach my $line (@{$scan_info_href->{'tsid_order'}})
  0         0  
2572             {
2573 0         0 my $this_set=0 ;
2574 0 0       0 if ($line =~ /Set freq/i)
2575             {
2576 0         0 $this_set=1 ;
2577             }
2578 0 0 0     0 if ($set && $this_set)
2579             {
2580 0         0 print " ** No TSIDs **\n" ;
2581             }
2582 0         0 $set = $this_set ;
2583 0 0       0 print "\n" if $this_set ;
2584 0         0 print " $line\n" ;
2585             }
2586 0         0 print "\n" ;
2587              
2588 0         0 print "TSID Info\n";
2589 0         0 print "---------\n";
2590 0         0 foreach my $tsid (sort {int($a) <=> int($b)} keys %{$scan_info_href->{'tsids'}})
  0         0  
  0         0  
2591             {
2592 0         0 print "\n TSID $tsid\n" ;
2593 0         0 foreach my $line (@{$scan_info_href->{'tsids'}{$tsid}{'comments'}})
  0         0  
2594             {
2595 0         0 print " $line\n" ;
2596             }
2597             }
2598 0         0 print "\n";
2599              
2600 0         0 print "Channel Info\n";
2601 0         0 print "------------\n";
2602 0         0 foreach my $chan (sort keys %{$scan_info_href->{'chans'}})
  0         0  
2603             {
2604 0         0 print "\n $chan\n" ;
2605 0         0 foreach my $line (@{$scan_info_href->{'chans'}{$chan}{'comments'}})
  0         0  
2606             {
2607 0         0 print " $line\n" ;
2608             }
2609             }
2610 0         0 print "\n";
2611             }
2612              
2613             # callback
2614 0 0       0 if ($self->scan_cb_end)
2615             {
2616 0         0 $callback_info{'estimated_percent'} = 100 ;
2617 0         0 $callback_info{'total_freqs'} = scalar(keys %freq_list) ;
2618 0         0 $callback_info{'done_freqs'} = scalar(keys %freq_list) ;
2619 0         0 $callback_info{'scan_info'} = $self->tuning() ;
2620 0         0 $callback_info{'current_freq'} = 0 ;
2621              
2622 0         0 my $cb = $self->scan_cb_end() ;
2623 0         0 &$cb(\%callback_info) ;
2624             }
2625              
2626             ## return tuning settings
2627 0         0 return $self->tuning() ;
2628             }
2629              
2630              
2631              
2632              
2633              
2634              
2635             #============================================================================================
2636              
2637             =back
2638              
2639             =head3 TUNING
2640              
2641             =over 4
2642              
2643             =cut
2644              
2645             #============================================================================================
2646              
2647             #----------------------------------------------------------------------------
2648              
2649             =item B
2650              
2651             Returns 0 is the currently selected adapter frontend is not busy; 1 if it is.
2652              
2653             =cut
2654              
2655             sub is_busy
2656             {
2657 0     0 1 0 my $self = shift ;
2658              
2659 0         0 my $is_busy = dvb_is_busy($self->{dvb}) ;
2660            
2661 0         0 return $is_busy ;
2662             }
2663              
2664             #----------------------------------------------------------------------------
2665              
2666             =item B
2667              
2668             Tune the frontend to the specified frequency etc. HASH %params contains:
2669              
2670             'frequency'
2671             'inversion'
2672             'bandwidth'
2673             'code_rate_high'
2674             'code_rate_low'
2675             'modulation'
2676             'transmission'
2677             'guard_interval'
2678             'hierarchy'
2679             'timeout'
2680             'tsid'
2681              
2682             (If you don't know what these parameters should be set to, then I recommend you just use the L method)
2683              
2684             Returns 0 if ok; error code otherwise
2685              
2686             =cut
2687              
2688             sub set_frontend
2689             {
2690 0     0 1 0 my $self = shift ;
2691 0         0 my (%params) = @_ ;
2692              
2693             # hardware closed?
2694 0 0       0 if ($self->dvb_closed())
2695             {
2696             # Raise an error
2697 0         0 return $self->handle_error("DVB tuner has been closed") ;
2698             }
2699              
2700             # Set up the frontend
2701 0         0 my $rc = dvb_tune($self->{dvb}, {%params}) ;
2702            
2703 0 0       0 print STDERR "dvb_tune() returned $rc\n" if $DEBUG ;
2704            
2705             # If tuning went ok, then save params
2706             #
2707             # Currently:
2708             # -11 = Device busy
2709             # -15 / -16 = Failed to tune
2710             #
2711 0 0       0 if ($rc == 0)
2712             {
2713 0         0 $self->frontend_params( {%params} ) ;
2714             }
2715            
2716 0         0 return $rc ;
2717             }
2718              
2719             #----------------------------------------------------------------------------
2720              
2721             =item B
2722              
2723             Selects a particular video/audio stream (and optional subtitle and/or teletext streams) and sets the
2724             demultiplexer to those streams (ready for recording).
2725              
2726             (If you don't know what these parameters should be set to, then I recommend you just use the L method)
2727              
2728             Returns 0 for success; error code otherwise.
2729              
2730             =cut
2731              
2732             sub set_demux
2733             {
2734 0     0 1 0 my $self = shift ;
2735 0         0 my ($video_pid, $audio_pid, $subtitle_pid, $teletext_pid, $tsid, $demux_params_href) = @_ ;
2736              
2737 0 0       0 print STDERR "set_demux( <$video_pid>, <$audio_pid>, <$teletext_pid> )\n" if $DEBUG ;
2738              
2739 0         0 my $error = 0 ;
2740 0 0 0     0 if ($video_pid && !$error)
2741             {
2742 0         0 $error = $self->add_demux_filter($video_pid, "video", $tsid, $demux_params_href) ;
2743             }
2744 0 0 0     0 if ($audio_pid && !$error)
2745             {
2746 0         0 $error = $self->add_demux_filter($audio_pid, "audio", $tsid, $demux_params_href) ;
2747             }
2748 0 0 0     0 if ($teletext_pid && !$error)
2749             {
2750 0         0 $error = $self->add_demux_filter($teletext_pid, "teletext", $tsid, $demux_params_href) ;
2751             }
2752 0 0 0     0 if ($subtitle_pid && !$error)
2753             {
2754 0         0 $error = $self->add_demux_filter($subtitle_pid, "subtitle", $tsid, $demux_params_href) ;
2755             }
2756 0         0 return $error ;
2757             }
2758              
2759             #----------------------------------------------------------------------------
2760              
2761             =item B
2762              
2763             Tune the frontend & the demux based on $channel_name.
2764              
2765             This method uses a "fuzzy" search to match the specified channel name with the name broadcast by the network.
2766             The case of the name is not important, and neither is whitespace. The search also checks for both numeric and
2767             name instances of a number (e.g. "1" and "one").
2768              
2769             For example, the following are all equivalent and match with the broadcast channel name "BBC ONE":
2770              
2771             bbc1
2772             BbC One
2773             b b c 1
2774              
2775             Returns 0 if ok; error code otherwise
2776              
2777             =cut
2778              
2779             sub select_channel
2780             {
2781 0     0 1 0 my $self = shift ;
2782 0         0 my ($channel_name) = @_ ;
2783              
2784             # hardware closed?
2785 0 0       0 if ($self->dvb_closed())
2786             {
2787             # Raise an error
2788 0         0 return $self->handle_error("DVB tuner has been closed") ;
2789             }
2790              
2791             # ensure we have the tuning info
2792 0         0 my $tuning_href = $self->get_tuning_info() ;
2793 0 0       0 if (! $tuning_href)
2794             {
2795 0         0 return $self->handle_error("Unable to get tuning information") ;
2796             }
2797              
2798             # get the channel info
2799 0         0 my ($frontend_params_href, $demux_params_href) = Linux::DVB::DVBT::Config::find_channel($channel_name, $tuning_href) ;
2800 0 0       0 if (! $frontend_params_href)
2801             {
2802 0         0 return $self->handle_error("Unable to find channel $channel_name") ;
2803             }
2804              
2805             # Tune frontend
2806 0 0       0 if ($self->set_frontend(%$frontend_params_href, 'timeout' => $self->timeout))
2807             {
2808 0         0 return $self->handle_error("Unable to tune frontend") ;
2809             }
2810              
2811             ## start with clean slate
2812 0         0 $self->multiplex_close() ;
2813              
2814             # Set demux (no teletext or subtitle)
2815 0 0       0 if ($self->set_demux(
2816             $demux_params_href->{'video'},
2817             $demux_params_href->{'audio'},
2818             0,
2819             0,
2820             $frontend_params_href->{'tsid'},
2821             $demux_params_href)
2822             )
2823             {
2824 0         0 return $self->handle_error("Unable to set demux") ;
2825             }
2826              
2827 0         0 return 0 ;
2828             }
2829            
2830             #----------------------------------------------------------------------------
2831              
2832             =item B
2833              
2834             Check to see if 'tuning' information has been set. If not, attempts to read from the config
2835             search path.
2836              
2837             Returns a HASH ref of tuning information - i.e. it contains the complete information on all
2838             transponders (under the 'ts' field), and all programs (under the 'pr' field). [see L method for format].
2839              
2840             Otherwise returns undef if no information is available.
2841              
2842             =cut
2843              
2844             sub get_tuning_info
2845             {
2846 5     5 1 19 my $self = shift ;
2847              
2848             # Get any existing info
2849 5         30 my $tuning_href = $self->tuning() ;
2850            
2851             # If not found, try reading
2852 5 50       22 if (!$tuning_href)
2853             {
2854 5         16 $tuning_href = Linux::DVB::DVBT::Config::read($self->config_path) ;
2855            
2856 5 50       14 prt_data("get_tuning_info()", $tuning_href) if $DEBUG >= 20 ;
2857            
2858             # save if got something
2859 5 50       40 $self->tuning($tuning_href) if $tuning_href ;
2860             }
2861              
2862 5         14 return $tuning_href ;
2863             }
2864              
2865             #----------------------------------------------------------------------------
2866              
2867             =item B
2868              
2869             Checks to see if 'channel_list' information has been set. If not, attempts to create a list based
2870             on the scan information.
2871              
2872             NOTE that the created list will be the best attempt at ordering the channels based on the TSID & PNR
2873             which won't be pretty, but it'll be better than nothing!
2874              
2875             Returns an ARRAY ref of channel_list information; otherwise returns undef. The array is sorted by logical channel number
2876             and contains HASHes of the form:
2877              
2878             {
2879             'channel' => channel name (e.g. "BBC THREE")
2880             'channel_num' => the logical channel number (e.g. 7)
2881             'type' => radio or tv channel ('radio', 'tv' or 'hd-tv')
2882             }
2883              
2884             =cut
2885              
2886             sub get_channel_list
2887             {
2888 0     0 1 0 my $self = shift ;
2889              
2890             # Get any existing info
2891 0         0 my $channels_aref = $self->channel_list() ;
2892            
2893             # If not found, try creating
2894 0 0       0 if (!$channels_aref)
2895             {
2896             #print STDERR "create chan list\n" ;
2897              
2898             # Get any existing info
2899 0         0 my $tuning_href = $self->get_tuning_info() ;
2900             #prt_data("Tuning Info=",$tuning_href) ;
2901            
2902             # Use the scanning info to create an ordered list
2903 0 0       0 if ($tuning_href)
2904             {
2905 0         0 $channels_aref = [] ;
2906 0         0 $self->channel_list($channels_aref) ;
2907              
2908 0         0 my %tsid_pnr ;
2909 0         0 foreach my $channel_name (keys %{$tuning_href->{'pr'}})
  0         0  
2910             {
2911 0         0 my $tsid = $tuning_href->{'pr'}{$channel_name}{'tsid'} ;
2912 0         0 my $pnr = $tuning_href->{'pr'}{$channel_name}{'pnr'} ;
2913 0         0 $tsid_pnr{$channel_name} = "$tsid-$pnr" ;
2914             }
2915            
2916 0         0 my $channel_num=1 ;
2917 0         0 foreach my $channel_name (sort
2918             {
2919 0   0     0 my $lcn_a = $tuning_href->{'pr'}{$a}{'lcn'}||0 ;
2920 0   0     0 my $lcn_b = $tuning_href->{'pr'}{$b}{'lcn'}||0 ;
2921 0 0 0     0 if (!$lcn_a || !$lcn_b)
2922             {
2923             $tuning_href->{'pr'}{$a}{'tsid'} <=> $tuning_href->{'pr'}{$b}{'tsid'}
2924             ||
2925 0 0       0 $tuning_href->{'pr'}{$a}{'pnr'} <=> $tuning_href->{'pr'}{$b}{'pnr'} ;
2926             }
2927             else
2928             {
2929 0         0 $lcn_a <=> $lcn_b ;
2930             }
2931            
2932             }
2933 0         0 keys %{$tuning_href->{'pr'}})
2934             {
2935 0   0     0 my $type = $tuning_href->{'pr'}{$channel_name}{'type'} || $SERVICE_TYPE{'tv'} ;
2936 0         0 my $type_str = 'special' ;
2937 0 0       0 Linux::DVB::DVBT::prt_data("type=$type, NAMES=", \%SERVICE_NAME) if $DEBUG>=10 ;
2938 0 0       0 if (exists($SERVICE_NAME{$type}))
2939             {
2940 0         0 $type_str = $SERVICE_NAME{$type} ;
2941             }
2942            
2943             push @$channels_aref, {
2944             'channel' => $channel_name,
2945 0   0     0 'channel_num' => $tuning_href->{'pr'}{$channel_name}{'lcn'} || $channel_num,
2946             'type' => $type_str,
2947             'type_code' => $type,
2948             } ;
2949            
2950 0         0 ++$channel_num ;
2951             }
2952             }
2953              
2954             #prt_data("TSID-PNR=",\%tsid_pnr) ;
2955             }
2956              
2957 0         0 return $channels_aref ;
2958             }
2959              
2960             #----------------------------------------------------------------------------
2961              
2962             =item B
2963              
2964             Measures the signal quality of the currently tuned transponder. Returns a HASH ref containing:
2965              
2966             {
2967             'ber' => Bit error rate (32 bits)
2968             'snr' => Signal to noise ratio (maximum is 0xffff)
2969             'strength' => Signal strength (maximum is 0xffff)
2970             'uncorrected_blocks' => Number of uncorrected blocks (32 bits)
2971             'ok' => flag set if no errors occured during the measurements
2972             }
2973              
2974             Note that some tuner hardware may not support some (or any) of the above measurements.
2975              
2976             =cut
2977              
2978             sub signal_quality
2979             {
2980 0     0 1 0 my $self = shift ;
2981            
2982              
2983             # hardware closed?
2984 0 0       0 if ($self->dvb_closed())
2985             {
2986             # Raise an error
2987 0         0 return $self->handle_error("DVB tuner has been closed") ;
2988             }
2989              
2990             # if not tuned yet, tune to all station freqs (assumes scan has been performed)
2991 0 0       0 if (!$self->frontend_params())
2992             {
2993 0         0 return $self->handle_error("Frontend not tuned") ;
2994             }
2995              
2996             # get signal info
2997 0         0 my $signal_href = dvb_signal_quality($self->{dvb}) ;
2998            
2999 0         0 return $signal_href ;
3000             }
3001              
3002             #----------------------------------------------------------------------------
3003              
3004             =item B
3005              
3006             Measures the signal quality of the specified transponder. Returns a HASH containing:
3007              
3008             {
3009             $tsid => {
3010             'ber' => Bit error rate (32 bits)
3011             'snr' => Signal to noise ratio (maximum is 0xffff)
3012             'strength' => Signal strength (maximum is 0xffff)
3013             'uncorrected_blocks' => Number of uncorrected blocks (32 bits)
3014             'ok' => flag set if no errors occured during the measurements
3015             'error' => Set to an error string on error; otherwise undef
3016             }
3017             }
3018              
3019             If no TSID is specified, then scans all transponders and returns the complete HASH.
3020              
3021             Note that some tuner hardware may not support some (or any) of the above measurements.
3022              
3023             =cut
3024              
3025             sub tsid_signal_quality
3026             {
3027 0     0 1 0 my $self = shift ;
3028 0         0 my ($tsid) = @_ ;
3029            
3030              
3031             # hardware closed?
3032 0 0       0 if ($self->dvb_closed())
3033             {
3034             # Raise an error
3035 0         0 return $self->handle_error("DVB tuner has been closed") ;
3036             }
3037              
3038             # ensure we have the tuning info
3039 0         0 my $tuning_href = $self->get_tuning_info() ;
3040 0 0       0 if (! $tuning_href)
3041             {
3042 0         0 return $self->handle_error("Unable to get tuning information") ;
3043             }
3044              
3045             # check/create list of TSIDs
3046 0         0 my @tsids ;
3047 0 0       0 if ($tsid)
3048             {
3049             # check it
3050 0 0       0 if (!exists($tuning_href->{'ts'}{$tsid}))
3051             {
3052             # Raise an error
3053 0         0 return $self->handle_error("Unknown TSID $tsid") ;
3054             }
3055            
3056 0         0 push @tsids, $tsid ;
3057             }
3058             else
3059             {
3060             # create
3061 0         0 @tsids = keys %{$tuning_href->{'ts'}} ;
  0         0  
3062             }
3063            
3064             ## handle errors
3065 0         0 my $errmode = $self->{errmode} ;
3066 0         0 $self->{errmode} = 'message' ;
3067            
3068             ## get info
3069 0         0 my %info ;
3070 0         0 foreach my $tsid (@tsids)
3071             {
3072             ## Tune frontend
3073 0         0 my $frontend_params_href = $tuning_href->{'ts'}{$tsid} ;
3074 0         0 my $error_code ;
3075 0 0       0 if ($error_code = $self->set_frontend(%$frontend_params_href, 'timeout' => $self->timeout))
3076             {
3077 0 0       0 print STDERR "set_frontend() returned $error_code\n" if $DEBUG ;
3078            
3079 0         0 $info{$tsid}{'error'} = "Unable to tune frontend. " . dvb_error_str() ;
3080 0 0       0 if ($info{$tsid}{'error'} =~ /busy/i)
3081             {
3082             ## stop now since the device is in use
3083 0         0 last ;
3084             }
3085             }
3086             else
3087             {
3088             ## get info
3089 0         0 $info{$tsid} = $self->signal_quality($tsid) ;
3090 0         0 $info{$tsid}{'error'} = undef ;
3091             }
3092             }
3093            
3094             ## restore error handling
3095 0         0 $self->{errmode} = $errmode ;
3096            
3097            
3098             ## return info
3099 0         0 return %info ;
3100             }
3101              
3102              
3103              
3104             #============================================================================================
3105              
3106             =back
3107              
3108             =head3 RECORDING
3109              
3110             =over 4
3111              
3112             =cut
3113              
3114             #============================================================================================
3115              
3116             #----------------------------------------------------------------------------
3117              
3118             =item B
3119              
3120             (New version that uses the underlying multiplex recording methods).
3121              
3122             Streams the selected channel information (see L) into the file $file for $duration.
3123              
3124             The duration may be specified either as an integer number of minutes, or in HH:MM format (for hours & minutes), or in
3125             HH:MM:SS format (for hours, minutes, seconds).
3126              
3127             Note that (if possible) the method creates the directory path to the file if it doersn't already exist.
3128              
3129             =cut
3130              
3131             sub record
3132             {
3133 0     0 1 0 my $self = shift ;
3134 0         0 my ($file, $duration) = @_ ;
3135              
3136 0 0       0 print STDERR "record($file, $duration)" if $DEBUG ;
3137              
3138             ## need filename
3139 0 0       0 return $self->handle_error("No valid filename specified") unless ($file) ;
3140              
3141             ## need valid duration
3142 0         0 my $seconds = Linux::DVB::DVBT::Utils::time2secs($duration) ;
3143 0 0       0 return $self->handle_error("No valid duration specified") unless ($seconds) ;
3144              
3145             ## Set up the multiplex info for this single file
3146              
3147             # create entry for this file
3148 0         0 my $href = $self->_multiplex_file_href($file) ;
3149            
3150             # set time
3151 0         0 $href->{'duration'} = $seconds ;
3152            
3153             # set total length
3154 0         0 $self->{_multiplex_info}{'duration'} = $seconds ;
3155            
3156             # set demux filter info
3157 0         0 push @{$href->{'demux'}}, @{$self->{_demux_filters}};
  0         0  
  0         0  
3158              
3159             # get tsid
3160 0         0 my $frontend_href = $self->frontend_params() ;
3161 0         0 my $tsid = $frontend_href->{'tsid'} ;
3162            
3163             ## Add in SI tables (if required) to the multiplex info
3164 0         0 my $error = $self->_add_required_si($tsid) ;
3165 0 0       0 $self->handle_error($error) if ($error) ;
3166            
3167             ## ensure pid lists match the demux list
3168 0         0 $self->_update_multiplex_info($tsid) ;
3169              
3170              
3171             ## Now record
3172 0 0       0 Linux::DVB::DVBT::prt_data("multiplex_info=", $self->{'_multiplex_info'}) if $DEBUG>=10 ;
3173              
3174 0         0 my $rc = $self->multiplex_record(%{$self->{'_multiplex_info'}}) ;
  0         0  
3175              
3176             ## Clear multiplex info ready for next time
3177 0         0 $self->multiplex_close() ;
3178              
3179 0         0 return $rc ;
3180             }
3181              
3182             #----------------------------------------------------------------------------
3183              
3184             =item B
3185              
3186             Old version 1.xxx style recording. Kept in case newer version does something that you weren't
3187             expecting. Note that this version will be phased out and removed in future releases.
3188              
3189             Streams the selected channel information (see L) into the file $file for $duration.
3190              
3191             The duration may be specified either as an integer number of minutes, or in HH:MM format (for hours & minutes), or in
3192             HH:MM:SS format (for hours, minutes, seconds).
3193              
3194             Note that (if possible) the method creates the directory path to the file if it doersn't already exist.
3195              
3196             =cut
3197              
3198             sub record_v1
3199             {
3200 0     0 1 0 my $self = shift ;
3201 0         0 my ($file, $duration) = @_ ;
3202              
3203             ## need filename
3204 0 0       0 return $self->handle_error("No valid filename specified") unless ($file) ;
3205              
3206             ## need valid duration
3207 0         0 my $seconds = Linux::DVB::DVBT::Utils::time2secs($duration) ;
3208 0 0       0 return $self->handle_error("No valid duration specified") unless ($seconds) ;
3209              
3210             # hardware closed?
3211 0 0       0 if ($self->dvb_closed())
3212             {
3213             # Raise an error
3214 0         0 return $self->handle_error("DVB tuner has been closed") ;
3215             }
3216              
3217             ## ensure directory is present
3218 0         0 my $dir = dirname($file) ;
3219 0 0       0 if (! -d $dir)
3220             {
3221             # create dir
3222 0 0       0 mkpath([$dir], $DEBUG, 0755) or return $self->handle_error("Unable to create record directory $dir : $!") ;
3223             }
3224            
3225 0 0       0 print STDERR "Recording to $file for $duration ($seconds secs)\n" if $DEBUG ;
3226              
3227             # save raw transport stream to file
3228 0         0 my $rc = dvb_record($self->{dvb}, $file, $seconds) ;
3229 0 0       0 return $self->handle_error("Error during recording : $rc") if ($rc) ;
3230            
3231 0         0 return 0 ;
3232             }
3233              
3234              
3235              
3236             #============================================================================================
3237              
3238             =back
3239              
3240             =head3 EPG
3241              
3242             =over 4
3243              
3244             =cut
3245              
3246             #============================================================================================
3247              
3248              
3249             #----------------------------------------------------------------------------
3250              
3251             =item B
3252              
3253             Gathers the EPG information into a HASH using the previously tuned frontend and
3254             returns the EPG info. If the frontend is not yet tuned then the method attempts
3255             to use the tuning information (either from a previous scan or from reading the config
3256             files) to set up the frontend.
3257              
3258             Note that you can safely run this method while recording; the EPG scan does not affect
3259             the demux or the frontend (once it has been set)
3260              
3261             Returns an array:
3262              
3263             [0] = EPG HASH
3264             [1] = Dates HASH
3265              
3266             EPG HASH format is:
3267              
3268             $channel_name =>
3269             $pid => {
3270             'pid' => program unique id (= $pid)
3271             'channel' => channel name
3272            
3273             'date' => date
3274             'start' => start time
3275             'end' => end time
3276             'duration' => duration
3277            
3278             'title' => title string (program/series/film title)
3279             'subtitle' => Usually the epsiode name
3280             'text' => synopsis string
3281             'etext' => extra text (not usually used)
3282             'genre' => genre string
3283            
3284             'episode' => episode number
3285             'num_episodes' => number of episodes
3286              
3287             'subtitle' => this is a short program name (useful for saving as a filename)
3288            
3289             'tva_prog' => TV Anytime program id
3290             'tva_series' => TV Anytime series id
3291            
3292             'flags' => HASH ref to flags (see below)
3293             }
3294              
3295             i.e. The information is keyed on channel name and program id (pid)
3296              
3297             The genre string is formatted as:
3298              
3299             "Major category|genre/genre..."
3300              
3301             For example:
3302              
3303             "Film|movie/drama (general)"
3304              
3305             This allows for a simple regexp to extract the information (e.g. in a TV listings application
3306             you may want to only use the major category in the main view, then show the extra genre information in
3307             a more detailed view).
3308              
3309             Note that the genre information is mostly correct (for films) but is not reliable. Most programs are tagged as 'show'
3310             (even some films!).
3311              
3312             The flags HASH format is:
3313              
3314             # audio information
3315             'mono' => flag set if program is in mono
3316             'stereo' => flag set if program is in stereo
3317             'dual-mono' => flag set if program is in 2 channel mono
3318             'multi' => flag set if program is in multi-lingual, multi-channel audio
3319             'surround' => flag set if program is in surround sound
3320             'he-aac' => flag set if component descriptor indicates audio is in HE-ACC format
3321            
3322             # video information
3323             '4:3' => flag set if program is in 4:3
3324             '16:9' => flag set if program is in 16:9
3325             'hdtv' => flag set if program is in high definition
3326             'h264' => flag set if component descriptor indicates video is in .H264 format
3327            
3328             'subtitles' => flag set if subtitles (for the hard of hearing) are available for this program
3329            
3330             'new' => flag set if description mentions that this is a new program/series
3331              
3332             Note that (especially for DVB-T2 HD-TV channels) not all of the flags that should be set *are* set! It depends on the broadcaster.
3333              
3334             Dates HASH format is:
3335              
3336             $channel_name => {
3337             'start_date' => date of first program for this channel
3338             'start' => start time of first program for this channel
3339            
3340             'end_date' => date of last program for this channel
3341             'end' => end time of last program for this channel
3342             }
3343              
3344             i.e. The information is keyed on channel name
3345              
3346             The dates HASH is created so that an existing EPG database can be updated by removing existing information for a channel between the indicated dates.
3347              
3348             =cut
3349              
3350              
3351             sub epg
3352             {
3353 0     0 1 0 my $self = shift ;
3354 0         0 my ($section) = @_ ; # debug only!
3355            
3356 0   0     0 $section ||= 0 ;
3357              
3358             # hardware closed?
3359 0 0       0 if ($self->dvb_closed())
3360             {
3361             # Raise an error
3362 0         0 return $self->handle_error("DVB tuner has been closed") ;
3363             }
3364              
3365 0         0 my %epg ;
3366             my %dates ;
3367              
3368             # Get tuning information
3369 0         0 my $tuning_href = $self->get_tuning_info() ;
3370 0 0       0 prt_data("tuning hash=", $tuning_href) if $DEBUG >= 2 ;
3371              
3372             # Create a lookup table to convert [tsid-pnr] values into channel names & channel numbers
3373 0         0 my $channel_lookup_href ;
3374 0         0 my $channels_aref = $self->get_channel_list() ;
3375 0 0 0     0 if ( $channels_aref && $tuning_href )
3376             {
3377             #print STDERR "creating chan lookup\n" ;
3378             #prt_data("Channels=", $channels_aref) ;
3379             #prt_data("Tuning=", $tuning_href) ;
3380 0         0 $channel_lookup_href = {} ;
3381 0         0 foreach my $chan_href (@$channels_aref)
3382             {
3383 0         0 my $channel = $chan_href->{'channel'} ;
3384              
3385             #print STDERR "CHAN: $channel\n" ;
3386 0 0       0 if (exists($tuning_href->{'pr'}{$channel}))
3387             {
3388             #print STDERR "created CHAN: $channel for $tuning_href->{pr}{$channel}{tsid} - for $tuning_href->{pr}{$channel}{pnr}\n" ;
3389             # create the lookup
3390             $channel_lookup_href->{"$tuning_href->{'pr'}{$channel}{tsid}-$tuning_href->{'pr'}{$channel}{pnr}"} = {
3391             'channel' => $channel,
3392 0   0     0 'channel_num' => $tuning_href->{'pr'}{$channel}{'lcn'} || $chan_href->{'channel_num'},
3393             } ;
3394             }
3395             }
3396             }
3397 0 0       0 prt_data("Lookup=", $channel_lookup_href) if $DEBUG >= 2 ;
3398              
3399              
3400             ## check for frontend tuned
3401            
3402             # list of carrier frequencies to tune to
3403 0         0 my @next_freq ;
3404            
3405             # if not tuned yet, tune to all station freqs (assumes scan has been performed)
3406 0 0       0 if (!$self->frontend_params())
3407             {
3408             # Grab first channel settings & attempt to set frontend
3409 0 0       0 if ($tuning_href)
3410             {
3411 0         0 @next_freq = values %{$tuning_href->{'ts'}} ;
  0         0  
3412            
3413 0 0       0 if ($DEBUG)
3414             {
3415 0         0 print STDERR "FREQ LIST:\n" ;
3416 0         0 foreach (@next_freq)
3417             {
3418 0         0 print STDERR " $_->{frequency} Hz\n" ;
3419             }
3420             }
3421            
3422 0         0 my $params_href = shift @next_freq ;
3423 0 0       0 prt_data("Set frontend : params=", $params_href) if $DEBUG >= 2 ;
3424 0         0 my $rc = $self->set_frontend(%$params_href, 'timeout' => $self->timeout) ;
3425 0 0       0 return $self->handle_error("Unable to tune frontend. Is aerial connected?)") if ($rc != 0) ;
3426             }
3427             }
3428              
3429             # start with a cleared list
3430 0         0 dvb_clear_epg() ;
3431            
3432             # collect all the EPG data from all carriers
3433 0         0 my $params_href ;
3434             my $epg_data ;
3435             do
3436 0         0 {
3437             # if not tuned by now then we have to raise an error
3438 0 0       0 if (!$self->frontend_params())
3439             {
3440             # Raise an error
3441 0         0 return $self->handle_error("Frontend must be tuned before gathering EPG data (have you run scan() yet?)") ;
3442             }
3443            
3444             # Gather EPG information into a list of HASH refs (collects all previous runs)
3445 0         0 $epg_data = dvb_epg($self->{dvb}, $VERBOSE, $DEBUG, $section) ;
3446              
3447             # tune to next carrier in the list (if any are left)
3448 0         0 $params_href = undef ;
3449 0 0       0 if (@next_freq)
3450             {
3451 0         0 $params_href = shift @next_freq ;
3452 0 0       0 prt_data("Retune params=", $params_href) if $DEBUG >= 2 ;
3453 0         0 $self->set_frontend(%$params_href, 'timeout' => $self->timeout) ;
3454             }
3455             }
3456             while ($params_href) ;
3457              
3458 0 0       0 printf("Found %d EPG entries\n", scalar(@$epg_data)) if $VERBOSE ;
3459              
3460 0 0       0 prt_data("EPG data=", $epg_data) if $DEBUG>=2 ;
3461              
3462             ## get epg statistics
3463 0         0 my $epg_stats = dvb_epg_stats($self->{dvb}) ;
3464              
3465              
3466             # ok to clear down the low-level list now
3467 0         0 dvb_clear_epg() ;
3468            
3469             # Analyse EPG info
3470 0         0 foreach my $epg_entry (@$epg_data)
3471             {
3472 0         0 my $tsid = $epg_entry->{'tsid'} ;
3473 0         0 my $pnr = $epg_entry->{'pnr'} ;
3474              
3475 0         0 my $chan = "$tsid-$pnr" ;
3476 0         0 my $channel_num = $chan ;
3477            
3478 0 0       0 if ($channel_lookup_href)
3479             {
3480             # Replace channel name with the text name (rather than tsid/pnr numbers)
3481 0   0     0 $channel_num = $channel_lookup_href->{$chan}{'channel_num'} || $chan ;
3482 0   0     0 $chan = $channel_lookup_href->{$chan}{'channel'} || $chan ;
3483             }
3484            
3485 0 0       0 prt_data("EPG raw entry ($chan)=", $epg_entry) if $DEBUG>=2 ;
3486            
3487             # {chan}
3488             # {pid}
3489             # date => 18-09-2008,
3490             # start => 23:15,
3491             # end => 03:20,
3492             # duration => 04:05,
3493             #
3494             # title => Personal Services,
3495             # text => This is a gently witty, if curiously coy, attempt by director
3496             # genre => Film,
3497             #
3498             # episode => 1
3499             # num_episodes => 2
3500             #
3501              
3502 0         0 my @start_localtime = localtime($epg_entry->{'start'}) ;
3503 0         0 my $start = strftime "%H:%M:%S", @start_localtime ;
3504 0         0 my $date = strftime "%Y-%m-%d", @start_localtime ;
3505              
3506 0         0 my $pid_date = strftime "%Y%m%d", @start_localtime ;
3507 0         0 my $pid = "$epg_entry->{'id'}-$channel_num-$pid_date" ; # id is reused on different channels
3508            
3509 0         0 my @end_localtime = localtime($epg_entry->{'stop'}) ;
3510 0         0 my $end = strftime "%H:%M:%S", @end_localtime ;
3511 0         0 my $end_date = strftime "%Y-%m-%d", @end_localtime ;
3512              
3513 0 0       0 prt_data("Start Time: start=$start, date=$date, localtime=", \@start_localtime) if $DEBUG>=10 ;
3514 0 0       0 prt_data("End Time: end=$end, date=$end_date, localtime=", \@end_localtime) if $DEBUG>=10 ;
3515              
3516              
3517             # keep track of dates
3518             $dates{$chan} ||= {
3519             'start_min' => $epg_entry->{'start'},
3520 0   0     0 'end_max' => $epg_entry->{'stop'},
3521            
3522             'start_date' => $date,
3523             'start' => $start,
3524             'end_date' => $end_date,
3525             'end' => $end,
3526             } ;
3527              
3528 0 0       0 if ($epg_entry->{'start'} < $dates{$chan}{'start_min'})
3529             {
3530 0         0 $dates{$chan}{'start_min'} = $epg_entry->{'start'} ;
3531 0         0 $dates{$chan}{'start_date'} = $date ;
3532 0         0 $dates{$chan}{'start'} = $start ;
3533             }
3534 0 0       0 if ($epg_entry->{'stop'} > $dates{$chan}{'end_max'})
3535             {
3536 0         0 $dates{$chan}{'end_max'} = $epg_entry->{'stop'} ;
3537 0         0 $dates{$chan}{'end_date'} = $end_date ;
3538 0         0 $dates{$chan}{'end'} = $end ;
3539             }
3540              
3541              
3542             ## Set the duration explicitly to allow for BST->GMT clock changes etc
3543 0         0 my $duration = Linux::DVB::DVBT::Utils::duration($start, $end) ;
3544             # my $duration ;
3545             # {
3546             # my $secs = $epg_entry->{'duration_secs'} ;
3547             # my $mins = int($secs/60) ;
3548             # my $hours = int($mins/60) ;
3549             # $mins = $mins % 60 ;
3550             #
3551             # $duration = sprintf "%02d:%02d", $hours, $mins ;
3552             # }
3553            
3554 0         0 my $title = Linux::DVB::DVBT::Utils::text($epg_entry->{'name'}) ;
3555 0         0 my $synopsis = Linux::DVB::DVBT::Utils::text($epg_entry->{'stext'}) ;
3556 0         0 my $etext = Linux::DVB::DVBT::Utils::text($epg_entry->{'etext'}) ;
3557 0         0 my $subtitle = "" ;
3558            
3559 0         0 my $episode ;
3560             my $num_episodes ;
3561 0         0 my $new_program = 0 ;
3562 0         0 my %flags ;
3563            
3564 0         0 Linux::DVB::DVBT::Utils::fix_title(\$title, \$synopsis) ;
3565 0         0 Linux::DVB::DVBT::Utils::fix_synopsis(\$title, \$synopsis, \$new_program) ; # need to call this before fix_episodes to remove "New series"
3566 0         0 Linux::DVB::DVBT::Utils::fix_episodes(\$title, \$synopsis, \$episode, \$num_episodes) ;
3567 0         0 Linux::DVB::DVBT::Utils::fix_audio(\$title, \$synopsis, \%flags) ;
3568 0         0 Linux::DVB::DVBT::Utils::subtitle(\$synopsis, \$subtitle) ;
3569            
3570 0         0 my $epg_flags = $epg_entry->{'flags'} ;
3571            
3572             $epg{$chan}{$pid} = {
3573             'pid' => $pid,
3574             'channel' => $chan,
3575            
3576             'date' => $date,
3577             'start' => $start,
3578             'end' => $end,
3579             'duration' => $duration,
3580            
3581             'title' => $title,
3582             'subtitle' => $subtitle,
3583             'text' => $synopsis,
3584             'etext' => $etext,
3585             'genre' => $epg_entry->{'genre'} || '',
3586              
3587             'episode' => $episode,
3588             'num_episodes' => $num_episodes,
3589            
3590             'tva_prog' => $epg_entry->{'tva_prog'} || '',
3591             'tva_series'=> $epg_entry->{'tva_series'} || '',
3592              
3593             'flags' => {
3594             'mono' => $epg_flags & $EPG_FLAGS{'AUDIO_MONO'} ? 1 : 0,
3595             'stereo' => $epg_flags & $EPG_FLAGS{'AUDIO_STEREO'} ? 1 : 0,
3596             'dual-mono' => $epg_flags & $EPG_FLAGS{'AUDIO_DUAL'} ? 1 : 0,
3597             'multi' => $epg_flags & $EPG_FLAGS{'AUDIO_MULTI'} ? 1 : 0,
3598             'surround' => $epg_flags & $EPG_FLAGS{'AUDIO_SURROUND'} ? 1 : 0,
3599             'he-aac' => $epg_flags & $EPG_FLAGS{'AUDIO_HEAAC'} ? 1 : 0,
3600              
3601             '4:3' => $epg_flags & $EPG_FLAGS{'VIDEO_4_3'} ? 1 : 0,
3602             '16:9' => $epg_flags & $EPG_FLAGS{'VIDEO_16_9'} ? 1 : 0,
3603             'hdtv' => $epg_flags & $EPG_FLAGS{'VIDEO_HDTV'} ? 1 : 0,
3604             'h264' => $epg_flags & $EPG_FLAGS{'VIDEO_H264'} ? 1 : 0,
3605              
3606 0 0 0     0 'subtitles' => $epg_flags & $EPG_FLAGS{'SUBTITLES'} ? 1 : 0,
    0 0        
    0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
3607            
3608             'new' => $new_program,
3609             },
3610             } ;
3611            
3612             ## Process strings
3613 0         0 foreach my $field (qw/title subtitle text/)
3614             {
3615             # ensure filled with something
3616 0 0       0 if (!$epg{$chan}{$pid}{$field})
3617             {
3618 0         0 $epg{$chan}{$pid}{$field} = 'unknown' ;
3619             }
3620             }
3621            
3622              
3623 0 0       0 prt_data("EPG final entry ($chan) $pid=", $epg{$chan}{$pid}) if $DEBUG>=2 ;
3624              
3625             }
3626            
3627             ## analyse statistics
3628 0         0 my %epg_statistics ;
3629 0         0 $epg_statistics{'totals'} = $epg_stats->{'totals'} ;
3630 0         0 foreach my $part_href (@{$epg_stats->{'parts'}})
  0         0  
3631             {
3632 0         0 my ($tsid, $pnr, $parts, $parts_left) = @{$part_href}{qw/tsid pnr parts parts_left/} ;
  0         0  
3633 0         0 $epg_statistics{'parts'}{$tsid}{$pnr} = {
3634             'parts' => $parts,
3635             'parts_left' => $parts_left,
3636             } ;
3637             }
3638 0         0 foreach my $err_href (@{$epg_stats->{'errors'}})
  0         0  
3639             {
3640 0         0 my ($freq, $section, $errors) = @{$err_href}{qw/freq section errors/} ;
  0         0  
3641 0         0 $epg_statistics{'errors'}{$freq}{$section} = $errors ;
3642             }
3643              
3644 0 0       0 prt_data("** EPG STATS ** =", \%epg_statistics) if $DEBUG ;
3645            
3646 0         0 return (\%epg, \%dates, \%epg_statistics) ;
3647             }
3648              
3649              
3650             #============================================================================================
3651              
3652             =back
3653              
3654             =head3 MULTIPLEX RECORDING
3655              
3656             =over 4
3657              
3658             =cut
3659              
3660             #============================================================================================
3661              
3662              
3663              
3664             #----------------------------------------------------------------------------
3665              
3666             =item B
3667              
3668             Adds a demultiplexer filter for the specified PID to allow that stream to be recorded.
3669              
3670             Internally keeps track of the list of filters created (see L for format of the
3671             list entries)
3672              
3673             $pid_type is a string and should be one of:
3674              
3675             "video"
3676             "audio"
3677             "teletext"
3678             "subtitle"
3679             "other"
3680              
3681             Optionally a tsid may be specified. This will be used if to tune the frontend if it has not yet been tuned.
3682              
3683             Returns 0 for success; error code otherwise.
3684              
3685             =cut
3686              
3687             sub add_demux_filter
3688             {
3689 0     0 1 0 my $self = shift ;
3690 0         0 my ($pid, $pid_type, $tsid, $demux_params_href) = @_ ;
3691              
3692 0   0     0 $tsid ||= "0" ;
3693            
3694 0 0       0 printf STDERR "add_demux_filter(pid=$pid, type=$pid_type, tsid=$tsid)\n", $pid if $DEBUG ;
3695              
3696             ## valid pid?
3697 0 0 0     0 if ( ($pid < 0) || ($pid > $MAX_PID) )
3698             {
3699 0         0 return $self->handle_error("Invalid PID ($pid)") ;
3700             }
3701              
3702             # hardware closed?
3703 0 0       0 if ($self->dvb_closed())
3704             {
3705             # Raise an error
3706 0         0 return $self->handle_error("DVB tuner has been closed") ;
3707             }
3708              
3709             ## start with current tuning params
3710 0         0 my $frontend_href = $self->frontend_params() ;
3711 0 0       0 prt_data("frontend_href=", $frontend_href) if $DEBUG >= 5 ;
3712              
3713             # re-tune if not the same tsid
3714 0 0       0 if ($frontend_href)
3715             {
3716 0   0     0 my $current_tsid = $frontend_href->{'tsid'} || "" ;
3717 0 0       0 $frontend_href = undef if $current_tsid ne $tsid ;
3718             }
3719            
3720             # check tuning
3721 0 0       0 if (!$frontend_href)
3722             {
3723 0 0       0 print STDERR " frontend not yet tuned...\n" if $DEBUG >= 5 ;
3724             ## if we've got a tsid, then use that to get the parameters and tune the frontend
3725 0 0       0 if ($tsid)
3726             {
3727 0 0       0 print STDERR " + got tsid=$tsid, attempting tune\n" if $DEBUG >= 5 ;
3728             # ensure we have the tuning info
3729 0         0 my $tuning_href = $self->get_tuning_info() ;
3730 0 0       0 if (! $tuning_href)
3731             {
3732 0         0 return $self->handle_error("Unable to get tuning information") ;
3733             }
3734            
3735             # get frontend params
3736 0         0 $frontend_href = Linux::DVB::DVBT::Config::tsid_params($tsid, $tuning_href) ;
3737 0 0       0 if (! $frontend_href)
3738             {
3739 0         0 return $self->handle_error("Unable to get frontend parameters for specified TSID ($tsid)") ;
3740             }
3741            
3742             # Tune frontend
3743 0 0       0 if ($self->set_frontend(%$frontend_href, 'timeout' => $self->timeout))
3744             {
3745 0         0 return $self->handle_error("Unable to tune frontend") ;
3746             }
3747 0 0       0 print STDERR " + frontend tuned to tsid=$tsid\n" if $DEBUG >= 5 ;
3748             }
3749             }
3750              
3751             ## final check
3752 0 0       0 if (!$frontend_href)
3753             {
3754             # Raise an error
3755 0         0 return $self->handle_error("Frontend must be tuned before setting demux filter (have you run scan() yet?)") ;
3756             }
3757              
3758             ## next try setting the filter
3759 0         0 my $fd = dvb_add_demux($self->{dvb}, $pid) ;
3760              
3761 0 0       0 if ($fd <= 0)
3762             {
3763             # Raise an error
3764 0         0 return $self->handle_error("Unable to create demux filter for pid $pid") ;
3765             }
3766              
3767 0 0       0 printf STDERR "added demux filter : PID = 0x%03x ( fd = $fd )\n", $pid if $DEBUG ;
3768              
3769             ## Create filter information
3770 0 0       0 if (exists($frontend_href->{'tsid'}))
3771             {
3772             # frontend set during normal operation via internal routines
3773 0         0 $tsid = $frontend_href->{'tsid'} ;
3774             }
3775             else
3776             {
3777             # Someone has called the frontend setup routine directly, so update TSID to match!
3778 0         0 my $tuning_href = $self->get_tuning_info() ;
3779 0         0 $tsid = Linux::DVB::DVBT::Config::find_tsid($frontend_href->{'frequency'}, $tuning_href) ;
3780              
3781             # save tsid
3782 0         0 $frontend_href->{'tsid'} = $tsid ;
3783             }
3784 0         0 my $filter_href = {
3785             'fd' => $fd,
3786             'tsid' => $tsid,
3787             'pid' => $pid,
3788             'pidtype' => $pid_type,
3789            
3790             ## keep track of the associated program's demux params
3791             'demux_params' => $demux_params_href,
3792             } ;
3793              
3794 0         0 push @{$self->{_demux_filters}}, $filter_href ;
  0         0  
3795              
3796 0         0 return 0 ;
3797             }
3798              
3799              
3800             #----------------------------------------------------------------------------
3801              
3802             =item B
3803              
3804             Return the list of currently active demux filters.
3805              
3806             Each filter entry in the list consists of a HASH ref of the form:
3807              
3808             'fd' => file handle for this filter
3809             'tsid' => Transponder ID
3810             'pid' => Stream PID
3811             'pidtype' => $pid_type,
3812              
3813             =cut
3814              
3815             sub demux_filter_list
3816             {
3817 0     0 1 0 my $self = shift ;
3818 0         0 return $self->{_demux_filters} ;
3819             }
3820              
3821             #----------------------------------------------------------------------------
3822              
3823             =item B
3824              
3825             Closes any currently open demux filters (basically tidies up after finished recording)
3826              
3827             =cut
3828              
3829             sub close_demux_filters
3830             {
3831 0     0 1 0 my $self = shift ;
3832              
3833             #prt_data("close_demux_filters() dvb=", $self->{dvb}, "Demux filters=", $self->{_demux_filters}) ;
3834              
3835             # hardware closed?
3836 0 0       0 unless ($self->dvb_closed())
3837             {
3838 0         0 foreach my $filter_href (@{$self->{_demux_filters}} )
  0         0  
3839             {
3840 0         0 dvb_del_demux($self->{dvb}, $filter_href->{fd}) ;
3841             }
3842             }
3843 0         0 $self->{_demux_filters} = [] ;
3844             }
3845              
3846             #----------------------------------------------------------------------------
3847              
3848             =item B
3849              
3850             Clears out the list of recordings for a multiplex. Also releases any demux filters.
3851              
3852             =cut
3853              
3854              
3855             # clear down any records
3856             sub multiplex_close
3857             {
3858 0     0 1 0 my $self = shift ;
3859              
3860 0         0 $self->close_demux_filters() ;
3861             $self->{_multiplex_info} = {
3862 0         0 'duration' => 0,
3863             'tsid' => 0,
3864             'files' => {},
3865             } ;
3866             }
3867              
3868             #----------------------------------------------------------------------------
3869              
3870             =item B
3871              
3872             Helper function intended to be used to parse a program's arguments list (@ARGV). The arguments
3873             are parsed into the provided ARRAY ref ($chan_spec_aref) that can then be passed to L
3874             (see that method for a description of the $chan_spec_aref ARRAY).
3875              
3876             The arguments define the set of streams (all from the same multiplex, or transponder) that are to be recorded
3877             at the same time into each file.
3878              
3879             Each stream definition must start with a filename, followed by either channel names or pid numbers. Also,
3880             you must specify the duration of the stream. Finally, an offset time can be specified that delays the start of
3881             the stream (for example, if the start time of the programs to be recorded are staggered).
3882              
3883             The list of recognised arguments is:
3884              
3885             =over 4
3886              
3887             =item f|file
3888              
3889             Filename
3890              
3891             =item c|chan
3892              
3893             Channel name
3894              
3895             =item p|pid
3896              
3897             PID number
3898              
3899             =item lan|lang
3900              
3901             L
3902              
3903             =item out
3904              
3905             L
3906              
3907             =item len|duration
3908              
3909             Recording duration (specified in HH:MM or HH:MM:SS format, or as minutes)
3910              
3911             =item off|offset
3912              
3913             Start offset (specified in HH:MM or HH:MM:SS format, or as minutes)
3914              
3915             =item title
3916              
3917             Title name (reserved for future use)
3918              
3919             =item ev|event
3920              
3921             Event id used for timeslipping (see L)
3922              
3923             =item tslip|timeslip
3924              
3925             Program start/end/both extended (see L)
3926              
3927             =item max|max_timeslip
3928              
3929             Maximum timeslip time (specified in HH:MM or HH:MM:SS format, or as minutes) (see L)
3930              
3931             =back
3932              
3933             =back
3934              
3935              
3936             =head3 Output Specification
3937            
3938             A file defined by channel name(s) may optionally also contain a language spec and an output spec:
3939              
3940             The output spec determines which type of streams are included in the recording. By default, "video" and "audio" tracks are recorded. You can
3941             override this by specifying the output spec. For example, if you also want the subtitle track to be recorded, then you need to
3942             specify the output includes video, audio, and subtitles. This can be done either by specifying the types in full or by just their initials.
3943              
3944             For example, any of the following specs define video, audio, and subtitles:
3945              
3946             "audio, video, subtitle"
3947             "a, v, s"
3948             "avs"
3949              
3950             Note that, if the file format explicitly defines the type of streams required, then there is no need to specify an output spec. For example,
3951             specifying that the file format is mp3 will ensure that only the audio is recorded.
3952              
3953              
3954             =head3 Language Specification
3955              
3956             In a similar fashion, the language spec determines the audio streams to be recorded in the program. Normally, the default audio stream is included
3957             in the recorded file. If you want either an alternative audio track, or additional audio tracks, then you use the language spec to
3958             define them. The spec consists of a space seperated list of language names. If the spec contains a '+' then the audio streams are
3959             added to the default; otherwise the default audio is B and only those other audio tracks in the spec are recorded. Note that
3960             the specification order is important, audio streams from the language spec are matched with the audio details in the specified order. Once a
3961             stream has been skipped there is no back tracking (see the examples below for clarification).
3962              
3963             For example, if a channel has the audio details: eng:601 eng:602 fra:603 deu:604 (i.e. 2 English tracks, 1 French track, 1 German) then
3964              
3965             =over 4
3966              
3967             =item lang="+eng"
3968              
3969             Results in the default audio (pid 601) and the next english track (pid 602) recorded
3970              
3971             =item lang="fra"
3972              
3973             Results in just the french track (pid 603) recorded
3974              
3975             =item lang="eng fra"
3976              
3977             Results in the B english (pid 602) and the french track (pid 603) recorded
3978              
3979             =item lang="fra eng"
3980              
3981             Results in an error. The english tracks have already been skipped to match the french track, and so will not be matched again.
3982              
3983             =back
3984              
3985             Note that the output spec overrides the language spec. If the output does not include audio, then the language spec is ignored.
3986              
3987              
3988             =head3 Timeslip Specification
3989            
3990             Timeslip recording uses the now/next live EPG information to track the start and end of the program being recorded. This information
3991             is transmit by the broadcaster and (hopefully) is a correct reflection of the broadcast of the program. Using this feature should then
3992             allow recordings to be adjusted to account for late start of a program (for example, due to extended news or sports events).
3993              
3994             To use the feature you MUST specify the event id of the program to be recorded. This information is the same event id that is gathered
3995             by the L function. By default, the timeslip will automatically extend the end of the recording by up to 1 hour (recording stops
3996             automatically when the now/next information indicates the real end of the program).
3997              
3998             =over 4
3999              
4000             =item event=41140
4001              
4002             Sets the event id to be 41140
4003              
4004             =back
4005              
4006             Optionally you can specify a different maximum timeslip time using the 'max_timeslip' argument. Specify the time in minutes (or HH:MM or HH:MM:SS).
4007             Note that this has a different effect depending on the B setting (which specifies the program 'edge'):
4008              
4009             =over 4
4010              
4011             =item max_timeslip=2:00
4012              
4013             Sets the maximum timslip time to be 2 hours (i.e. by default, the recording end can be extended by up to 2 hours)
4014              
4015             =back
4016              
4017              
4018             Also, you can set the 'edge' of the program that is to be timeslipped using the B parameter:
4019              
4020             =over 4
4021              
4022             =item timeslip=end
4023              
4024             Timeslips only the end of the recording. This means that the recording will record for the normal duration, and then check to see if
4025             the specified event (B) has finished broadcasting. If not, the recording continues until the program finishes OR the maximum timeslip
4026             duration has expired.
4027              
4028             This is the default.
4029              
4030             =item timeslip=start
4031              
4032             Timeslips only the start of the recording. This means that the recording will not start until the event begins broadcasting. Once started, the
4033             specified duration will be recorded.
4034              
4035             Note that this can mean that you miss a few seconds at the start of the program (which is why the default is to just extend the end of the recording).
4036              
4037             =item timeslip=both
4038              
4039             Performs both start and end recording timeslipping.
4040              
4041             =back
4042              
4043              
4044             =head3 Examples
4045              
4046             Example valid sets of arguments are:
4047              
4048             =over 4
4049              
4050             =item file=f1.mpeg chan=bbc1 out=avs lang=+eng len=1:00 off=0:10
4051              
4052             Record channel BBC1 into file f1.mpeg, include subtitles, add second English audio track, record for 1 hour, start recording 10 minutes from now
4053              
4054             =item file=f2.mp3 chan=bbc2 len=0:30
4055              
4056             Record channel BBC2 into file f2.mp3, audio only, record for 30 minutes
4057              
4058             =item file=f3.ts pid=600 pid=601 len=0:30
4059              
4060             Record pids 600 & 601 into file f3.ts, record for 30 minutes
4061              
4062             =back
4063              
4064             =over 4
4065              
4066             =cut
4067              
4068             my %multiplex_params = (
4069             '^f' => 'file',
4070             '^c' => 'chan',
4071             '^p' => 'pid',
4072             '^lan' => 'lang',
4073             '^sublang' => 'sublang',
4074             '^out' => 'out',
4075             '^(len|duration)' => 'duration',
4076             '^off' => 'offset',
4077             '^title' => 'title',
4078            
4079             '^ev' => 'event_id',
4080             '^(tslip|timeslip)' => 'timeslip',
4081             '^max' => 'max_timeslip',
4082            
4083             ) ;
4084             sub multiplex_parse
4085             { # modified by rainbowcrypt
4086 10     10 1 13106 my $self = shift ;
4087 10         28 my ($chan_spec_aref, @args) = @_ ;
4088              
4089             ## work through the args
4090 10         9 my $current_file_href ;
4091             my $current_chan_href ;
4092 10         11 foreach my $arg (@args)
4093             {
4094             ## skip non-valid
4095            
4096             # strip off any extra quotes
4097 69 100       239 if ($arg =~ /(\S+)\s*=\s*([\'\"]{0,1})([^\2]*)\2/)
4098             {
4099 68         133 my ($var, $value, $valid) = (lc $1, $3, 0) ;
4100              
4101             # allow fuzzy input - convert to known variable names
4102 68         114 foreach my $regexp (keys %multiplex_params)
4103             {
4104 501 100       3145 if ($var =~ /$regexp/)
4105             {
4106 67         83 $var = $multiplex_params{$regexp} ;
4107 67         39 ++$valid ;
4108 67         61 last ;
4109             }
4110             }
4111            
4112             # check we know this var
4113 68 100       129 if (!$valid)
4114             {
4115 1         8 return $self->handle_error("Unexpected variable \"$var = $value\"") ;
4116             }
4117            
4118             # new file
4119 67 100       76 if ($var eq 'file')
4120             {
4121 13         9 $current_chan_href = undef ;
4122 13         42 $current_file_href = {
4123             'file' => $value,
4124             'chans' => [],
4125             'pids' => [],
4126            
4127             'event_id' => -1,
4128             'timeslip' => 'off',
4129             'max_timeslip' => 0,
4130             } ;
4131 13         16 push @$chan_spec_aref, $current_file_href ;
4132 13         15 next ;
4133             }
4134             else
4135             {
4136             # check file has been set before moving on
4137 54 100       81 return $self->handle_error("Variable \"$var = $value\" defined before specifying the filename")
4138             unless defined($current_file_href) ;
4139             }
4140              
4141             # duration / offset
4142 53         30 my $handled ;
4143 53         44 foreach my $genvar (qw/duration offset/)
4144             {
4145 93 100       127 if ($var eq $genvar)
4146             {
4147 27         45 $current_file_href->{$genvar} = $value ;
4148 27         19 ++$handled ;
4149 27         25 last ;
4150             }
4151             }
4152 53 100       84 next if $handled ;
4153            
4154             # new pid
4155 26 100       32 if ($var eq 'pid')
4156             {
4157 14         14 push @{$current_file_href->{'pids'}}, $value ;
  14         21  
4158 14         18 next ;
4159             }
4160            
4161             # event_id setting
4162 12 50       18 if ($var eq 'event_id')
4163             {
4164 0         0 $current_file_href->{'event_id'} = $value ;
4165 0         0 next ;
4166             }
4167            
4168             # timeslip setting
4169 12 50       21 if ($var eq 'timeslip')
4170             {
4171 0         0 $current_file_href->{'timeslip'} = 'end' ;
4172 0 0       0 if ($value =~ /both/i)
4173             {
4174 0         0 $current_file_href->{'timeslip'} = 'both' ;
4175             }
4176 0 0       0 if ($value =~ /start/i)
4177             {
4178 0         0 $current_file_href->{'timeslip'} = 'start' ;
4179             }
4180 0         0 next ;
4181             }
4182            
4183             # maximum slippage setting
4184 12 50       15 if ($var eq 'max_timeslip')
4185             {
4186 0         0 $current_file_href->{'max_timeslip'} = $value ;
4187 0         0 next ;
4188             }
4189            
4190             # new chan
4191 12 100       15 if ($var eq 'chan')
4192             {
4193 5         9 $current_chan_href = {
4194             'chan' => $value,
4195             } ;
4196 5         4 push @{$current_file_href->{'chans'}}, $current_chan_href ;
  5         8  
4197 5         7 next ;
4198             }
4199             else
4200             {
4201             # check chan has been set before moving on
4202 7 100       14 return $self->handle_error("Variable \"$var = $value\" defined before specifying the channel")
4203             unless defined($current_chan_href) ;
4204             }
4205            
4206             # lang / out - requires chan
4207 6         7 foreach my $chvar (qw/lang out/)
4208             {
4209 10 100       14 if ($var eq $chvar)
4210             {
4211 6         14 $current_chan_href->{$chvar} = $value ;
4212 6         4 last ;
4213             }
4214             }
4215            
4216             # sublang - requires chan #by rainbowcrypt
4217 6 50       14 if ($var eq 'sublang')
4218             {
4219 0         0 $current_chan_href->{'sublang'} = $value ;
4220 0         0 next ;
4221             }
4222              
4223             }
4224             else
4225             {
4226 1         6 return $self->handle_error("Unexpected arg \"$arg\"") ;
4227             }
4228             }
4229            
4230             ## Check entries for required information
4231 6         9 foreach my $spec_href (@$chan_spec_aref)
4232             {
4233 8         11 my $file = $spec_href->{'file'} ;
4234 8 100       17 if (!$spec_href->{'duration'})
4235             {
4236 1         5 return $self->handle_error("File \"$file\" has no duration specified") ;
4237             }
4238 7 100 66     6 if (! @{$spec_href->{'pids'}} && ! @{$spec_href->{'chans'}})
  7         31  
  4         9  
4239             {
4240 1         5 return $self->handle_error("File \"$file\" has no channels/pids specified") ;
4241             }
4242             # if (@{$spec_href->{'pids'}} && @{$spec_href->{'chans'}})
4243             # {
4244             # return $self->handle_error("File \"$file\" has both channels and pids specified at the same time") ;
4245             # }
4246             }
4247            
4248 4         12 return 0 ;
4249             }
4250              
4251             #----------------------------------------------------------------------------
4252              
4253             =item B
4254              
4255             Selects a set of streams based on the definitions in the chan spec ARRAY ref. The array
4256             contains hashes of:
4257              
4258             {
4259             'file' => filename
4260             'chans' => [
4261             { 'chan' => channel name, 'lang' => lang spec, 'out' => output },
4262             ...
4263             ]
4264             'pids' => [ stream pid, ... ]
4265             'offset' => time
4266             'duration' => time
4267             }
4268              
4269             Each entry must contain a target filename, a recording duration, and either channel definitions or pid definitions.
4270             The channel definition list consists of HASHes containing a channel name, a language spec, and an output spec.
4271              
4272             The language and output specs are as described in L
4273              
4274             The optional options hash consists of:
4275              
4276             {
4277             'tsid' => tsid
4278             'lang' => default lang spec
4279             'out' => default output spec
4280             'no-pid-check' => when set, allows specification of any pids
4281             }
4282              
4283             The TSID definition defines the transponder (multiplex) to use. Use this when pids define the streams rather than
4284             channel names and the pid value(s) may occur in multiple TSIDs.
4285              
4286             If you define default language or output specs, these will be used in all file definitions unless that file definition
4287             has it's own output/language spec. For example, if you want all files to include subtitles you can specify it once as
4288             the default rather than for every file.
4289              
4290             The method sets up the DVB demux filters to record each of the required streams. It also sets up a HASH of the settings,
4291             which may be read using L. This hash being used in L.
4292              
4293             Setting the 'no-pid-check' allows the recording of pids that are not known to the module (i.e. not in the scan files). This is
4294             for experimental use.
4295              
4296             =cut
4297              
4298              
4299             sub multiplex_select
4300             {
4301 0     0 1 0 my $self = shift ;
4302 0         0 my ($chan_spec_aref, %options) = @_ ;
4303            
4304 0         0 my $error = 0 ;
4305              
4306 0 0       0 print STDERR "multiplex_select()\n" if $DEBUG>=10 ;
4307              
4308             ## ensure we have the tuning info
4309 0         0 my $tuning_href = $self->get_tuning_info() ;
4310 0 0       0 if (! $tuning_href)
4311             {
4312 0         0 return $self->handle_error("Unable to get tuning information from config file (have you run scan() yet?)") ;
4313             }
4314              
4315             # hardware closed?
4316 0 0       0 if ($self->dvb_closed())
4317             {
4318             # Raise an error
4319 0         0 return $self->handle_error("DVB tuner has been closed") ;
4320             }
4321              
4322             ## start with clean slate
4323 0         0 $self->multiplex_close() ;
4324              
4325 0         0 my %files ;
4326              
4327             ## Defaults
4328 0   0     0 my $def_lang = $options{'lang'} || "" ;
4329 0   0     0 my $def_lang_sub = $options{'sublang'} || ""; #by rainbowcrypt
4330 0   0     0 my $def_out = $options{'out'} || "" ;
4331              
4332             ## start with TSID option
4333 0         0 my $tsid = $options{'tsid'} ;
4334            
4335             ## process each entry
4336 0         0 my $demux_count = 0 ;
4337 0         0 foreach my $spec_href (@$chan_spec_aref)
4338             {
4339 0         0 my $file = $spec_href->{'file'} ;
4340 0 0       0 if ($file)
4341             {
4342 0         0 my $need_eit = 0 ;
4343            
4344             ## get entry for this file (or create it)
4345 0         0 my $href = $self->_multiplex_file_href($file) ;
4346            
4347             # keep track of file settings
4348 0   0     0 $files{$file} ||= {'chans'=>0, 'pids'=>0} ;
4349              
4350             # add error if already got pids for this file
4351 0 0       0 if ( $files{$file}{'pids'} )
4352             {
4353 0         0 return $self->handle_error("Cannot mix chan definitions with pid definitions for file \"$file\"") ;
4354             }
4355              
4356             # set time
4357 0   0     0 $href->{'offset'} ||= Linux::DVB::DVBT::Utils::time2secs($spec_href->{'offset'} || 0) ;
      0        
4358 0   0     0 $href->{'duration'} ||= Linux::DVB::DVBT::Utils::time2secs($spec_href->{'duration'} || 0) ;
      0        
4359              
4360             # title
4361 0   0     0 $href->{'title'} ||= $spec_href->{'title'} ;
4362            
4363              
4364             # types of streams present
4365 0         0 $href->{'audio'} = 0 ;
4366 0         0 $href->{'video'} = 0 ;
4367 0         0 $href->{'subtitle'} = 0 ;
4368            
4369             # list of channel names
4370 0         0 $href->{'channels'} = [] ;
4371            
4372              
4373             # event_id
4374 0   0     0 $href->{'event_id'} ||= $spec_href->{'event_id'} || -1 ;
      0        
4375            
4376             # timeslip
4377 0   0     0 $href->{'timeslip_start'} ||= 0 ;
4378 0   0     0 $href->{'timeslip_end'} ||= 0 ;
4379 0 0       0 if ($href->{'event_id'} >= 0)
4380             {
4381             ## only enable timeslip if we've got an event id
4382 0 0       0 if ($spec_href->{'timeslip'} =~ /start|both/)
4383             {
4384 0         0 $href->{'timeslip_start'} = 1 ;
4385             }
4386 0 0       0 if ($spec_href->{'timeslip'} =~ /end|both/)
4387             {
4388 0         0 $href->{'timeslip_end'} = 1 ;
4389             }
4390            
4391             ## default to slip end
4392 0 0 0     0 if (!$href->{'timeslip_start'} && !$href->{'timeslip_end'})
4393             {
4394 0         0 $href->{'timeslip_end'} = 1 ;
4395             }
4396            
4397             ## need to add EIT to perform the timeslip
4398 0         0 ++$need_eit ;
4399             }
4400              
4401             # slippage time (default = 1 hour)
4402 0   0     0 $href->{'max_timeslip'} = Linux::DVB::DVBT::Utils::time2secs($spec_href->{'max_timeslip'} || 3600) ;
4403            
4404             # calc total length
4405 0         0 my $period = $href->{'offset'} + $href->{'duration'} ;
4406 0 0       0 $self->{_multiplex_info}{'duration'}=$period if ($self->{_multiplex_info}{'duration'} < $period) ;
4407            
4408             # chans
4409 0   0     0 $spec_href->{'chans'} ||= [] ;
4410 0         0 foreach my $chan_href (@{$spec_href->{'chans'}})
  0         0  
4411             {
4412 0         0 my $channel_name = $chan_href->{'chan'} ;
4413 0   0     0 my $lang = $chan_href->{'lang'} || $def_lang ;
4414 0   0     0 my $lang_sub = $chan_href->{'sublang'} || $def_lang_sub ; #by rainbowcrypt
4415 0   0     0 my $out = $chan_href->{'out'} || $def_out ;
4416            
4417 0         0 push @{$href->{'channels'}}, $channel_name ;
  0         0  
4418            
4419             # find channel
4420 0         0 my ($frontend_params_href, $demux_params_href) = Linux::DVB::DVBT::Config::find_channel($channel_name, $tuning_href) ;
4421 0 0       0 if (! $frontend_params_href)
4422             {
4423 0         0 return $self->handle_error("Unable to find channel $channel_name") ;
4424             }
4425              
4426             # check in same multiplex
4427 0   0     0 $tsid ||= $frontend_params_href->{'tsid'} ;
4428 0 0       0 if ($tsid ne $frontend_params_href->{'tsid'})
4429             {
4430 0         0 return $self->handle_error("Channel $channel_name (on TSID $frontend_params_href->{'tsid'}) is not in the same multiplex as other channels/pids (on TSID $tsid)") ;
4431             }
4432            
4433             # Ensure the combination of file format, output spec, and language spec are valid. They get adjusted as required
4434 0         0 my $dest_file = $file ;
4435             $error = Linux::DVB::DVBT::Ffmpeg::sanitise_options(\$dest_file, \$out, \$lang,
4436 0         0 $href->{'errors'}, $href->{'warnings'}) ;
4437 0 0       0 return $self->handle_error($error) if $error ;
4438              
4439             # save settings
4440 0         0 my $ext = (fileparse($dest_file, '\..*'))[2] ;
4441            
4442 0         0 $href->{'destfile'} = $dest_file ;
4443 0         0 $href->{'destext'} = $ext ;
4444 0         0 $href->{'out'} = $out ;
4445 0         0 $href->{'lang'} = $lang ;
4446 0         0 $href->{'sublang'} = $lang_sub; # by rainbowcrypt
4447              
4448             # Handle output specification to get a list of pids
4449 0         0 my @pids ;
4450 0         0 $error = Linux::DVB::DVBT::Config::out_pids($demux_params_href, $out, $lang, $lang_sub, \@pids) ; #by rainbowcrypt
4451 0 0       0 return $self->handle_error($error) if $error ;
4452            
4453 0 0       0 if ($need_eit)
4454             {
4455             push @pids, {
4456 0         0 'pid' => $SI_TABLES{'EIT'},
4457             'pidtype' => 'EIT',
4458            
4459             'demux_params' => undef,
4460             } ;
4461            
4462             ## clear flag otherwise we'll record it twice!
4463 0         0 $need_eit = 0 ;
4464             }
4465              
4466 0 0       0 prt_data(" + Add pids for chan = ", \@pids) if $DEBUG >= 15 ;
4467            
4468             # add filters
4469 0         0 foreach my $pid_href (@pids)
4470             {
4471             # add filter
4472 0         0 $error = $self->add_demux_filter($pid_href->{'pid'}, $pid_href->{'pidtype'}, $tsid, $pid_href->{'demux_params'}) ;
4473 0 0       0 return $self->handle_error($error) if $error ;
4474            
4475             # keep demux filter info
4476 0         0 push @{$href->{'demux'}}, $self->{_demux_filters}[-1] ;
  0         0  
4477            
4478             # keep track of the stream types for this file
4479 0 0       0 $href->{'video'}=1 if ($pid_href->{'pidtype'} eq 'video') ;
4480 0 0       0 $href->{'audio'}=1 if ($pid_href->{'pidtype'} eq 'audio') ;
4481 0 0       0 $href->{'subtitle'}=1 if ($pid_href->{'pidtype'} eq 'subtitle') ;
4482            
4483            
4484 0         0 ++$files{$file}{'chans'} ;
4485             }
4486             }
4487            
4488              
4489             # pids
4490 0   0     0 $spec_href->{'pids'} ||= [] ;
4491 0 0       0 if ($need_eit)
4492             {
4493 0         0 push @{$spec_href->{'pids'}}, $SI_TABLES{'EIT'} ;
  0         0  
4494             }
4495              
4496            
4497 0         0 foreach my $pid (@{$spec_href->{'pids'}})
  0         0  
4498             {
4499             # array of: { 'pidtype'=>$type, 'tsid' => $tsid, ... } for this pid value
4500 0         0 my $pid_href ;
4501 0         0 my @pid_info = Linux::DVB::DVBT::Config::pid_info($pid, $tuning_href) ;
4502              
4503 0 0       0 if (!@pid_info)
4504             {
4505             # can't find pid - see if it's a standard SI table
4506 0         0 my $new_pid_href = $self->_si_pid($pid, $tsid) ;
4507 0 0       0 push @pid_info, $new_pid_href if $new_pid_href ;
4508             }
4509 0 0       0 if (! @pid_info)
    0          
4510             {
4511             # can't find pid
4512 0 0       0 if ($options{'no-pid-check'})
4513             {
4514             # create a simple entry if we allow any pids
4515 0         0 $pid_href = {
4516             'pidtype' => 'data',
4517             'tsid' => $tsid,
4518             } ;
4519             }
4520             else
4521             {
4522 0         0 return $self->handle_error("Unable to find PID $pid in the known list stored in your config file") ;
4523             }
4524             }
4525             elsif (@pid_info > 1)
4526             {
4527             # if we haven't already got a tsid, use the first
4528 0 0       0 if (!$tsid)
4529             {
4530 0         0 $pid_href = $pid_info[0] ;
4531             }
4532             else
4533             {
4534             # find entry with matching TSID
4535 0         0 foreach (@pid_info)
4536             {
4537 0 0       0 if ($_->{'tsid'} eq $tsid)
4538             {
4539 0         0 $pid_href = $_ ;
4540 0         0 last ;
4541             }
4542             }
4543             }
4544              
4545             # error if none match
4546 0 0       0 if (!$pid_href)
4547             {
4548 0         0 return $self->handle_error("Multiple multiplexes contain pid $pid, please specify the multiplex number (tsid)") ;
4549             }
4550             }
4551             else
4552             {
4553             # found a single one
4554 0         0 $pid_href = $pid_info[0] ;
4555             }
4556            
4557             # set filter
4558 0 0       0 if ($pid_href)
4559             {
4560 0 0       0 prt_data(" + Add pid = ", $pid_href) if $DEBUG >= 15 ;
4561              
4562             # check multiplex
4563 0   0     0 $tsid ||= $pid_href->{'tsid'} ;
4564 0 0 0     0 if (!defined($tsid) || !defined($pid_href->{'tsid'}) || ($tsid ne $pid_href->{'tsid'}) )
      0        
4565             {
4566 0         0 return $self->handle_error("PID $pid (on TSID $pid_href->{'tsid'}) is not in the same multiplex as other channels/pids (on TSID $tsid)") ;
4567             }
4568            
4569             # add a filter
4570 0         0 $error = $self->add_demux_filter($pid, $pid_href->{'pidtype'}, $tsid, $pid_href->{'demux_params'}) ;
4571 0 0       0 return $self->handle_error($error) if $error ;
4572            
4573             # keep demux filter info
4574 0         0 push @{$href->{'demux'}}, $self->{_demux_filters}[-1] ;
  0         0  
4575              
4576             # keep track of the stream types for this file
4577 0 0       0 $href->{'video'}=1 if ($pid_href->{'pidtype'} eq 'video') ;
4578 0 0       0 $href->{'audio'}=1 if ($pid_href->{'pidtype'} eq 'audio') ;
4579 0 0       0 $href->{'subtitle'}=1 if ($pid_href->{'pidtype'} eq 'subtitle') ;
4580            
4581            
4582 0         0 $files{$file}{'pids'}++ ;
4583             }
4584             }
4585            
4586             # add up all of the demux filters
4587 0         0 $demux_count += scalar(@{$href->{'demux'}}) ;
  0         0  
4588             }
4589             }
4590            
4591             # check that at least one demux filter has been added
4592 0 0       0 if ( !$demux_count )
4593             {
4594 0         0 $error = "No demux filters added (are you trying to record a special channel?)" ;
4595 0         0 return $self->handle_error($error) ;
4596             }
4597            
4598             ## Add in SI tables (if required) to the multiplex info
4599 0         0 $error = $self->_add_required_si($tsid) ;
4600            
4601             ## ensure pid lists match the demux list
4602 0         0 $self->_update_multiplex_info($tsid) ;
4603              
4604 0         0 return $error ;
4605             }
4606              
4607             #----------------------------------------------------------------------------
4608              
4609             =item B
4610              
4611             Returns the total recording duration (in seconds) of the currently spricied multiplex recordings.
4612              
4613             Used for informational purposes.
4614              
4615             =cut
4616              
4617             sub multiplex_record_duration
4618             {
4619 0     0 1 0 my $self = shift ;
4620            
4621 0         0 return $self->{_multiplex_info}{'duration'} ;
4622             }
4623              
4624             #----------------------------------------------------------------------------
4625              
4626             =item B
4627              
4628             Returns HASH of the currently defined multiplex filters. HASH is of the form:
4629              
4630             files => {
4631             $file => {
4632             'pids' => [
4633             {
4634             'pid' => Stream PID
4635             'pidtype' => pid type (i.e. 'audio', 'video', 'subtitle')
4636             },
4637             ...
4638             ]
4639             'offset' => offset time for this file
4640             'duration' => duration for this file
4641              
4642             'destfile' => final written file name (set by L)
4643             'warnings' => [
4644             ARRAY ref of list of warnings (set by L)
4645             ],
4646             'errors' => [
4647             ARRAY ref of list of errors (set by L)
4648             ],
4649             'lines' => [
4650             ARRAY ref of lines of output from the transcode/demux operation(s) (set by L)
4651             ],
4652             },
4653             },
4654             duration => maximum recording duration in seconds
4655             tsid => the multiplex id
4656              
4657             where there is an entry for each file, each entry containing a recording duration (in seconds),
4658             an offset time (in seconds), and an array of pids that define the streams required for the file.
4659              
4660             After recording, the multiplex info HASH 'pids' information also contains:
4661              
4662             'pids' => [
4663             {
4664             'pid' => Stream PID
4665             'pidtype' => pid type (i.e. 'audio', 'video', 'subtitle')
4666              
4667             'pkts' => Number of recorded packets
4668             'errors' => Transport stream error count
4669             'overflows' => Count of DVBT buffer overflows during recording
4670             'timeslip_start_secs' => Number of seconds the recording start has been slipped by
4671             'timeslip_end_secs' => Number of seconds the recording end has been slipped by
4672             },
4673              
4674             =cut
4675              
4676             sub multiplex_info
4677             {
4678 0     0 1 0 my $self = shift ;
4679            
4680 0         0 return %{$self->{_multiplex_info}} ;
  0         0  
4681             }
4682              
4683             #----------------------------------------------------------------------------
4684              
4685             =item B
4686              
4687             Records the selected streams into their files. Note that the recorded files will
4688             be the specified name, but with the extension set to '.ts'. You can optionally then
4689             call L to transcode the files into the requested file format.
4690              
4691             =cut
4692              
4693             sub multiplex_record
4694             {
4695 0     0 1 0 my $self = shift ;
4696 0         0 my (%multiplex_info) = @_ ;
4697            
4698 0         0 my $error = 0 ;
4699              
4700 0 0       0 Linux::DVB::DVBT::prt_data("multiplex_record() : multiplex_info=", \%multiplex_info) if $DEBUG>=10 ;
4701              
4702             # process information ready for C code
4703 0         0 my @stats_fields = qw/errors overflows pkts timeslip_start_secs timeslip_end_secs/ ;
4704 0         0 my @multiplex_info ;
4705 0         0 foreach my $file (keys %{$multiplex_info{'files'}} )
  0         0  
4706             {
4707 0         0 my $href = {
4708             '_file' => $file,
4709             'pids' => [],
4710             } ;
4711            
4712 0         0 foreach my $field (@stats_fields)
4713             {
4714 0         0 $href->{$field} = {} ;
4715             }
4716              
4717             # copy scalars
4718             #
4719 0         0 foreach (qw/offset duration destfile/)
4720             {
4721 0   0     0 $href->{$_} = $multiplex_info{'files'}{$file}{$_} || 0 ;
4722             }
4723            
4724            
4725             # copy service_id (i.e. pnr)
4726 0         0 foreach my $demux_href (@{$multiplex_info{'files'}{$file}{'demux'}})
  0         0  
4727             {
4728 0 0 0     0 if (exists($demux_href->{'demux_params'}) && $demux_href->{'demux_params'})
4729             {
4730 0         0 $href->{'pnr'} = $demux_href->{'demux_params'}{'pnr'} ;
4731             }
4732             }
4733            
4734             ## Set event information
4735             ##
4736 0         0 foreach (qw/event_id timeslip_start timeslip_end max_timeslip/)
4737             {
4738 0   0     0 $href->{$_} = $multiplex_info{'files'}{$file}{$_} || 0 ;
4739             }
4740            
4741             # placeholder in case we need to record to intermediate .ts file
4742 0         0 $multiplex_info{'files'}{$file}{'tsfile'} = "" ;
4743            
4744             # if file type is .ts, then leave everything; otherwise save the requested file name
4745             # and change source filename to .ts
4746 0         0 my ($name, $destdir, $suffix) = fileparse($multiplex_info{'files'}{$file}{'destfile'}, '\..*');
4747 0 0       0 print STDERR " + dest=$multiplex_info{'files'}{$file}{'destfile'} : name=$name dir=$destdir ext=$suffix\n" if $DEBUG>=10 ;
4748 0 0       0 if (lc $suffix ne '.ts')
4749             {
4750             # modify destination so that we record to it
4751 0         0 $href->{'destfile'} = "$destdir$name.ts" ;
4752            
4753             # report intermediate file
4754 0         0 $multiplex_info{'files'}{$file}{'tsfile'} = "$destdir$name.ts" ;
4755              
4756 0 0       0 print STDERR " + + mod extension\n" if $DEBUG>=10 ;
4757             }
4758              
4759             # fill in the pid info
4760 0         0 foreach my $pid_href (@{$multiplex_info{'files'}{$file}{'pids'}})
  0         0  
4761             {
4762 0         0 my $pid = $pid_href->{'pid'} ;
4763 0         0 push @{$href->{'pids'}}, $pid ;
  0         0  
4764            
4765 0         0 foreach my $field (@stats_fields)
4766             {
4767 0         0 $href->{$field}{$pid} = 0 ;
4768             }
4769             }
4770 0         0 push @multiplex_info, $href ;
4771            
4772             # check directory exists
4773 0 0       0 if (! -d $destdir)
4774             {
4775 0 0       0 mkpath([$destdir], $DEBUG, 0755) or return $self->handle_error("Error: unable to create directory \"$destdir\" : $!") ;
4776             }
4777            
4778             # make sure we can write file
4779 0         0 my $destfile = $href->{'destfile'} ;
4780 0 0       0 open my $fh, ">$destfile" or return $self->handle_error("Error: unable to write to file \"$destfile\" : $!") ;
4781 0         0 close $fh ;
4782             }
4783              
4784 0 0       0 Linux::DVB::DVBT::prt_data(" + info=", \@multiplex_info) if $DEBUG>=10 ;
4785              
4786             ## @multiplex_info = (
4787             # {
4788             # destfile => recorded ts file
4789             # pids => [
4790             # pid,
4791             # pid,
4792             # ...
4793             # ]
4794             #
4795             # }
4796             #
4797             # )
4798              
4799             ## do the recordings
4800 0         0 my $options_href = {} ;
4801 0 0       0 if (exists($multiplex_info{'options'}))
4802             {
4803 0         0 $options_href = $multiplex_info{'options'} ;
4804             }
4805 0         0 $error = dvb_record_demux($self->{dvb}, \@multiplex_info, $options_href) ;
4806 0 0       0 return $self->handle_error(dvb_error_str()) if $error ;
4807              
4808 0 0       0 Linux::DVB::DVBT::prt_data(" + returned info=", \@multiplex_info) if $DEBUG ;
4809            
4810             ## Pass error counts back
4811             ## @multiplex_info = (
4812             # {
4813             # destfile => recorded ts file
4814             # pids => [
4815             # pid1,
4816             # pid2,
4817             # ...
4818             # ],
4819             # errors => {
4820             # pid1 => error_count1,
4821             # pid2 => error_count2,
4822             # ...
4823             # }
4824             # overflows => {
4825             # pid1 => overflow_count1,
4826             # pid2 => overflow_count2,
4827             # ...
4828             # }
4829             # pkts => {
4830             # pid1 => packet_count1,
4831             # pid2 => packet_count2,
4832             # ...
4833             # }
4834             #
4835             # }
4836             #
4837             # )
4838 0         0 foreach my $href (@multiplex_info)
4839             {
4840 0 0       0 Linux::DVB::DVBT::prt_data(" + + href=", $href) if $DEBUG ;
4841 0         0 my $file = $href->{'_file'} ;
4842             #files => {
4843             # $file => {
4844             # 'pids' => [
4845             # {
4846             # 'pid' => Stream PID
4847             # 'pidtype' => pid type (i.e. 'audio', 'video', 'subtitle')
4848             # },
4849             # ...
4850             # ]
4851 0         0 foreach my $pid_href (@{$multiplex_info{'files'}{$file}{'pids'}})
  0         0  
4852             {
4853 0         0 my $pid = $pid_href->{'pid'} ;
4854             #print STDERR " - PID $pid (file=$file)\n" ;
4855              
4856 0         0 foreach my $field (@stats_fields)
4857             {
4858 0         0 $pid_href->{$field} = 0 ;
4859 0 0       0 if (exists($href->{$field}{$pid}))
4860             {
4861 0         0 $pid_href->{$field} = $href->{$field}{$pid} ;
4862             }
4863             }
4864             }
4865             }
4866            
4867 0         0 return $error ;
4868             }
4869              
4870              
4871             #----------------------------------------------------------------------------
4872              
4873             =item B
4874              
4875             Transcodes the recorded files into the requested formats (uses ffmpeg helper module).
4876              
4877             If the destination file format is the same as the recorded format (i.e. transport file)
4878             then no transcoding is performed, but a check is made to ensure the file duration is correct.
4879              
4880             Sets the following fields in the %multiplex_info HASH:
4881              
4882             $file => {
4883              
4884             ...
4885              
4886             'destfile' => final written file name
4887             'warnings' => [
4888             ARRAY ref of list of warnings
4889             ],
4890             'errors' => [
4891             ARRAY ref of list of errors
4892             ],
4893             'lines' => [
4894             ARRAY ref of lines of output from the transcode/demux operation(s)
4895             ],
4896             }
4897              
4898             See L for further details.
4899              
4900             =cut
4901              
4902             sub multiplex_transcode
4903             {
4904 0     0 1 0 my $self = shift ;
4905 0         0 my (%multiplex_info) = @_ ;
4906              
4907 0 0       0 Linux::DVB::DVBT::prt_data("multiplex_transcode() : multiplex_info=", \%multiplex_info) if $DEBUG>=10 ;
4908            
4909 0         0 my $error = 0 ;
4910 0         0 my @errors ;
4911            
4912             ## keep track of each filename as it is written, so we don't overwrite anything
4913             my %written_files ;
4914            
4915             ## process each file
4916 0         0 foreach my $file (keys %{$multiplex_info{'files'}})
  0         0  
4917             {
4918 0 0       0 Linux::DVB::DVBT::prt_data("Call ts_transcode for file=$file with : info=", $multiplex_info{'files'}{$file}) if $DEBUG>=10 ;
4919              
4920             # run ffmpeg (or just do video duration check)
4921             $error = Linux::DVB::DVBT::Ffmpeg::ts_transcode(
4922             # $multiplex_info{'files'}{$file}{'destfile'},
4923             # $multiplex_info{'files'}{$file}{'_destfile'},
4924             $multiplex_info{'files'}{$file}{'tsfile'},
4925             $multiplex_info{'files'}{$file}{'destfile'},
4926 0         0 $multiplex_info{'files'}{$file},
4927             \%written_files) ;
4928            
4929             # collect all errors together
4930 0 0       0 if ($error)
4931             {
4932 0         0 push @errors, "FILE: $file" ;
4933 0         0 push @errors, @{$multiplex_info{'files'}{$file}{'errors'}} ;
  0         0  
4934             }
4935             }
4936            
4937             # handle all errors in one go
4938 0 0       0 if (@errors)
4939             {
4940 0         0 $error = join "\n", @errors ;
4941 0         0 return $self->handle_error($error) ;
4942             }
4943 0         0 return $error ;
4944             }
4945              
4946              
4947             #============================================================================================
4948              
4949             =back
4950              
4951             =head3 DEBUG UTILITIES
4952              
4953             =over 4
4954              
4955             =cut
4956              
4957             #============================================================================================
4958              
4959              
4960             =item B
4961              
4962             Print out each item in the list, showing HASH hierarchies. Handles scalars,
4963             hashes (as an array), arrays, ref to scalar, ref to hash, ref to array, object.
4964              
4965             Useful for debugging.
4966              
4967             =cut
4968              
4969              
4970             #=====================================================================
4971             # MODULE USAGE
4972             #=====================================================================
4973             #
4974              
4975              
4976             #---------------------------------------------------------------------
4977             sub _setup_modules
4978             {
4979             # Attempt to load Debug object
4980 10 50   10   19 if (_load_module('Debug::DumpObj'))
4981             {
4982             # Create local function
4983 0     0   0 *prt_data = sub {print STDERR Debug::DumpObj::prtstr_data(@_)} ;
  0         0  
4984             }
4985             else
4986             {
4987             # See if we've got Data Dummper
4988 10 50       37 if (_load_module('Data::Dumper'))
4989             {
4990             # Create local function
4991 10     0   11939 *prt_data = sub {print STDERR Data::Dumper->Dump([@_])} ;
  0         0  
4992             }
4993             else
4994             {
4995             # Create local function
4996 0     0   0 *prt_data = sub {print STDERR @_, "\n"} ;
  0         0  
4997             }
4998             }
4999              
5000             }
5001              
5002             #---------------------------------------------------------------------
5003             sub _load_module
5004             {
5005 20     20   43 my ($mod) = @_ ;
5006            
5007 20         25 my $ok = 1 ;
5008              
5009             # see if we can load up the package
5010 20 100       1149 if (eval "require $mod")
5011             {
5012 10         387 $mod->import() ;
5013             }
5014             else
5015             {
5016             # Can't load package
5017 10         23 $ok = 0 ;
5018             }
5019 20         93 return $ok ;
5020             }
5021              
5022              
5023             # ============================================================================================
5024             BEGIN {
5025             # Debug only
5026 10     10   36 _setup_modules() ;
5027             }
5028              
5029              
5030             #============================================================================================
5031              
5032             =back
5033              
5034             =head3 INTERNAL METHODS
5035              
5036             =over 4
5037              
5038             =cut
5039              
5040             #============================================================================================
5041              
5042              
5043             #-----------------------------------------------------------------------------
5044              
5045             =item B
5046              
5047             I
5048              
5049             Initialise the hardware (create dvb structure). Called once and sets the adpater &
5050             frontend number for this object.
5051              
5052             If no adapter number has been specified yet then use the first device in the list.
5053              
5054             =cut
5055              
5056             sub hwinit
5057             {
5058 0     0 1 0 my $self = shift ;
5059              
5060 0         0 my $info_aref = $self->devices() ;
5061              
5062             ## Check for special adapter:frontend specification
5063 0 0       0 if (defined($self->adapter))
5064             {
5065 0         0 my ($adap, $fe) = split(/:/, $self->adapter) ;
5066 0 0       0 $self->adapter_num($adap) if defined($adap) ;
5067 0 0       0 $self->frontend_num($fe) if defined($fe) ;
5068             }
5069              
5070              
5071             # If no adapter set, use first in list
5072 0 0       0 if (!defined($self->adapter_num))
5073             {
5074             # use first device found
5075 0 0       0 if (scalar(@$info_aref))
5076             {
5077             $self->set(
5078             'adapter_num' => $info_aref->[0]{'adapter_num'},
5079 0         0 'frontend_num' => $info_aref->[0]{'frontend_num'},
5080             ) ;
5081 0         0 $self->_device_index(0) ;
5082             }
5083             else
5084             {
5085 0         0 return $self->handle_error("Error: No adapters found to initialise") ;
5086             }
5087             }
5088            
5089             # If no frontend set, use first in list
5090 0 0       0 if (!defined($self->frontend_num))
5091             {
5092             # use first frontend found
5093 0 0       0 if (scalar(@$info_aref))
5094             {
5095 0         0 my $adapter = $self->adapter_num ;
5096 0         0 my $dev_idx=0;
5097 0         0 foreach my $device_href (@$info_aref)
5098             {
5099 0 0       0 if ($device_href->{'adapter_num'} == $adapter)
5100             {
5101 0         0 $self->frontend_num($device_href->{'frontend_num'}) ;
5102 0         0 $self->_device_index($dev_idx) ;
5103 0         0 last ;
5104             }
5105 0         0 ++$dev_idx ;
5106             }
5107             }
5108             else
5109             {
5110 0         0 return $self->handle_error("Error: No adapters found to initialise") ;
5111             }
5112             }
5113            
5114             ## ensure device exists
5115 0 0       0 if (!defined($self->_device_index))
5116             {
5117 0         0 my $adapter = $self->adapter_num ;
5118 0         0 my $fe = $self->frontend_num ;
5119 0         0 my $dev_idx=0;
5120 0         0 foreach my $device_href (@$info_aref)
5121             {
5122 0 0 0     0 if ( ($device_href->{'adapter_num'} == $adapter) && ($device_href->{'frontend_num'} == $fe) )
5123             {
5124 0         0 $self->_device_index($dev_idx) ;
5125 0         0 last ;
5126             }
5127 0         0 ++$dev_idx ;
5128             }
5129 0 0       0 if (!defined($self->_device_index))
5130             {
5131 0         0 return $self->handle_error("Error: Specified adapter ($adapter) and frontend ($fe) does not exist") ;
5132             }
5133             }
5134            
5135             ## set info ref
5136 0         0 my $dev_idx = $self->_device_index() ;
5137 0         0 $self->_device_info($info_aref->[$dev_idx]) ;
5138            
5139             # Create DVB
5140 0         0 my $dvb = dvb_init_nr($self->adapter_num, $self->frontend_num) ;
5141 0         0 $self->dvb($dvb) ;
5142              
5143             # get & set the device names
5144 0         0 my $names_href = dvb_device_names($dvb) ;
5145 0         0 $self->set(%$names_href) ;
5146            
5147             # Set adapter
5148 0         0 $self->adapter( sprintf("%d:%d", $self->adapter_num, $self->frontend_num) ) ;
5149            
5150             }
5151              
5152             #----------------------------------------------------------------------------
5153              
5154             =item B
5155              
5156             I
5157              
5158             Add the error message to the error log. Get the log as an ARRAY ref via the 'errors()' method
5159              
5160             =cut
5161              
5162             sub log_error
5163             {
5164 6     6 1 5 my $self = shift ;
5165 6         5 my ($error_message) = @_ ;
5166            
5167 6         5 push @{$self->errors()}, $error_message ;
  6         41  
5168            
5169             }
5170              
5171             #-----------------------------------------------------------------------------
5172              
5173             =item B
5174              
5175             Returns true if the DVB tuner has been closed (or failed to open).
5176              
5177             =cut
5178              
5179             sub dvb_closed
5180             {
5181 0     0 1 0 my $self = shift ;
5182              
5183 0         0 return !$self->{dvb} ;
5184             }
5185              
5186              
5187             #-----------------------------------------------------------------------------
5188             # return current (or create new) file entry in multiplex_info
5189             sub _multiplex_file_href
5190             {
5191 0     0   0 my $self = shift ;
5192 0         0 my ($file) = @_ ;
5193            
5194 0   0     0 $self->{_multiplex_info}{'files'}{$file} ||= {
5195              
5196             # start with this being the same as the requested filename
5197             'destfile' => $file,
5198            
5199             # init
5200             'offset' => 0,
5201             'duration' => 0,
5202             'title' => '',
5203             'warnings' => [],
5204             'errors' => [],
5205             'lines' => [],
5206             'demux' => [],
5207              
5208             # beta: title
5209             'title' => '',
5210             } ;
5211 0         0 my $href = $self->{_multiplex_info}{'files'}{$file} ;
5212              
5213 0         0 return $href ;
5214             }
5215              
5216             #-----------------------------------------------------------------------------
5217             # Add in the required SI tables to any recording that requires it OR if the 'add_si'
5218             # option is set
5219             sub _add_required_si
5220             {
5221 0     0   0 my $self = shift ;
5222 0         0 my ($tsid) = @_ ;
5223 0         0 my $error ;
5224              
5225             # get flag
5226 0         0 my $force_si = $self->{'add_si'} ;
5227              
5228             # set tsid if not already set
5229 0   0     0 $self->{_multiplex_info}{'tsid'} ||= $tsid ;
5230              
5231 0 0       0 print STDERR "_add_required_si(tsid=$tsid, force=$force_si)\n" if $DEBUG>=10 ;
5232 0 0       0 prt_data("current mux info=", $self->{_multiplex_info}) if $DEBUG>=15 ;
5233            
5234 0         0 foreach my $file (keys %{$self->{_multiplex_info}{'files'}})
  0         0  
5235             {
5236 0         0 my $add_si = $force_si ;
5237              
5238             ## get entry for this file (or create it)
5239 0         0 my $href = $self->_multiplex_file_href($file) ;
5240            
5241             ## check pids looking for non-audio/video (get pnr for later)
5242 0         0 my $demux_params_href ;
5243             my %pids ;
5244 0         0 foreach my $demux_href (@{$self->{_multiplex_info}{'files'}{$file}{'demux'}})
  0         0  
5245             {
5246             # keep track of the pids scheduled
5247 0         0 ++$pids{ $demux_href->{'pid'} } ;
5248            
5249             # get HASH ref to program's demux params
5250 0 0       0 $demux_params_href = $demux_href->{'demux_params'} if ($demux_href->{'demux_params'}) ;
5251              
5252             # see if non-av
5253 0 0 0     0 if ( ($demux_href->{'pidtype'} ne 'audio') && ($demux_href->{'pidtype'} ne 'video') )
5254             {
5255 0         0 ++$add_si ;
5256             }
5257             }
5258              
5259 0         0 my $pmt = $demux_params_href->{'pmt'} ;
5260 0         0 my $pcr = $demux_params_href->{'pcr'} ;
5261 0 0       0 print STDERR " + file=$file : add=$add_si pmt=$pmt pcr=$pcr\n" if $DEBUG>=10 ;
5262 0 0       0 prt_data("demux_params_href=", $demux_params_href) if $DEBUG>=10 ;
5263 0 0       0 prt_data("scheduled PIDS==", \%pids) if $DEBUG>=10 ;
5264              
5265             ## Add tables if necessary (and possible!)
5266 0 0       0 if ($add_si)
5267             {
5268 0 0       0 if (!$pmt)
5269             {
5270 0         0 $error = "Unable to determine PMT pid (have you re-scanned with this latest version?)" ;
5271 0         0 return $self->handle_error($error) ;
5272             }
5273             else
5274             {
5275 0         0 foreach my $pid_href (
5276             { 'pidtype' => 'PAT', 'pid' => $SI_TABLES{'PAT'}, },
5277             # { 'pidtype' => 'SDT', 'pid' => $SI_TABLES{'SDT'}, },
5278             # { 'pidtype' => 'TDT', 'pid' => $SI_TABLES{'TDT'}, },
5279             { 'pidtype' => 'PMT', 'pid' => $pmt, },
5280             { 'pidtype' => 'PCR', 'pid' => $pcr, },
5281             )
5282             {
5283 0 0       0 print STDERR " + pid=$pid_href->{'pid'} pidtype=$pid_href->{'pidtype'}\n" if $DEBUG>=10 ;
5284              
5285             # skip any already scheduled
5286 0 0       0 next unless defined($pid_href->{'pid'}) ;
5287 0 0       0 next if exists($pids{ $pid_href->{'pid'} }) ;
5288            
5289 0 0       0 print STDERR " + check defined..\n" if $DEBUG>=10 ;
5290 0 0       0 next unless defined($pid_href->{'pid'}) ;
5291              
5292 0 0       0 print STDERR " + add filter..\n" if $DEBUG>=10 ;
5293            
5294             # add filter
5295 0         0 $error = $self->add_demux_filter($pid_href->{'pid'}, $pid_href->{'pidtype'}, $tsid, $demux_params_href) ;
5296 0 0       0 return $self->handle_error($error) if $error ;
5297            
5298             # keep demux filter info
5299 0         0 push @{$href->{'demux'}}, $self->{_demux_filters}[-1] ;
  0         0  
5300             }
5301             }
5302             }
5303             }
5304              
5305 0 0       0 prt_data("final mux info=", $self->{_multiplex_info}) if $DEBUG>=15 ;
5306            
5307 0         0 return $error ;
5308             }
5309              
5310              
5311             #-----------------------------------------------------------------------------
5312             # Ensure that the multiplex_info HASH is up to date (pids match the demux list)
5313             sub _update_multiplex_info
5314             {
5315 0     0   0 my $self = shift ;
5316 0         0 my ($tsid) = @_ ;
5317              
5318 0   0     0 $self->{_multiplex_info}{'tsid'} ||= $tsid ;
5319            
5320 0         0 foreach my $file (keys %{$self->{_multiplex_info}{'files'}})
  0         0  
5321             {
5322 0         0 $self->{_multiplex_info}{'files'}{$file}{'pids'} = [] ;
5323            
5324             # fill in the pid info
5325 0         0 foreach my $demux_href (@{$self->{_multiplex_info}{'files'}{$file}{'demux'}})
  0         0  
5326             {
5327 0         0 push @{$self->{_multiplex_info}{'files'}{$file}{'pids'}}, {
5328             'pid' => $demux_href->{'pid'},
5329 0         0 'pidtype' => $demux_href->{'pidtype'},
5330             } ;
5331             }
5332             }
5333             }
5334              
5335             #-----------------------------------------------------------------------------
5336             # Check to see if pid is an SI table
5337             sub _si_pid
5338             {
5339 0     0   0 my $self = shift ;
5340 0         0 my ($pid, $tsid, $pmt) = @_ ;
5341 0         0 my $pid_href ;
5342              
5343             # check for SI
5344 0 0       0 if (exists($SI_LOOKUP{$pid}))
5345             {
5346             $pid_href = {
5347             'tsid' => $tsid,
5348 0         0 'pidtype' => $SI_LOOKUP{$pid},
5349             'pmt' => 1,
5350             } ;
5351             }
5352              
5353            
5354             # if not found & pnr specified, see if it's PMT
5355 0 0 0     0 if (!$pid_href && $pmt)
5356             {
5357 0         0 $pid_href = {
5358             'tsid' => $tsid,
5359             'pidtype' => 'PMT',
5360             'pmt' => $pmt,
5361             } ;
5362             }
5363              
5364 0         0 return $pid_href ;
5365             }
5366              
5367             #-----------------------------------------------------------------------------
5368             sub _no_once_warning
5369             {
5370 0     0   0 return \%Linux::DVB::DVBT::Constants::CONSTANTS ;
5371             }
5372              
5373             # ============================================================================================
5374              
5375             sub AUTOLOAD
5376             {
5377 66     66   12209 my $this = shift;
5378              
5379 66         57 my $name = $AUTOLOAD;
5380 66         210 $name =~ s/.*://; # strip fully-qualified portion
5381 66         61 my $class = $AUTOLOAD;
5382 66         180 $class =~ s/::[^:]+$//; # get class
5383              
5384 66         69 my $type = ref($this) ;
5385            
5386             # possibly going to set a new value
5387 66         39 my $set=0;
5388 66         54 my $new_value = shift;
5389 66 100       101 $set = 1 if defined($new_value) ;
5390            
5391             # 1st see if this is of the form undef_
5392 66 50       94 if ($name =~ m/^undef_(\w+)$/)
5393             {
5394 0         0 $set = 1 ;
5395 0         0 $name = $1 ;
5396 0         0 $new_value = undef ;
5397             }
5398              
5399             # check for valid field
5400 66 50       110 unless (exists($FIELDS{$name}))
5401             {
5402 0         0 croak "Error: Attempting to access invalid field $name on $class";
5403             }
5404              
5405             # ok to get/set
5406 66         61 my $value = $this->{$name};
5407              
5408 66 100       109 if ($set)
5409             {
5410 43         69 $this->{$name} = $new_value ;
5411             }
5412              
5413             # Return previous value
5414 66         117 return $value ;
5415             }
5416              
5417              
5418              
5419             # ============================================================================================
5420             # END OF PACKAGE
5421             1;
5422              
5423             __END__