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__