File Coverage

blib/lib/Video/CPL/AnnotationList.pm
Criterion Covered Total %
statement 49 66 74.2
branch 4 16 25.0
condition n/a
subroutine 9 12 75.0
pod 3 6 50.0
total 65 100 65.0


line stmt bran cond sub pod time code
1             package Video::CPL::AnnotationList;
2              
3 1     1   4 use warnings;
  1         1  
  1         28  
4 1     1   3 use strict;
  1         1  
  1         23  
5 1     1   3 use Carp;
  1         1  
  1         41  
6 1     1   4 use Data::Dumper;
  1         0  
  1         33  
7 1     1   3 use XML::Writer;
  1         1  
  1         18  
8              
9 1     1   3 use Video::CPL::Annotation;
  1         1  
  1         416  
10              
11             =head1 NAME
12              
13             Video::CPL::AnnotationList - Manages a list of Annotation objects. Generally invoked by other Video::CPL modules.
14              
15             =head1 VERSION
16              
17             Version 0.09
18              
19             =cut
20              
21             our $VERSION = '0.09';
22              
23             =head1 SYNOPSIS
24              
25             Video::CPL::AnnotationList is normally called by Video::CPL.pm. If need be it can be
26             called directly to create or modify Video::CPL::AnnotationList objects.
27              
28             =head1 METHODS
29              
30             =cut
31              
32             our @FIELDS = qw(target);
33              
34 0 0   0 0 0 sub target { my $obj = shift; $obj->{target} = shift if @_; return $obj->{target};};
  0         0  
  0         0  
35              
36             =head2 new()
37              
38             Create a new AnnotationList object.
39              
40             =cut
41              
42             sub new {
43 2     2 1 4 my $pkg = shift;
44 2         3 my %parms = @_;
45 2         2 my $ret = {};
46 2         3 bless $ret,$pkg;
47              
48 2         3 foreach my $x (@FIELDS){
49 2 50       9 $ret->{$x} = $parms{$x} if defined $parms{$x};
50             }
51 2         5 foreach my $x (keys %parms){
52 2 50       5 confess("Parameter ('$x') given to Video::CPL::AnnotationList::new, but not understood\n") if !defined $ret->{$x};
53             }
54              
55 2         8 return $ret;
56             }
57              
58             sub pusht {
59 0     0 0 0 my $obj = shift;
60 0         0 my $t = shift;
61 0 0       0 if (defined $obj->{target}){
62 0         0 push @{$obj->{target}},$t;
  0         0  
63             } else {
64 0         0 $obj->{target} = [$t];
65             }
66             }
67              
68             =head2 xmlo
69            
70             Given an XML::Writer object, add the xml information for this AnnotationList.
71              
72             =cut
73              
74             sub xmlo {
75 1     1 1 1 my $obj = shift;
76 1         4 my $xo = shift;
77 1         2 my %p;
78 1         2 foreach my $x (@FIELDS){
79 1 50       4 next if $x eq "target";
80 0 0       0 $p{$x} = $obj->{$x} if defined $obj->{$x};
81             }
82 1         4 $xo->startTag("annotationList",%p);
83 1         19 foreach my $c (@{$obj->{target}}){ #if we are a targetList we must have target
  1         3  
84 1         5 $c->xmlo($xo);
85             }
86 1         34 $xo->endTag("annotationList");
87             }
88              
89             =head2 xml()
90              
91             Return the xml format of a AnnotationList object.
92              
93             =cut
94              
95             sub xml {
96 0     0 1 0 my $obj = shift;
97 0         0 my $a;
98 0         0 my $xo = new XML::Writer(OUTPUT=>\$a);
99 0         0 $obj->xmlo($xo);
100 0         0 $xo->end();
101 0         0 return $a;
102             }
103              
104             sub fromxml {
105 1     1 0 1 my $s = shift;
106 1         1 my %s = %{$s};
  1         3  
107 1         1 my %parms;
108 1         3 foreach my $q (@FIELDS){
109 1 50       2 next if $q eq "target";
110 0 0       0 $parms{$q} = $s{$q} if defined($s{$q});
111             }
112             #process targets
113 1         2 my @t;
114 1         1 foreach my $x (@{$s{target}}){
  1         3  
115 1         3 push @t,Video::CPL::Target::fromxml($x);
116             }
117 1         2 $parms{target} = \@t;
118 1         6 return new Video::CPL::AnnotationList(%parms);
119             }
120              
121             =head1 AUTHOR
122              
123             Carl Rosenberg, C<< >>
124              
125             =head1 BUGS
126              
127             Please report any bugs or feature requests to Coincident TV.
128              
129             =head1 SUPPORT
130              
131             You can find documentation for this module with the perldoc command.
132              
133             =head1 LICENSE AND COPYRIGHT
134              
135             Copyright 2010 Coincident TV
136              
137             Licensed under the Apache License, Version 2.0 (the "License");
138             you may not use this file except in compliance with the License.
139             You may obtain a copy of the License at
140              
141             http://www.apache.org/licenses/LICENSE-2.0
142              
143             Unless required by applicable law or agreed to in writing, software
144             distributed under the License is distributed on an "AS IS" BASIS,
145             WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
146             See the License for the specific language governing permissions and
147             limitations under the License.
148              
149             =cut
150              
151             1;