File Coverage

blib/lib/Elive/Entity/Preload.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package Elive::Entity::Preload;
2 13     13   953 use warnings; use strict;
  13     13   19  
  13         331  
  13         43  
  13         16  
  13         278  
3              
4 13     13   40 use Mouse;
  13         12  
  13         62  
5 13     13   2913 use Mouse::Util::TypeConstraints;
  13         16  
  13         147  
6              
7             extends 'Elive::Entity';
8              
9 13     13   904 use Elive::Util;
  13         19  
  13         200  
10              
11 13     13   102422 use SOAP::Lite; # contains SOAP::Data package
  0            
  0            
12             use MIME::Types;
13             use File::Basename qw{};
14              
15             use Carp;
16              
17             __PACKAGE__->entity_name('Preload');
18             __PACKAGE__->collection_name('Preloads');
19              
20             has 'preloadId' => (is => 'rw', isa => 'Int', required => 1);
21             __PACKAGE__->primary_key('preloadId');
22             __PACKAGE__->params(
23             meetingId => 'Str',
24             fileName => 'Str',
25             length => 'Int',
26             );
27             __PACKAGE__->_alias(key => 'preloadId');
28              
29             enum enumPreloadTypes => qw(media whiteboard plan);
30             has 'type' => (is => 'rw', isa => 'enumPreloadTypes', required => 1,
31             documentation => 'preload type. media, whiteboard or plan',
32             );
33              
34             has 'name' => (is => 'rw', isa => 'Str', required => 1,
35             documentation => 'preload name, e.g. "intro.wbd"',
36             );
37              
38             has 'mimeType' => (is => 'rw', isa => 'Str', required => 1,
39             documentation => 'The mimetype of the preload (e.g., video/quicktime).');
40              
41             has 'ownerId' => (is => 'rw', isa => 'Str', required => 1,
42             documentation => 'preload owner (userId)',
43             );
44              
45             has 'size' => (is => 'rw', isa => 'Int', required => 1,
46             documentation => 'The length of the preload in bytes',
47             );
48              
49             has 'data' => (is => 'rw', isa => 'Str',
50             documentation => 'The contents of the preload.');
51              
52             has 'isProtected' => (is => 'rw', isa => 'Bool');
53             has 'isDataAvailable' => (is => 'rw', isa => 'Bool');
54              
55             sub BUILDARGS {
56             my $class = shift;
57             my $spec = shift;
58              
59             my %args;
60              
61             if ($spec && ! ref($spec) ) {
62             #
63             # Assume a single string arguments represents the local path of a file
64             # to be uploaded.
65             #
66             my $preload_path = $spec;
67              
68             open ( my $fh, '<', $preload_path)
69             or die "unable to open preload file $preload_path";
70              
71             binmode $fh;
72             my $content = do {local $/; <$fh>};
73              
74             close $fh;
75              
76             die "upload file is empty: $preload_path"
77             unless length $content;
78              
79             %args = (
80             fileName => $preload_path,
81             data => $content,
82             );
83             }
84             elsif (Elive::Util::_reftype($spec) eq 'HASH') {
85             %args = %$spec;
86             }
87             else {
88             croak 'usage: '.$class.'->new( filepath | {name => $filename, data => $binary_data, ...} )';
89             }
90              
91             if ($args{data}) {
92             $args{size} ||= length( $args{data} )
93             }
94              
95             if (defined $args{fileName} && length $args{fileName}) {
96             $args{name} ||= File::Basename::basename( $args{fileName} );
97             croak "unable to determine a basename for preload path: $args{fileName}"
98             unless length $args{name};
99             }
100              
101             die "unable to determine file name"
102             unless defined $args{name} && length $args{name};
103              
104             $args{mimeType} ||= $class->_guess_mimetype($args{name});
105             $args{type} ||= ($args{name} =~ m{\.wb[pd]$}ix ? 'whiteboard'
106             : $args{name} =~ m{\.elpx?$}ix ? 'plan'
107             : 'media');
108              
109             return \%args;
110             }
111              
112             =head1 NAME
113              
114             Elive::Entity::Preload - Elluminate Preload instance class
115              
116             =head2 DESCRIPTION
117              
118             This is the entity class for meeting preloads.
119              
120             my $preloads = Elive::Entity::Preload->list(
121             filter => 'mimeType=application/x-shockwave-flash',
122             );
123              
124             my $preload = Elive::Entity::Preload->retrieve($preload_id);
125              
126             my $type = $preload->type;
127              
128             There are three possible types of preloads: media, plan and whiteboard.
129              
130             =cut
131              
132             =head1 METHODS
133              
134             =cut
135              
136             =head2 upload
137              
138             #
139             # upload from a file
140             #
141             my $preload1 = Elive::Entity::Preload->upload('mypreloads/intro.wbd');
142              
143             #
144             # upload in-memory data
145             #
146             my $preload2 = Elive::Entity::Preload->upload(
147             {
148             type => 'whiteboard',
149             name => 'introduction.wbd',
150             ownerId => 357147617360,
151             data => $binary_data,
152             },
153             );
154              
155             Upload data from a client and create a preload. If a C is not
156             supplied, it will be guessed from the C extension, using
157             L.
158              
159             =cut
160              
161             sub upload {
162             my ($class, $spec, %opt) = @_;
163              
164             my $connection = $opt{connection} || $class->connection
165             or die "not connected";
166              
167             my $insert_data = $class->BUILDARGS( $spec );
168             my $content = delete $insert_data->{data};
169             $insert_data->{ownerId} ||= $connection->login->userId;
170             #
171             # 1. create initial record
172             #
173             my $self = $class->insert($insert_data, %opt);
174              
175             if ($self->size && $content) {
176             #
177             # 2. Now upload data to it
178             #
179             my $som = $connection->call('streamPreload',
180             %{ $self->_freeze(
181             {preloadId => $self->preloadId,
182             length => $self->size,
183             })},
184             stream => (SOAP::Data
185             ->type('hexBinary')
186             ->value($content)),
187             );
188              
189             $connection->_check_for_errors($som);
190             }
191              
192             return $self;
193             }
194              
195             =head2 download
196              
197             my $preload = Elive::Entity::Preload->retrieve($preload_id);
198             my $binary_data = $preload->download;
199              
200             Download preload data.
201              
202             =cut
203              
204             sub download {
205             my ($self, %opt) = @_;
206              
207             my $preload_id = $opt{preload_id} ||= $self->preloadId;
208              
209             die "unable to get a preload_id"
210             unless $preload_id;
211              
212             my $connection = $opt{connection} || $self->connection
213             or die "not connected";
214              
215             my $som = $connection->call('getPreloadStream',
216             %{$self->_freeze({preloadId => $preload_id})}
217             );
218              
219             my $results = $self->_get_results($som, $connection);
220              
221             return Elive::Util::_hex_decode($results->[0])
222             if $results->[0];
223              
224             return;
225             }
226              
227             =head2 import_from_server
228              
229             my $preload1 = Elive::Entity::Preload->import_from_server(
230             {
231             type => 'whiteboard',
232             name => 'introduction.wbd',
233             ownerId => 357147617360,
234             fileName => $path_on_server
235             },
236             );
237              
238             Create a preload from a file that is already present on the server's
239             file-system. If a C is not supplied, it will be guessed from
240             the C or C extension using L.
241              
242             =cut
243              
244             sub import_from_server {
245             my ($class, $spec, %opt) = @_;
246              
247             $spec = {fileName => $spec} if defined $spec && !ref $spec;
248              
249             my $insert_data = $class->BUILDARGS($spec);
250              
251             die "missing required parameter: fileName"
252             unless $insert_data->{fileName};
253              
254             $insert_data->{ownerId} ||= do {
255             my $connection = $opt{connection} || $class->connection
256             or die "not connected";
257              
258             $connection->login->userId;
259             };
260              
261             $opt{command} ||= 'importPreload';
262              
263             return $class->insert($insert_data, %opt);
264             }
265              
266             =head2 list_meeting_preloads
267              
268             my $preloads = Elive::Entity::Preload->list_meeting_preloads($meeting_id);
269              
270             Returns a list of preloads associated with the given meeting-Id or meeting
271             object.
272              
273             =cut
274              
275             sub list_meeting_preloads {
276             my ($self, $meeting_id, %opt) = @_;
277              
278             die 'usage: $preload_obj->list_meeting_preloads($meeting)'
279             unless $meeting_id;
280              
281             $opt{command} ||= 'listMeetingPreloads';
282              
283             return $self->_fetch({meetingId => $meeting_id}, %opt);
284             }
285              
286             =head2 list
287              
288             my $all_preloads = Elive::Entity::Preload->list();
289              
290             Lists all known preloads.
291              
292             =cut
293              
294             sub _thaw {
295             my ($class, $db_data, %opt) = @_;
296              
297             my $db_thawed = $class->SUPER::_thaw($db_data, %opt);
298              
299             for (grep {defined} $db_thawed->{type}) {
300             #
301             # Just to pass type constraints
302             #
303             $_ = lc($_);
304              
305             unless (m{^media|whiteboard|plan$}x) {
306             Carp::carp "ignoring unknown media type: $_";
307             delete $db_thawed->{type};
308             }
309             }
310              
311             return $db_thawed;
312             }
313              
314             =head2 update
315              
316             The update method is not available for preloads.
317              
318             =cut
319              
320             sub update {return shift->_not_available}
321              
322             sub _guess_mimetype {
323             my ($class, $filename) = @_;
324              
325             my $mime_type;
326             my $guess;
327              
328             unless ($filename =~ m{\.elpx?}x) { # plan
329             our $mime_types ||= MIME::Types->new;
330             $mime_type = $mime_types->mimeTypeOf($filename);
331              
332             $guess = $mime_type->type
333             if $mime_type;
334             }
335              
336             $guess ||= 'application/octet-stream';
337              
338             # untaint
339             $guess = $1
340             if $guess =~ /([[:print:]]+)/;
341              
342             return $guess;
343             }
344              
345             sub _readback_check {
346             my ($class, $update_ref, $rows, @args) = @_;
347              
348             #
349             # Elluminate 10.0 discards the file extension for whiteboard preloads;
350             # bypass check on 'name'.
351             #
352              
353             my %updates = %{ $update_ref };
354             delete $updates{name};
355              
356             return $class->SUPER::_readback_check(\%updates, $rows, @args, case_insensitive => 1);
357             }
358              
359             =head1 BUGS AND LIMITATIONS
360              
361             =over 4
362              
363             =item * Under Elluminate 9.6.0 and LDAP, you may need to arbitrarily add a 'DomN:'
364             prefix to the owner ID, when creating or updating a meeting.
365              
366             $preload->ownerId('Dom1:freddy');
367              
368             =item * Elluminate 10.0 strips the file extension from the filename when
369             whiteboard files are saved or uploaded (C => C).
370             However, if the file lacks an extension to begin with, the request crashes with
371             the confusing error message: C<"string index out of range: -1">.
372              
373             =item * As of ELM 3.3.5, The C option appears to have no affect when passed to the C method.
374              
375             =back
376              
377             =cut
378              
379             1;