source: gs2-extensions/video-and-audio/trunk/src/perllib/plugins/SimpleVideoPlugin.pm@ 27552

Last change on this file since 27552 was 27552, checked in by jmt12, 11 years ago

Altering the debug comments to provide IO boundary timings a little more machine readable
File size: 14.7 KB
Line 
1###########################################################################
2#
3# SimpleVideoPlugin.pm -- Plugin for multimedia with some simple video
4# processing
5#
6# A component of the Greenstone digital library software from the New
7# Zealand Digital Library Project at the University of Waikato, New
8# Zealand.
9#
10# Copyright (C) 2012 New Zealand Digital Library Project
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful, but
18# WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20# General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program; if not, write to the Free Software
24# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25#
26###########################################################################
27
28package SimpleVideoPlugin;
29
30use File::Temp qw/ tempdir /;
31
32use BasePlugin;
33use MetadataRead;
34use util;
35use FileUtils;
36
37use strict;
38use warnings;
39no strict 'refs'; # allow filehandles to be variables and viceversa
40
41sub BEGIN
42{
43 @SimpleVideoPlugin::ISA = ('MetadataRead', 'BasePlugin');
44}
45
46my $arguments = [ { 'name' => "process_exp",
47 'desc' => "{BasePlugin.process_exp}",
48 'type' => "regexp",
49 'reqd' => "no",
50 'deft' => &get_default_process_exp() },
51 { 'name' => "streamingHQsize",
52 'desc' => "{VideoPlugin.streamingsize}",
53 'type' => "int",
54 'deft' => "720",
55 'reqd' => "no" },
56 { 'name' => "streamingHQVideoBitrate",
57 'desc' => "{VideoPlugin.streamingbitrate}",
58 'type' => "int",
59 'deft' => "496",
60 'reqd' => "no" },
61 { 'name' => "streamingHQAudioBitrate",
62 'desc' => "{VideoPlugin.streamingbitrate}",
63 'type' => "int",
64 'deft' => "80",
65 'reqd' => "no" },
66 { 'name' => "videoDeinterlacingFilter",
67 'desc' => "Activate a deinterlacing filter to increase the quality of TV footage",
68 'type' => "enum",
69 'list' => [{'name' => "true", 'desc' => "{common.true}"},
70 {'name' => "false", 'desc' => "{common.false}"}],
71 'deft' => "false",
72 'reqd' => "no" },
73 { 'name' => "isParallel",
74 'desc' => "Will the import use parallel processing? (maybe this should be set by parallel-import.pl somehow)",
75 'type' => "enum",
76 'list' => [{'name' => "true", 'desc' => "{common.true}"},
77 {'name' => "false", 'desc' => "{common.false}"}],
78 'deft' => "true",
79 'reqd' => "no" },
80 { 'name' => "isCluster",
81 'desc' => "Will the import be run on a cluster (multiple computers) or not (single computer - possibly multiple processors)",
82 'type' => "enum",
83 'list' => [{'name' => "true", 'desc' => "{common.true}"},
84 {'name' => "false", 'desc' => "{common.false}"}],
85 'deft' => "false",
86 'reqd' => "no" },
87 { 'name' => "separateIO",
88 'desc' => "copy and process the file locally (good for segregating IO cost)",
89 'type' => "enum",
90 'list' => [{'name' => "true", 'desc' => "{common.true}"},
91 {'name' => "false", 'desc' => "{common.false}"}],
92 'deft' => "false",
93 'reqd' => "no" },
94 { 'name' => "fixedCore",
95 'desc' => "Restrict the execution of Handbrake to a single core (0 = no restriction, > 0 use value-1'th core)",
96 'type' => "int",
97 'deft' => "0",
98 'reqd' => "no" },
99 ];
100
101my $options = { 'name' => "BasicVideoPlugin",
102 'desc' => "",
103 'abstract' => "no",
104 'inherits' => "yes",
105 'args' => $arguments };
106
107sub new
108{
109 my ($class) = shift (@_);
110 my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
111 push(@$pluginlist, $class);
112
113 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
114 push(@{$hashArgOptLists->{"OptList"}},$options);
115 my $self = new BasePlugin($pluginlist, $inputargs, $hashArgOptLists);
116 return bless $self, $class;
117}
118
119sub get_default_process_exp
120{
121 return '(?i)\.ts$';
122}
123
124sub get_oid_hash_type
125{
126 my $self = shift (@_);
127 return "hash_on_ga_xml";
128}
129
130sub process
131{
132 my $self = shift (@_);
133 my ($pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
134
135 if (!&FileUtils::isFilenameAbsolute($file) && $base_dir ne '')
136 {
137 $file = &FileUtils::filenameConcatenate($base_dir, $file);
138 }
139
140 print STDERR " * SimpleVideoPlugin processing: " . $file . "\n";
141
142 # - I have to add some text (yay, back to needing dummy text) otherwise the
143 # DocumentText formatting is ignored (?!?)
144 my $topsection = $doc_obj->get_top_section();
145 $doc_obj->add_utf8_text($topsection, "This is dummy text");
146
147
148 $file =~ /[\/]?([^\/]+)\.(?:ts)$/;
149 my $filename = $1;
150
151 # Optional date metadata (available on raw ReplayMe recordings)
152 if ($filename =~ /(\d\d\d\d)-(\d\d)-(\d\d)/)
153 {
154 my $date = $1 . $2 . $3;
155 $filename =~ s/[^a-z0-9]+/_/ig;
156 $filename =~ s/^_+|_+$//g;
157 $doc_obj->add_utf8_metadata($topsection,"Date",$date);
158 }
159
160 # Special Case: HDFS *only* supported by separateIO flag (you need to move
161 # the file out of HDFS to local filespace to allow MediaInfo and Handbrake
162 # to be run on it.
163 my $separate_io = $self->{'separateIO'};
164 if (&FileUtils::isHDFS($file))
165 {
166 $separate_io = 'true';
167 }
168 ###rint STDERR "[DEBUG] separate_io:" . $separate_io . "\n";
169
170 my $process_dir = $ENV{'GSDLCOLLECTDIR'};
171 # If we are in a cluster, then we don't want to be writing all the logs
172 # etc to the shared file system. Instead, we write to the tmp drive
173 if ($separate_io eq 'true')
174 {
175 $process_dir = &FileUtils::filenameConcatenate('/tmp', 'gsimport-' . $filename);
176 if (!&FileUtils::directoryExists($process_dir))
177 {
178 mkdir($process_dir, 0775);
179 }
180 }
181 my $logs_dir = &FileUtils::filenameConcatenate($process_dir, "logs");
182 if (!&FileUtils::directoryExists($logs_dir))
183 {
184 mkdir($logs_dir, 0775);
185 }
186 my $convert_log_path = &FileUtils::filenameConcatenate($logs_dir, 'convert-' . $filename . '.log');
187 my $pass_log_path = &FileUtils::filenameConcatenate($logs_dir, 'convert-' . $filename . '-pass');
188 my $tmp_dir = &FileUtils::filenameConcatenate($process_dir, "cached");
189 if (!&FileUtils::directoryExists($tmp_dir))
190 {
191 mkdir($tmp_dir, 0775);
192 }
193 $tmp_dir = &FileUtils::filenameConcatenate($tmp_dir, $filename);
194 if (!&FileUtils::directoryExists($tmp_dir))
195 {
196 mkdir($tmp_dir, 0775);
197 }
198
199 # If we are separating IO, then we also start by copying the file to
200 # the process directory (local tmp) as well
201 my $ivideo_path = $file;
202 if (!&FileUtils::isFilenameAbsolute($file) && $base_dir ne '')
203 {
204 $ivideo_path = &FileUtils::filenameConcatenate($base_dir, $file);
205 }
206 if ($separate_io eq 'true')
207 {
208 my $io_start = time();
209 print " - creating local copy of file: " . $ivideo_path . " [IOS:" . time() . "]\n";
210 my $local_ivideo_path = &FileUtils::filenameConcatenate($process_dir, $filename . ".ts");
211 &FileUtils::copyFiles($ivideo_path, $local_ivideo_path);
212 $ivideo_path = $local_ivideo_path;
213 print " - copied! [IOE:" . time() . "]\n";
214 }
215
216 # 1. Use MediaInfo to extract important metadata
217 print ' - Extracting metadata using MediaInfo...';
218 my $mi_metadata = $self->getMetadata($ivideo_path);
219 $doc_obj->add_utf8_metadata($topsection,"Format", 'multimedia (' . $mi_metadata->{'General'}->{'Format'} . ')');
220 if (defined $mi_metadata->{'General'}->{'File_size'})
221 {
222 $doc_obj->set_metadata_element($topsection, "FileSize", $mi_metadata->{'General'}->{'File_size'});
223 }
224 else
225 {
226 $doc_obj->set_metadata_element($topsection, "FileSize", &FileUtils::fileSize($ivideo_path));
227 }
228 $doc_obj->add_utf8_metadata($topsection,"Duration",$mi_metadata->{'General'}->{'Duration'});
229 if (defined $mi_metadata->{'Video'}->{'Format_Info'} && defined $mi_metadata->{'Video'}->{'Format'})
230 {
231 $doc_obj->add_utf8_metadata($topsection,"VideoFormat",$mi_metadata->{'Video'}->{'Format_Info'} . ' (' . $mi_metadata->{'Video'}->{'Format'} . ')');
232 }
233 if (defined $mi_metadata->{'Audio'}->{'Format_Info'} && defined $mi_metadata->{'Audio'}->{'Format'})
234 {
235 $doc_obj->add_utf8_metadata($topsection,"AudioFormat",$mi_metadata->{'Audio'}->{'Format_Info'} . ' (' . $mi_metadata->{'Audio'}->{'Format'} . ')');
236 }
237 $doc_obj->add_utf8_metadata($topsection,"Width",$mi_metadata->{'Video'}->{'Width'});
238 $doc_obj->add_utf8_metadata($topsection,"Height",$mi_metadata->{'Video'}->{'Height'});
239 print STDERR "Done!\n";
240
241 # 2. Convert into FLV, reprocess to make seekable, and associate
242 # - generate a path for our temporary converted video file
243 print STDERR " - Converting video to streamble format...\n";
244 my $ovideo_path = &FileUtils::filenameConcatenate($tmp_dir, 'gsv.mp4');
245 if (&FileUtils::fileExists($ovideo_path))
246 {
247 print " - Found existing converted video in cache!\n";
248 }
249 else
250 {
251 # - first conversion pass
252 print " - Convert using Handbrake\n";
253 my $streaming_HQ_size = $self->{'streamingHQsize'};
254 my $streaming_HQ_VideoBitrate = $self->{'streamingHQVideoBitrate'};
255 my $streaming_HQ_AudioBitrate = $self->{'streamingHQAudioBitrate'};
256 my $deinterlace = $self->{'videoDeinterlacingFilter'};
257 my $video_processing_parameters;
258 if (!$streaming_HQ_size || $streaming_HQ_size eq "fullsize")
259 {
260 $video_processing_parameters = "--strict-anamorphic";
261 }
262 else
263 {
264 $video_processing_parameters = "-w $streaming_HQ_size --loose-anamorphic";
265 }
266 if ($deinterlace eq "true")
267 {
268 $video_processing_parameters .= " --decomb";
269 }
270 # Default MenCoder options for x264
271 my $mencoder_options = 'ref=2:bframes=2:subq=6:mixed-refs=0:weightb=0:8x8dct=0:trellis=0';
272 my $is_cluster = $self->{'isCluster'};
273 my $is_parallel = $self->{'isParallel'};
274 # If we are parallel processing on a single (presumably) multicore computer
275 # then we need to limit the number of threads (and hence CPUs) HandBrake
276 # will utilize in order to emulate true parallel processing (otherwise the
277 # first thread to get to HandBrake conversion will take up most the CPUs
278 # causing all other threads to wait anyway). It will interesting to test
279 # whether parallel processing or serial processing (with HandBrake parallel
280 # processing) is faster. *update* threads=1 *only* controls the encoding and
281 # several other parts of Handbrake can run parallel (demuxing etc). I've
282 # had to include a 'taskset' command to truely make Handbrake serial
283 if ($is_parallel eq 'true' && $is_cluster eq 'false')
284 {
285 $mencoder_options .= ':threads=1';
286 }
287 # Banish HandbrakeCLI to the (fixedCore-1)'th CPU if necessary
288 my $cmd = '';
289 if (defined $self->{'fixedCore'} && $self->{'fixedCore'} > 0)
290 {
291 $cmd .= 'taskset -c ' . ($self->{'fixedCore'} - 1) . ' ';
292 }
293 $cmd .= 'HandBrakeCLI -i "' . $ivideo_path . '" -t 1 -c 1 -f mp4 -O -o "' . $ovideo_path . '" ' . $video_processing_parameters . ' -e x264 -b ' . $streaming_HQ_VideoBitrate . ' -a 1 -E faac -6 dpl2 -R Auto -B ' . $streaming_HQ_AudioBitrate . ' -D 0.0 -x ' . $mencoder_options . ' > "' . $convert_log_path . '" 2>&1';
294 my $attempt_count = 0;
295 do
296 {
297 $attempt_count++;
298 ###rint "[DEBUG: Video conversion attempt #" . $attempt_count . ": |" . $cmd . "|]\n";
299 `$cmd`;
300 }
301 while ($attempt_count < 5 && !&FileUtils::fileExists($ovideo_path))
302 }
303 if (!&FileUtils::fileExists($ovideo_path))
304 {
305 die("Fatal Error! Failed to convert video: " . $ovideo_path . "\nReason:" . $! . "\n");
306 }
307 print STDERR " - conversion done!\n";
308
309 # 3. Extract keyframes using hive
310 print STDERR " - extract keyframes...\n";
311 my $oshots_path = &FileUtils::filenameConcatenate($tmp_dir, 'shots.xml');
312 if (&FileUtils::fileExists($oshots_path))
313 {
314 print " - found existing keyframe images in cache\n";
315 }
316 else
317 {
318 print " - generating keyframe images using Hive2\n";
319 my $cmd = 'hive2_ffmpegsvn -o "' . $oshots_path . '" -k "' . $tmp_dir . '" "' . $ovideo_path . '" >> "' . $convert_log_path . '" 2>&1';
320 ###print "[cmd: " . $cmd . "]\n";
321 `$cmd`;
322 }
323 if (!&FileUtils::fileExists($oshots_path))
324 {
325 die("Fatal Error! Failed to extract keyframe images: " . $oshots_path . "\nReason:" . $! . "\n");
326 }
327 print STDERR " - keyframes extracted!\n";
328
329
330 # 4. Associate files (copies back to shared space if IO separated)
331 print STDERR " - Associate derived files to doc_obj... ";
332 # - associate streamable video
333 $doc_obj->associate_file($ovideo_path,'gsv.mp4','video/mp4',$topsection);
334 # - associate all of the JPGs found in the temp directory
335 opendir(my $dh, $tmp_dir);
336 my @shots = readdir($dh);
337 closedir($dh);
338 my $thumbnail = 0;
339 foreach my $shot (sort @shots)
340 {
341 my $shot_path = &FileUtils::filenameConcatenate($tmp_dir, $shot);
342 if ($shot =~ /.jpg$/)
343 {
344 if (!$thumbnail)
345 {
346 $doc_obj->add_utf8_metadata($topsection,"Thumbnail",$shot);
347 $thumbnail = 1;
348 }
349 $doc_obj->add_utf8_metadata($topsection,"Keyframe",$shot);
350 $doc_obj->associate_file($shot_path,$shot,"image/jpeg",$topsection);
351 }
352 }
353 print STDERR "Done!\n";
354
355 # 5. Done! Cleanup.
356 print STDERR "SimpleVideoPlugin: Complete! [IOS:" . time() . "]\n";
357 return 1;
358}
359
360sub getMetadata
361{
362 my ($self, $ivideo_path) = @_;
363 my $cmd = 'mediainfo --Output=XML "' . $ivideo_path . '" 2>&1';
364 ###rint "[DEBUG] command: " . $cmd . "\n";
365 my $metadata_xml = `$cmd`;
366 ###rint "[DEBUG] result: " . $metadata_xml . "\n\n";
367 my @lines = split(/\r?\n/, $metadata_xml);
368 my $metadata = {'Unknown'=>{}};
369 my $metadata_type = 'Unknown';
370 foreach my $line (@lines)
371 {
372 if ($line =~ /<track type="(.+)">/)
373 {
374 $metadata_type = $1;
375 if (!defined $metadata->{$metadata_type})
376 {
377 $metadata->{$metadata_type} = {};
378 }
379 }
380 elsif ($line =~ /<([^>]+)>(.+)<\/[^>]+>/)
381 {
382 my $field = $1;
383 my $value = $2;
384 $metadata->{$metadata_type}->{$field} = $value;
385 }
386 }
387 return $metadata;
388}
389
3901;
391
392
393
394
395
396
397
398
399
400
401
Note: See TracBrowser for help on using the repository browser.