File Coverage

blib/lib/Video/CPL/Annotation.pm
Criterion Covered Total %
statement 82 123 66.6
branch 25 60 41.6
condition n/a
subroutine 18 27 66.6
pod 6 19 31.5
total 131 229 57.2


line stmt bran cond sub pod time code
1             package Video::CPL::Annotation;
2              
3 1     1   4 use warnings;
  1         1  
  1         24  
4 1     1   4 use strict;
  1         1  
  1         12  
5 1     1   3 use Carp;
  1         1  
  1         63  
6 1     1   6 use Data::Dumper;
  1         2  
  1         37  
7 1     1   3 use XML::Writer;
  1         1  
  1         18  
8              
9 1     1   344 use Video::CPL::Story;
  1         1  
  1         26  
10 1     1   326 use Video::CPL::Target;
  1         1  
  1         22  
11 1     1   385 use Video::CPL::TargetList;
  1         1  
  1         977  
12              
13             =head1 NAME
14              
15             Video::CPL::Annotation - Video::CPL::Annotation object.
16              
17             =head1 VERSION
18              
19             Version 0.09
20              
21             =cut
22              
23             our $VERSION = '0.09';
24              
25             =head1 SYNOPSIS
26              
27             Video::CPL::Annotate exists to create and manipulate Annotations. CPL.pm is moving towards including more
28             and more helper functions; eventually this routine should be most useful for accessor functions, to modify
29             or examine attributes.
30              
31             use Video::CPL::Annotation;
32             my $foo = Video::CPL::Annotation->new(name=>"alpha-tech",clickBehavior=>"goto",x=>772,y=>66,
33             story=>new Video::CPL::Story(pic=>"foo.png"));
34              
35             =head1 METHODS
36              
37             =cut
38              
39             our @FIELDS = qw(name clickBehavior x y skipOnReturn showIcon story ajs alpha targetList parent);
40             our @SIMPLEFIELDS = qw(name clickBehavior x y skipOnReturn showIcon ajs alpha);
41             our %COMPLEX = (story=>1,targetList=>1,parent=>1);
42              
43             #accessors: creating these dynamically in BEGIN has complications.
44 45 50   45 0 30 sub name { my $obj = shift; $obj->{name} = shift if @_; return $obj->{name}; }
  45         62  
  45         187  
45 2 50   2 0 2 sub clickBehavior { my $obj = shift; $obj->{clickBehavior} = shift if @_; return $obj->{clickBehavior}; }
  2         5  
  2         5  
46 2 50   2 0 4 sub x { my $obj = shift; $obj->{x} = shift if @_; return $obj->{x}; }
  2         5  
  2         6  
47 2 50   2 0 15 sub y { my $obj = shift; $obj->{y} = shift if @_; return $obj->{y}; }
  2         8  
  2         9  
48 2 50   2 0 5 sub skipOnReturn { my $obj = shift; $obj->{skipOnReturn} = shift if @_; return $obj->{skipOnReturn}; }
  2         7  
  2         10  
49 2 50   2 0 3 sub showIcon { my $obj = shift; $obj->{showIcon} = shift if @_; return $obj->{showIcon}; }
  2         5  
  2         8  
50 0 0   0 0 0 sub ajs { my $obj = shift; $obj->{ajs} = shift if @_; return $obj->{ajs}; }
  0         0  
  0         0  
51 16 50   16 0 15 sub story { my $obj = shift; $obj->{story} = shift if @_; return $obj->{story}; }
  16         19  
  16         34  
52             #proposed
53             #picLoc picOverLoc ballonText forever
54             #if present will create and add story
55 0     0 0 0 sub picLoc { my $obj = shift;
56 0 0       0 if (@_){
57 0 0       0 if ($obj->story()){
58 0         0 $obj->story()->picLoc(@_);
59             } else {
60 0         0 $obj->{story} = new Video::CPL::Story(picLoc=>@_);
61             }
62             } else {
63 0 0       0 return undef if !$obj->story();
64             }
65 0         0 return $obj->story()->picLoc();
66             }
67 0 0   0 0 0 sub alpha { my $obj = shift; $obj->{alpha} = shift if @_; return $obj->{alpha}; }
  0         0  
  0         0  
68 0 0   0 0 0 sub targetList { my $obj = shift; $obj->{targetList} = shift if @_; return $obj->{targetList}; }
  0         0  
  0         0  
69             #proposed: add
70             #target [accept array or scalar. Strings or cuePt. return array if wantarray else single target if only one else croak.]
71             #backgroundPicLoc
72             #operation
73             #headerText
74 0 0   0 0 0 sub parent { my $obj = shift; $obj->{parent} = shift if @_; return $obj->{parent}; }
  0         0  
  0         0  
