File Coverage

blib/lib/DVB/Carousel.pm
Criterion Covered Total %
statement 74 75 98.6
branch 11 18 61.1
condition 1 3 33.3
subroutine 13 13 100.0
pod 7 7 100.0
total 106 116 91.3


line stmt bran cond sub pod time code
1             package DVB::Carousel;
2              
3             =head1 NAME
4              
5             DVB::Carousel - Handling of simple DVB carousel database used by ringelspiel.
6              
7             =head1 SYNOPSIS
8              
9             Add, delete and list MPEG-2 transport streams chunks in a carousel playout system.
10              
11             use DVB::Carousel;
12              
13             my $myCarousel = DVB::Carousel->new( 'databasefile');
14              
15             # initialize the basic databse table structure
16             $myCarousel->initdb();
17              
18             # add file to carousel by pid 12 with repetition rate 2000 ms
19             $myCarousel->addFile( 12, "nit.ts", 2000);
20              
21             # add some binary data to carousel by pid 16 with repetition rate 30 s
22             my $data = generateSomeData();
23             $myCarousel->addMts( 16, \$data, 30000);
24              
25             # delete carousel data with pid 16
26             $myCarousel->deleteData( 16);
27              
28             =head1 CLASS C
29              
30             =head2 METHODS
31              
32             =cut
33              
34 1     1   95620 use warnings;
  1         3  
  1         57  
35 1     1   8 use strict;
  1         3  
  1         97  
36 1     1   11432 use DBI qw(:sql_types);
  1         53390  
  1         629  
37 1     1   12 use Carp;
  1         9  
  1         80  
38 1     1   5 use Exporter;
  1         2  
  1         42  
39 1     1   5 use vars qw($VERSION @ISA @EXPORT);
  1         2  
  1         1206  
