source: extensions/gsdl-video/trunk/perllib/videoconvert.pm@ 18425

Last change on this file since 18425 was 18425, checked in by davidb, 15 years ago

Video extension to Greenstone
File size: 17.5 KB
Line 
1##########################################################################
2#
3# videoconvert.pm -- utility to help convert video file
4#
5# Copyright (C) 1999 DigiLib Systems Limited, NZ
6#
7# This program is free software; you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 2 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program; if not, write to the Free Software
19# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20#
21###########################################################################
22
23
24package videoconvert;
25
26use strict;
27no strict 'refs'; # allow filehandles to be variables and viceversa
28
29use baseconvert;
30
31sub BEGIN {
32 @videoconvert::ISA = ('baseconvert');
33}
34
35
36# Discover the characteristics of a video file.
37# Equivalent step to that in ImagePlugin that uses ImageMagicks's 'indentify' utility
38# Here we use 'ffmpeg' for video but for consistency keep the Perl method name the same
39# as before
40
41
42sub identify {
43 my ($video, $outhandle, $verbosity) = @_;
44
45 # Use the ffmpeg command to get the file specs
46 my $command = "ffmpeg -i \"$video\"";
47
48 print $outhandle " $command\n" if ($verbosity > 2);
49 my $result = '';
50 $result = `$command 2>&1`;
51 print $outhandle " $result\n" if ($verbosity > 4);
52
53 # Read the type, width, and height etc.
54 my $vtype = 'unknown';
55 my $vcodec = 'unknown';
56 my $width = 'unknown';
57 my $height = 'unknown';
58 my $fps = 'unknown';
59
60 my $atype = 'unknown';
61 my $afreq = 'unknown';
62 my $achan = 'unknown';
63 my $arate = 'unknown';
64
65 my $video_safe = quotemeta $video;
66
67 # strip off everything up to filename
68 $result =~ s/^.*\'$video_safe\'://s;
69
70 if ($result =~ m/Video: (.*?) fps/m) {
71 my $video_info = $1;
72 if ($video_info =~ m/([^,]+),(?: ([^,]+),)? (\d+)x(\d+),.*?(\d+\.\d+)/)
73 {
74 $vtype = $1;
75 $vcodec = $2 if defined $2;
76 $width = $3;
77 $height = $4;
78 $fps = $5;
79 }
80 }
81
82## if ($result =~ m/Video: (\w+), (\w+), (\d+)x(\d+),.*?(\d+\.\d+) fps/m) {
83# if ($result =~ m/Video: ([^,]+),(?: ([^,]+),)? (\d+)x(\d+),.*?(\d+\.\d+) fps/m) {
84# $vtype = $1;
85# $vcodec = $2;
86# $width = $3;
87# $height = $4;
88# $fps = $5;
89# }
90
91 if ($result =~ m/Audio: (\w+), (\d+) Hz, (\w+)(?:, (\d+.*))?/m) {
92 $atype = $1;
93 $afreq = $2;
94 $achan = $3;
95 $arate = $4 if (defined $4);
96 }
97
98 # Read the duration
99 my $duration = "unknown";
100 if ($result =~ m/Duration: (\d+:\d+:\d+\.\d+)/m) {
101 $duration = $1;
102 }
103 print $outhandle " file: $video:\t $vtype, $width, $height, $duration\n"
104 if ($verbosity > 2);
105
106 if ($verbosity >3) {
107 print $outhandle "\t video codec=$vcodec, fps = $fps\n";
108 print $outhandle "\t audio codec=$atype, freq = $afreq Hz, $achan, $arate\n";
109 }
110
111 # Return the specs
112 return ($vtype, $width, $height, $duration, -s $video,
113 $vcodec,$fps,$atype,$afreq,$achan,$arate);
114}
115
116
117sub vob_durations
118{
119 my ($media_base_dir,$title_num,$outhandle) = @_;
120
121 my $filter_re = sprintf("^VTS_%02d_[1-9]\\.VOB\$",$title_num);
122
123 my $duration_info = {};
124
125 if (opendir(VTSIN,$media_base_dir)) {
126 my @vts_title_vobs = grep { $_ =~ m/$filter_re/ } readdir(VTSIN);
127 closedir(VTSIN);
128
129 foreach my $v (@vts_title_vobs) {
130 my $full_v = &util::filename_cat($media_base_dir,$v);
131
132 my ($vtype, $width, $height, $duration, $vsize,
133 $vcodec,$fps,$atype,$afreq,$achan,$arate) = identify($full_v,$outhandle,0);
134
135 my ($vob_num) = ($v =~ m/^VTS_\d\d_(\d)\.VOB$/);
136
137 $duration_info->{$vob_num} = $duration;
138 print STDERR "**** $title_num: $title_num, storing {$vob_num} => $duration\n";
139
140 }
141
142 }
143 else {
144 print $outhandle "Warning: unable to read files in directory $media_base_dir\n";
145 }
146
147 return $duration_info;
148
149}
150
151
152
153sub new {
154 my ($class) = shift @_;
155
156 my ($base_dir,$video_filename, $verbosity,$outhandle,
157 $exp_duration,$ascii_only_filenames) = @_;
158
159 my $self = new baseconvert($base_dir,$video_filename,$verbosity,$outhandle);
160
161 $self->{'exp_duration'} = $exp_duration;
162
163 if (defined $ascii_only_filenames && ($ascii_only_filenames)) {
164 my $file_root = $self->{'file_root'};
165 $self->{'file_root'} = ascii_only_filename($file_root);
166 }
167
168 my @ffmpeg_monitor = ( 'monitor_init' , "videoconvert::ffmpeg_monitor_init",
169 'monitor_line' , "videoconvert::ffmpeg_monitor_line",
170 'monitor_deinit' , "videoconvert::ffmpeg_monitor_deinit" );
171
172 my @flvtool2_monitor = ( 'monitor_init' ,"monitor_init_unbuffered",
173 'monitor_line' , "videoconvert::flvtool2_monitor_line",
174 'monitor_deinit' , "monitor_deinit_unbuffered" );
175
176 $self->{'ffmpeg_monitor'} = \@ffmpeg_monitor;
177 $self->{'flvtool2_monitor'} = \@flvtool2_monitor;
178
179
180 return bless $self, $class;
181}
182
183
184sub ascii_only_filename
185{
186 my ($file) = @_;
187
188 my $file_unicode = pack("U0C*", map { ord($_) } split(//,$file)); # force explicitly to unicode
189
190 my @ascii_only_chars
191 = map { $_ >= 128 # if non-ascii
192 ? ""
193 : chr($_) } unpack("U*", $file_unicode); # unpack Unicode characters
194
195 my $ascii_file = join("",@ascii_only_chars);
196
197 if ($ascii_file eq "") {
198 print STDERR "Warning: filename includes no ASCII characters\n";
199 print STDERR " Keeping as original filename\n";
200 $ascii_file = $file;
201 }
202
203 return $ascii_file;
204}
205
206
207sub remove_difficult_chars
208{
209 my $self = shift @_;
210
211 my ($file) = @_;
212
213 # remove problematic characters from filename that make using it in a URL difficult
214
215 my $file_unicode = pack("U0C*", map { ord($_) } split(//,$file)); # force explicitly to unicode
216
217 my $url = $file_unicode;
218 $url =~ s/\x{2018}|\x{2019}|\x{201C}|\x{201D}//g; # remove smart quotes as cause problem in URL for video server
219 $url =~ s/\x{2013}/\-/g; # change en-dash to '-' as again causes problems for video server
220
221 return $url;
222}
223
224
225sub url_safe
226{
227 my $self = shift @_;
228
229 my ($file) = @_;
230
231 my @url_utf8_chars
232 = map { $_ >= 128 # if non-ascii
233 ? "%" . sprintf("%02X", $_)
234 : chr($_) } unpack("U*", $file); # unpack Unicode characters
235
236 my $url = join("",@url_utf8_chars);
237
238
239 return $url;
240}
241
242
243
244
245
246sub optional_frame_scale
247{
248 my $self = shift (@_);
249 my ($orig_size,$video_width,$video_height) = @_;
250
251 my $s_opt = "";
252 if ($video_width > $video_height) {
253 if ($video_width > $orig_size) {
254 my $scale_factor = $orig_size/$video_width;
255 my $scaled_width = int($video_width * $scale_factor);
256 my $scaled_height = int($video_height * $scale_factor);
257
258 # round to be ensure multiple of 2 (needed by some codecs)
259 $scaled_width = int($scaled_width/2)*2;
260 $scaled_height = int($scaled_height/2)*2;
261
262 $s_opt = "-s ${scaled_width}x${scaled_height}";
263 }
264 # else, video is smaller than requested size, don't scale up
265 }
266 else {
267 if ($video_height > $orig_size) {
268 my $scale_factor = $orig_size/$video_height;
269 my $scaled_width = int($video_width * $scale_factor);
270 my $scaled_height = int($video_height * $scale_factor);
271
272 # round to be ensure multiple of 2 (needed by some codecs)
273 $scaled_width = int($scaled_width/2)*2;
274 $scaled_height = int($scaled_height/2)*2;
275
276 $s_opt = "-s ${scaled_width}x${scaled_height}";
277 }
278 # else, video is smaller than requested size, don't scale up
279
280 }
281
282 return $s_opt;
283}
284
285
286sub keyframe_cmd
287{
288 my $self = shift (@_);
289 my ($ivideo_filename) = @_;
290
291 my $video_ext_dir = &util::filename_cat($ENV{'GSDLHOME'},"ext","video");
292
293 my $output_dir = $self->{'cached_dir'};
294 my $ivideo_root = $self->{'file_root'};
295
296 my $oshot_filename = &util::filename_cat($output_dir,"shots.xml");
297
298 my $exp_duration = $self->{'exp_duration'};
299 my $t_opt = (defined $exp_duration) ? "-t $exp_duration" : "";
300
301 my $main_opts = "-y $t_opt";
302
303 my $hive = &util::filename_cat($video_ext_dir,"lib","vhook","hive.so");
304
305 my $oflash_filename = &util::filename_cat($output_dir,"$ivideo_root\_keyframe.flv");
306
307 my $vhook_opts = "$hive -o $oshot_filename -k $output_dir $ivideo_filename";
308
309 my $ffmpeg_cmd = "ffkeyframe $main_opts -vhook \"$vhook_opts\" -i \"$ivideo_filename\" -an -y \"$oflash_filename\"";
310
311
312 return ($ffmpeg_cmd,$oflash_filename);
313}
314
315
316sub stream_cmd
317{
318 my $self = shift (@_);
319 my ($ivideo_filename,$video_width,$video_height,
320 $streaming_quality,
321 $streaming_bitrate,$streaming_size,
322 $opt_streaming_achan, $opt_streaming_arate) = @_;
323
324 my $streaming_achan
325 = (defined $opt_streaming_achan) ? $opt_streaming_achan : 2;
326
327 my $streaming_arate
328 = (defined $opt_streaming_arate) ? $opt_streaming_arate : 22050;
329
330 my $output_dir = $self->{'cached_dir'};
331 my $ivideo_root = $self->{'file_root'};
332
333 my $oflash_file = "${ivideo_root}_stream.flv";
334 my $oflash_filename = &util::filename_cat($output_dir,$oflash_file);
335
336 my $s_opt = $self->optional_frame_scale($streaming_size,$video_width,$video_height);
337
338 my $exp_duration = $self->{'exp_duration'};
339 my $t_opt = (defined $exp_duration) ? "-t $exp_duration" : "";
340
341 my $main_opts = "-y $t_opt";
342
343 my $bitrate_opt = "-b $streaming_bitrate";
344 ### my $stream_opts = "-r 25 $s_opt";
345 my $stream_opts .= " $s_opt -ac $streaming_achan -ar $streaming_arate";
346
347 # -flags +ilme+ildct' and maybe '-flags +alt' for interlaced material, and try '-top 0/1'
348
349 my $all_opts = "$main_opts $stream_opts";
350
351 my $ffmpeg_cmd;
352
353 if ($streaming_quality eq "high") {
354
355 my $pass_log_file = &util::filename_cat($output_dir,"$ivideo_root-logpass.txt");
356 if (-e $pass_log_file) {
357 &util::rm($pass_log_file);
358 }
359
360 $all_opts .= " -passlogfile \"$pass_log_file\"";
361
362 my $ffmpeg_cmd_pass1 = "ffmpeg -pass 1 -i \"$ivideo_filename\" $all_opts -y \"$oflash_filename\"";
363
364 my $ffmpeg_cmd_pass2 = "ffmpeg -pass 2 -i \"$ivideo_filename\" $all_opts $bitrate_opt -y \"$oflash_filename\"";
365 $ffmpeg_cmd = "( $ffmpeg_cmd_pass1 ; $ffmpeg_cmd_pass2 )";
366 }
367 else {
368 # single pass
369
370 $ffmpeg_cmd = "ffmpeg -i \"$ivideo_filename\" $all_opts -y \"$oflash_filename\"";
371 }
372
373 return ($ffmpeg_cmd,$oflash_filename,$oflash_file);
374}
375
376
377
378sub audio_excerpt_cmd
379{
380 my $self = shift (@_);
381 my ($ivoa_filename,$hh,$mm,$ss,$opt_excerpt_len) = @_;
382
383 # ivoa = input video or audio
384
385 my $time_encoded = "$hh:$mm:$ss";
386 my $time_encoded_file = "$hh$mm$ss";
387
388
389 my $output_dir = $self->{'cached_dir'};
390 my $ivoa_root = $self->{'file_root'};
391
392 my $omp3_file = "${ivoa_root}_$time_encoded_file.mp3";
393 my $omp3_filename = &util::filename_cat($output_dir,$omp3_file);
394
395 my $all_opts = "-y -acodec mp3 -ss $time_encoded ";
396
397 if (defined $opt_excerpt_len) {
398 $all_opts .= "-t $opt_excerpt_len ";
399 }
400
401
402 my $ffmpeg_cmd = "ffmpeg -i \"$ivoa_filename\" $all_opts \"$omp3_filename\"";
403
404 return ($ffmpeg_cmd,$omp3_filename,$omp3_file);
405}
406
407
408
409sub streamseekable_cmd
410{
411 my $self = shift (@_);
412 my ($oflash_filename) = @_;
413
414 my $output_dir = $self->{'cached_dir'};
415 my $ivideo_root = $self->{'file_root'};
416
417 my $cue_filename = &util::filename_cat($output_dir,"on_cue.xml");
418
419 my $flvtool_cmd = "flvtool2 -vUP \"$oflash_filename\"";
420
421 return ($flvtool_cmd,$oflash_filename);
422}
423
424
425sub streamkeyframes_cmd
426{
427 my $self = shift (@_);
428 my ($oflash_filename,$doc_obj,$section) = @_;
429
430 my $assocfilepath
431 = $doc_obj->get_metadata_element($section,"assocfilepath");
432
433 my $output_dir = $self->{'cached_dir'};
434
435 my $cue_filename = &util::filename_cat($output_dir,"on_cue.xml");
436
437 my $video_server = $ENV{'GEXT_VIDEO_SERVER'};
438 my $video_prefix = $ENV{'GEXT_VIDEO_PREFIX'};
439
440 my $collect = $ENV{'GSDLCOLLECTION'};
441
442 my $flvtool_cmd = "flvtool2 -vAUtP \"$cue_filename\" -thumbLocation:$video_server$video_prefix/collect/$collect/index/assoc/$assocfilepath \"$oflash_filename\"";
443
444
445 return ($flvtool_cmd,$oflash_filename);
446}
447
448
449sub streamcuepts_cmd
450{
451 my $self = shift (@_);
452 my ($oflash_filename) = @_;
453
454 my $output_dir = $self->{'cached_dir'};
455
456 my $cue_filename = &util::filename_cat($output_dir,"on_cue.xml");
457
458 my $video_server = $ENV{'GEXT_VIDEO_SERVER'};
459 my $video_prefix = $ENV{'GEXT_VIDEO_PREFIX'};
460
461 my $collect = $ENV{'GSDLCOLLECTION'};
462 my $thumbloc = "$video_server$video_prefix/collect/$collect";
463
464
465# my $flvtool_cmd = "flvtool2 -vUAtP \"$cue_filename\" -thumbLocation:$thumbloc \"$oflash_filename\"";
466
467# my $flvtool_cmd = "flvtool2 -vUAt \"$cue_filename\" \"$oflash_filename\"";
468
469
470
471# my $flvtool_cmd = "flvtool2 -vUAt \"$cue_filename\" \"$oflash_filename\"";
472
473
474## my $flvtool_cmd = "flvtool2 -vAt \"$cue_filename\" -UP \"$oflash_filename\" \"$output_dir/updated.flv\"";
475
476## my $flvtool_cmd = "flvtool2 -vAtU \"$cue_filename\" \"$oflash_filename\" \"$output_dir/updated.flv\"";
477
478 my $flvtool_cmd = "flvtool2 -vAtUP \"$cue_filename\" \"$oflash_filename\"";
479
480 return ($flvtool_cmd,$oflash_filename);
481}
482
483
484sub keyframe_thumbnail_cmd
485{
486 my $self = shift (@_);
487 my ($ivideo_filename,$thumbnailfile,$thumbnailsize) = @_;
488
489 my $output_dir = $self->{'cached_dir'};
490 my $ivideo_root = $self->{'file_root'};
491
492 my $key_filename_prefix = &util::filename_cat($output_dir,$ivideo_root);
493
494
495 # Try for 4th keyframe, but fall back to 1st if doesn't exist
496 my $key_filename = "${key_filename_prefix}_0003.jpg";
497 $key_filename = "${key_filename_prefix}_0000.jpg" if (!-e $key_filename);
498
499 my $command;
500
501 if (-e $key_filename) {
502 $command = "convert -interlace plane -verbose -geometry $thumbnailsize"
503 . "x$thumbnailsize \"$key_filename\" \"$thumbnailfile\"";
504 }
505 else {
506 # extractkeyframe has either not been switched on, or else had
507 # a problem when running
508 # => extract a from
509 # my $frame_rate = 1.0 / 60.0;
510
511
512 $command = "ffmpeg -i \"$ivideo_filename\" -ss 5.5 -vframes 1 -f image2 -s ${thumbnailsize}x${thumbnailsize} -y \"$thumbnailfile\"";
513
514 # fmpeg -i input.dv -r 1 -f image2 -s 120x96 images%05d.png
515 }
516
517 return ($command,$thumbnailfile);
518}
519
520
521sub keyframe_montage_cmd
522{
523 my $self = shift (@_);
524 my ($ivideo_filename,$montagefile) = @_;
525
526 my $output_dir = $self->{'cached_dir'};
527 my $ivideo_root = $self->{'file_root'};
528
529 my $key_filename_prefix = &util::filename_cat($output_dir,$ivideo_root);
530
531 my $options = "-tile 10 -geometry 75x62+2+2";
532
533 my $command = "montage $options ${key_filename_prefix}_*.jpg \"$montagefile\"";
534
535 return ($command,$montagefile);
536}
537
538
539
540sub parse_shot_xml
541{
542 my ($self) = shift(@_);
543
544 my ($plugin) = @_;
545
546 my $outhandle = $self->{'outhandle'};
547 my $output_dir = $self->{'cached_dir'};
548
549 my $shots_filename = &util::filename_cat($output_dir,"shots.xml");
550
551 eval {
552 $plugin->{'parser'}->parsefile($shots_filename);
553 };
554
555 if ($@) {
556 print $outhandle "videoconvert.pm: skipping $shots_filename as not conformant to Hive shot syntax\n" if ($self->{'verbosity'} > 1);
557 print $outhandle "\n Perl Error:\n $@\n" if ($self->{'verbosity'}>2);
558 return 0;
559 }
560
561}
562
563sub associate_keyframes_old
564{
565 my ($self) = shift(@_);
566
567 my ($doc_obj,$section,$plugin) = @_;
568
569 my $output_dir = $self->{'cached_dir'};
570
571 my $count = 1;
572 foreach my $kframe_file (@{$plugin->{'keyframe_fnames'}}) {
573
574 my $kframe_filename = &util::filename_cat($output_dir,$kframe_file);
575 $doc_obj->associate_file($kframe_filename,"keyframe$count.jpg","image/jpeg",
576 $section);
577 $count++;
578 }
579
580 $doc_obj->add_utf8_metadata($section,"NumKeyframes",scalar(@{$plugin->{'keyframe_fnames'}}));
581
582
583 # *****
584 # $doc_obj->add_metadata ($section, "thumblist", $plugin->{'flowplayer_thumblist'});
585
586}
587
588sub associate_keyframes
589{
590 my ($self) = shift(@_);
591
592 my ($doc_obj,$section,$plugin) = @_;
593
594 my $output_dir = $self->{'cached_dir'};
595 my $timeline = $plugin->{'keyframe_timeline'};
596
597 my $count = 1;
598
599 foreach my $t (sort { $timeline->{$a}->{'keyframeindex'} <=> $timeline->{$b}->{'keyframeindex'} } keys %$timeline)
600 {
601 my $kframe_file = $timeline->{$t}->{'thumb'};
602 my $timestamp = $timeline->{$t}->{'timestamp'};
603
604 my $kframe_filename = &util::filename_cat($output_dir,$kframe_file);
605 $doc_obj->associate_file($kframe_filename,"keyframe$count.jpg","image/jpeg",
606 $section);
607 $doc_obj->add_utf8_metadata($section,"KeyframeTimestamp",$timestamp);
608
609 $count++;
610 }
611
612 $doc_obj->add_utf8_metadata($section,"NumKeyframes",scalar(@{$plugin->{'keyframe_fnames'}}));
613
614
615 # *****
616 # $doc_obj->add_metadata ($section, "thumblist", $plugin->{'flowplayer_thumblist'});
617}
618
619
620
621sub ffmpeg_monitor_init
622{
623 my $saved_record_sep = $/;
624 $/ = "\r";
625
626 my $saved_buffer_len = $|;
627 $| = 1;
628
629 my $saved_rec = { 'saved_record_sep' => $saved_record_sep,
630 'saved_buffer_len' => $saved_buffer_len };
631
632 return $saved_rec;
633}
634
635
636
637sub ffmpeg_monitor_deinit
638{
639 my ($saved_rec) = @_;
640
641 my $saved_record_sep = $saved_rec->{'saved_record_sep'};
642 my $saved_buffer_len = $saved_rec->{'saved_buffer_len'};
643
644 $/ = $saved_record_sep;
645 $| = $saved_buffer_len;
646}
647
648
649sub ffmpeg_monitor_line
650{
651 my ($line) = @_;
652
653 my $had_error = 0;
654 my $generate_dot = 0;
655
656 if ($line =~ m/^frame=/)
657 {
658 $generate_dot = 1;
659 }
660
661 return ($had_error,$generate_dot);
662}
663
664
665sub flvtool2_monitor_line
666{
667 my ($line) = @_;
668
669 my $had_error = 0;
670 my $generate_dot = 1;
671
672 if ($line =~ m/\s+\- /) {
673 # ignore tabulated output printed at end of command
674 $generate_dot = 0;
675 }
676
677 if ($line =~ m/^Error:/i) {
678 $had_error = 1;
679 }
680
681 return ($had_error,$generate_dot);
682}
683
684
685
686
687
6881;
Note: See TracBrowser for help on using the repository browser.