75              
76             =head2 new(name=>"foo",click=>"goto",x=>23,y=>40)
77              
78             Creates a new Annotation object.
79              
80             =cut
81              
82             sub new {
83 2     2 1 3 my $pkg = shift;
84 2         16 my %p = @_;
85 2         5 my $ret = {};
86 2         5 bless $ret,$pkg;
87              
88 2 50       8 confess("new Annotation without parent\n") if !defined $p{parent};
89 2 50       9 $p{name} = $p{parent}->newname("anno") if !defined $p{name};
90 2         2 my %s;
91 2         6 foreach my $s (@Video::CPL::Story::FIELDS){
92 10 100       21 if (defined($p{$s})){
93 1         3 $s{$s} = $p{$s};
94 1         3 delete $p{$s};
95             }
96             }
97 2 100       10 $ret->{story} = new Video::CPL::Story(%s) if %s;
98 2 50       7 if (defined($p{target})){
99 0         0 $ret->{targetList} = new Video::CPL::TargetList(target=>[new Video::CPL::Target(cuePointRef=>$p{target})]);
100 0         0 delete $p{target};
101             }
102              
103 2         4 foreach my $x (@FIELDS){
104 22 100       65 $ret->{$x} = $p{$x} if defined $p{$x};
105             }
106 2         6 foreach my $x (keys %p){
107 18 50       28 confess("Parameter ('$x') given to Video::CPL::Annotation::new, but not understood\n") if !defined $ret->{$x};
108             }
109              
110 2         15 return $ret;
111             }
112              
113              
114             =head2 adjust(parm1=>val,parm2=>val,...)
115              
116             Change arbitrary fields within an Annotation point.
117              
118             =cut
119              
120             sub adjust {
121 0     0 1 0 my $obj = shift;
122 0         0 my %parms = @_;
123 0         0 foreach my $x (qw(name clickBehavior skipOnReturn showIcon alpha relative skip x y modal story )){
124 0 0       0 $obj->{$x} = $parms{$x} if defined($parms{$x});
125             }
126              
127 0         0 return $obj;
128             }
129              
130             =head2 fromxml()
131              
132             =cut
133              
134             sub fromxml{
135 1     1 1 2 my $parent = shift;
136 1         2 my $s = shift;
137 1         3 my %s = %{$s};
  1         8  
138 1         5 my %p = (parent=>$parent);
139 1         2 foreach my $k (@SIMPLEFIELDS){
140 8 100       17 $p{$k} = $s{$k} if defined($s{$k});
141             }
142 1 50       9 $p{story} = Video::CPL::Story::fromxml($s{story}[0]) if defined($s{story}[0]);
143 1 50       9 $p{targetList} = Video::CPL::TargetList::fromxml($s{targetList}[0]) if defined($s{targetList}[0]);
144 1         10 return new Video::CPL::Annotation(%p);
145             }
146              
147             =head2 xml()
148              
149             Return the text form of the Annotation. Usually called by Video::CPL::xml().
150              
151             =cut
152              
153             sub xmlo {
154             #given parent, add stuff to it and return.
155 1     1 0 1 my $obj = shift;
156 1         1 my $xo = shift;
157 1         1 my %p;
158 1         3 foreach my $x (@SIMPLEFIELDS){
159 8 100       17 $p{$x} = $obj->{$x} if defined($obj->{$x});
160             }
161 1         4 $xo->startTag("annotation",%p);
162 1 50       109 $obj->{story}->xmlo($xo) if defined $obj->{story};
163 1 50       69 $obj->{targetList}->xmlo($xo) if defined $obj->{targetList};
164 1         12 $xo->endTag("annotation");
165             }
166              
167             sub xml {
168 0     0 1   my $obj = shift;
169 0           my $a = "";
170 0           my $xo = new XML::Writer(OUTPUT=>\$a);
171 0           $obj->xmlo($xo);
172 0           $xo->end();
173 0           return $a;
174             }
175              
176             =head2 reffromobj($cplobj)
177              
178             =cut
179              
180             sub reffromobj {
181 0     0 1   my $obj = shift;
182 0           my $cpl = shift;
183 0 0         confess("Video::CPL::Annotation::reffromobj but no parent\n") if !defined($obj->{parent});
184 0 0         return $obj->{name} if $obj->parent() == $cpl;
185 0           my $ctvfile = $obj->parent()->{ctvfilename};
186 0           return "/$ctvfile\#$obj->{name}";
187             #TODO: support for CPL objects with a different domain, think about dynamic
188             }
189              
190             =head2 printref()
191              
192             Return a cuePointRef to this Annotation.
193              
194             =cut
195              
196             sub printref {
197 0     0 1   my $obj = shift;
198 0           my $name = $obj->{name};
199 0           return "\n";
200             }
201              
202             =head1 AUTHOR
203              
204             Carl Rosenberg, C<< >>
205              
206             =head1 BUGS
207              
208             Please report any bugs or feature requests to Coincident TV.
209              
210             =head1 SUPPORT
211              
212             You can find documentation for this module with the perldoc command.
213              
214             perldoc Video::CPL::Annotation
215              
216              
217             =head1 LICENSE AND COPYRIGHT
218              
219             Copyright 2010 Coincident TV
220              
221             Licensed under the Apache License, Version 2.0 (the "License");
222             you may not use this file except in compliance with the License.
223             You may obtain a copy of the License at
224              
225             http://www.apache.org/licenses/LICENSE-2.0
226              
227             Unless required by applicable law or agreed to in writing, software
228             distributed under the License is distributed on an "AS IS" BASIS,
229             WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
230             See the License for the specific language governing permissions and
231             limitations under the License.
232             =cut
233              
234             1; # End of Video::CPL::Annotation