40              
41             our $VERSION = "0.22";
42             our @ISA = qw(Exporter);
43             our @EXPORT = qw();
44              
45             =head3 new( $dbfile )
46              
47             Class initialization with sqlite3 database filename.
48             Open existing or create new sqlite database.
49              
50             =cut
51              
52             sub new {
53 1     1 1 181 my $this = shift;
54 1   33     9 my $class = ref($this) || $this;
55 1         3 my $self = {};
56              
57 1         5 $self->{filename} = shift;
58 1 50       12 $self->{dbh} = DBI->connect( "dbi:SQLite:" . $self->{filename} )
59             or return -1;
60              
61 1         14158 $self->{dbh}->do( " PRAGMA synchronous = OFF;
62             PRAGMA temp_store = MEMORY;
63             PRAGMA auto_vacuum = NONE;
64             PRAGMA journal_mode = OFF;
65             PRAGMA cache_size = 4000000;");
66              
67 1         390 bless( $self, $class );
68 1         10 return $self;
69             }
70              
71             =head3 initdb( )
72              
73             Initialize database with some basic table structure;
74             This service can then be played multiple times with different service_id.
75             Therefore service_id is used when building sections and referencing data in sections.
76              
77             =cut
78              
79             sub initdb {
80 1     1 1 3 my $self = shift;
81 1         2 my $dbh = $self->{dbh};
82              
83 1         7 $dbh->do("BEGIN TRANSACTION");
84              
85 1         97 $dbh->do( "DROP TABLE IF EXISTS carousel");
86              
87 1         217 $dbh->do( "DROP TABLE IF EXISTS journal");
88              
89 1         86 $dbh->do(
90             "CREATE TABLE carousel ( pid INTEGER,
91             interval INTEGER,
92             mts BLOB,
93             timestamp DATE,
94             PRIMARY KEY( pid))"
95             );
96            
97 1         1025 $dbh->do(
98             "CREATE TABLE journal ( id INTEGER PRIMARY KEY AUTOINCREMENT);"
99             );
100              
101             # define triggers to trap changes in list of transport streams and update the
102             # journal table.
103             # This table is used by the playout system to re-read the list of transport
104             # streams to play
105 1         264 $dbh->do(
106             "CREATE TRIGGER journal_carousel_insert
107             BEFORE INSERT ON carousel WHEN (SELECT count(*) FROM carousel WHERE pid=new.pid) = 0
108             BEGIN
109             INSERT INTO journal VALUES( NULL);
110             END;"
111             );
112              
113 1         227 $dbh->do(
114             "CREATE TRIGGER journal_carousel_delete
115             AFTER DELETE ON carousel
116             BEGIN
117             INSERT INTO journal VALUES( NULL);
118             END;"
119             );
120              
121 1         170 $dbh->do(
122             "CREATE TRIGGER journal_carousel_pidchange
123             AFTER UPDATE OF pid ON carousel
124             BEGIN
125             INSERT INTO journal VALUES( NULL);
126             END;"
127             );
128              
129 1         182 $dbh->do(
130             "CREATE TRIGGER journal_carousel_cleaning
131             AFTER INSERT ON carousel
132             BEGIN
133             DELETE FROM journal WHERE id != (SELECT id FROM journal ORDER BY id DESC LIMIT 1);
134             END;"
135             );
136              
137             # define triggers that set timestamps on each update
138 1         223 $dbh->do(
139             "CREATE TRIGGER carousel_timestamp_insert
140             AFTER INSERT ON carousel
141             BEGIN
142             UPDATE carousel
143             SET timestamp = DATETIME('NOW')
144             WHERE pid = new.pid;
145             END;"
146             );
147 1         185 $dbh->do(
148             "CREATE TRIGGER carousel_timestamp_update
149             AFTER UPDATE ON carousel
150             BEGIN
151             UPDATE carousel
152             SET timestamp = DATETIME('NOW')
153             WHERE pid = new.pid;
154             END;"
155             );
156              
157 1 50       186 $dbh->do("COMMIT") or die("error creating database");
158              
159 1         280 return 1;
160             }
161              
162             =item addMts ( $pid, \$mts, $interval)
163              
164             Add/update MPEG-2 transport stream (MTS) binary data for $pid into carousel.
165             The MTS data consists of multiple packets each 188 bytes long.
166             Return 1 on success.
167              
168             =cut
169              
170             sub addMts {
171 3     3 1 6 my $self = shift;
172 3         7 my ( $pid, $mts, $interval ) = @_;
173 3         6 my $dbh = $self->{dbh};
174              
175 3 100       15 return if ( length($$mts) % 188 ) != 0;
176 2 50       7 return if length($$mts) == 0;
177              
178 2         21 my $insert = $dbh->prepare(
179             "INSERT or REPLACE INTO carousel
180             ( pid, interval, mts) VALUES ( $pid, $interval, ?)"
181             );
182              
183 2         338 $insert->bind_param( 1, $$mts, SQL_BLOB );
184 2         1137 return $insert->execute();
185             }
186              
187             =item addFile ( $pid, $fileName, $interval)
188              
189             Same as addMts () except getting MPEG-2 transport stream FROM file.
190              
191             =cut
192              
193             sub addFile {
194 1     1 1 3 my $self = shift;
195 1         3 my ( $pid, $fileName, $interval ) = @_;
196 1         3 my $dbh = $self->{dbh};
197 1         2 my $data;
198              
199 1 50       17 return if !-e $fileName;
200              
201 1 50       28 open( MTSFILE, "<$fileName" ) or return;
202 1         2 $data = do { local $/; };
  1         6  
  1         42  
203 1         10 close(MTSFILE);
204              
205 1 50       5 if ( length($data) > 0 ) {
206 1         4 return $self->addMts( $pid, \$data, $interval );
207             }
208             else {
209 0         0 return;
210             }
211             }
212              
213             =item deleteMts( $pid)
214              
215             Remove MTS data from carousel by $pid.
216             If $pid not defined, delete all.
217              
218             Return 1 on success.
219              
220             =cut
221              
222             sub deleteMts {
223 2     2 1 1655 my $self = shift;
224 2         5 my $pid = shift;
225 2         4 my $dbh = $self->{dbh};
226              
227 2 100       25 return $dbh->do( "DELETE FROM carousel WHERE 1"
228             . ( defined $pid ? " AND pid='" . $pid . "'" : "" ) );
229             }
230              
231             =item listMts( $pid)
232              
233             List information on MPEG-2 transport stream data in carousel.
234             $pid is an optional parameter used as selection filter.
235              
236             Return reference to an array of arrays of MTS consisting of pid,
237             repetition interval and timestamp of last update.
238              
239             =cut
240              
241             sub listMts {
242 2     2 1 576 my $self = shift;
243 2         4 my $pid = shift;
244 2         5 my $dbh = $self->{dbh};
245              
246 2 50       30 return $dbh->selectall_arrayref( "SELECT pid, interval, strftime('%s',timestamp) AS timestamp FROM carousel WHERE 1"
247             . ( defined $pid ? " AND pid=$pid" : "" )
248             . ( " ORDER BY pid"));
249             }
250              
251             =item getMts( $pid)
252              
253             Return reference to array of MPEG-2 transport stream data in carouselfor $pid.
254             The elements of array are pid, repetition interval, MTS binary data and
255             timestamp of last update.
256              
257             =cut
258              
259             sub getMts {
260 1     1 1 855 my $self = shift;
261 1         3 my $pid = shift;
262 1         2 my $dbh = $self->{dbh};
263              
264 1         14 my $sel = $dbh->selectrow_arrayref( "SELECT pid, interval, mts, strftime('%s',timestamp) FROM carousel WHERE pid=$pid");
265              
266 1         259 return $sel;
267             }
268             =head1 AUTHOR
269              
270             Bojan Ramsak, C<< >>
271              
272             =head1 BUGS
273              
274             Please report any bugs or feature requests to C, or through
275             the web interface at L. I will be notified, and then you'll
276             automatically be notified of progress on your bug as I make changes.
277              
278             =head1 SUPPORT
279              
280             You can find documentation for this module with the perldoc command.
281              
282             perldoc DVB::Carousel
283              
284             You can also look for information at:
285              
286             =head1 ACKNOWLEDGEMENTS
287              
288             =head1 LICENSE AND COPYRIGHT
289              
290             Copyright 2012 Bojan Ramsak.
291              
292             This program is free software; you can redistribute it and/or modify it
293             under the terms of either: the GNU General Public License as published
294             by the Free Software Foundation; or the Artistic License.
295              
296             See http://dev.perl.org/licenses/ for more information.
297              
298             =cut
299              
300             1; # End of DVB::Carousel