source: Trunk/Scripts/VoxForge/lib/Corpus/Quarantine/Submission/Audio.pm @ 3927

Revision 3616, 34.3 KB checked in by kmaclean, 3 years ago (diff)

in Trunk: fix and tests for: error in Audio class where in test it sent back a relative path but in prod sent an absolute path

Line 
1#!/usr/bin/perl
2####################################################################
3###
4### script name : Audio.pm
5### version: 0.1
6### created by: Ken MacLean
7### mail: contact@voxforge.org
8### Date: 2010.4.10
9###   
10### Copyright (C) 2010 Ken MacLean
11###
12### This program is free software; you can redistribute it and/or
13### modify it under the terms of the GNU General Public License
14### as published by the Free Software Foundation; either version 3
15### of the License, or (at your option) any later version.
16###
17### This program is distributed in the hope that it will be useful,
18### but WITHOUT ANY WARRANTY; without even the implied warranty of
19### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20### GNU General Public License for more details.
21###
22### Change History:   
23### 0.1 - 2010.4.10 - created
24### 0.2 - 2010.5.18 - created subclass AudioFile
25### 0.3 - 2010.5.21 - refactored Audio; AudioFile and Wav
26####################################################################
27package Corpus::Quarantine::Submission::Audio;
28use 5.10.0;
29
30=head1 Corpus::Quarantine::Submission::Audio
31
32# Audio::Wav requires Inline::C package to run without some warnings...
33# Audio::Wav need to modify source as follows to run without 'sub redefine' warnings...
34#               # read is generated by _init_read_sub
35#               # !!!!!!
36#               # sub read { die "ERROR: can't call read without first calling _init_read_sub"; };
37#               # !!!!!!
38
39=cut
40
41use Moose; # automatically turns on strict and warnings
42has 'parms' => (is => 'rw', isa => 'Object', required => 1);
43has 'audioDirName' => (is => 'rw', isa => 'Str', required => 1);
44has 'audioFileCount' => (is => 'rw', isa => 'Str', reader => 'get_audioFileCount');
45has 'audioFilesCollection' => (
46      traits    => [ 'Hash' ],
47      is        => 'rw',
48      isa       => 'HashRef[Corpus::Quarantine::Submission::Audio::AudioFile]',
49      default   => sub { {} },
50      handles   => { # methods to access data in audioFilesCollection hash table
51          exists_in_audioFiles => 'exists',
52          get_keys_from_audioFiles    => 'keys',
53          get_audioFile => 'get',
54          set_audioFile => 'set',   
55          numberOfFiles => 'count',                   
56      },
57  );
58has 'confidenceScores' => (is => 'rw', isa => 'ArrayRef', reader => 'get_confidenceScores');
59has 'suffixlist' => (is => 'rw', isa => 'ArrayRef', reader => 'get_suffixlist', default => sub { return ["wav", "raw", "flac"] } );
60has 'forcedAlignment' => (is => 'rw', isa => 'ArrayRef', reader => 'get_forcedAlignment' );
61has 'tempDir' => (is => 'rw', isa => 'Str', reader => 'get_tempDir',
62        default => sub {
63                #return tempdir(CLEANUP => 1 ); # cleanup directory on program exit
64                return tempdir();       # test 
65                }
66        );
67has 'audioExceptions' => (is => 'rw', isa => 'ArrayRef', reader => 'get_audioExceptions', default => sub { return [] }); # array ref needs a default otherwise will return undef...
68has 'doNotProcessAudio' => (is => 'rw', isa => 'Int', reader => 'get_doNotProcessAudio', default => 0 );
69has 'html' => (is => 'rw', isa => 'Str', reader => 'get_html');
70
71use Exception::Class (
72        'Corpus::Quarantine::Submission::Audio::Exception' => {isa => 'Corpus::Quarantine::Submission::Exception' },
73                'Corpus::Quarantine::Submission::Audio::noAudioFiles::Exception'                                        => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },   
74                'Corpus::Quarantine::Submission::Audio::invalidAudioType::Exception'                            => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },   
75               
76                'Corpus::Quarantine::Submission::Audio::FileError::Exception'                                           => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },       
77                'Corpus::Quarantine::Submission::Audio::CantOpenDirectory::Exception'                           => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },   
78                'Corpus::Quarantine::Submission::Audio::AudioFileNotInPrompts::Exception'                       => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },               
79                 
80                'Corpus::Quarantine::Submission::Audio::AudioDoesNotMatchPrompts::Exception'            => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },   
81                                'Corpus::Quarantine::Submission::Audio::Confidence::AudioDoesNotMatchPrompts::Exception'                        => { isa => 'Corpus::Quarantine::Submission::Audio::AudioDoesNotMatchPrompts::Exception' }, 
82                                'Corpus::Quarantine::Submission::Audio::AudioFile::ForceAlign::AudioDoesNotMatchPrompts::Exception' => { isa => 'Corpus::Quarantine::Submission::Audio::AudioDoesNotMatchPrompts::Exception' },
83            'Corpus::Quarantine::Submission::Audio::NumPromptsNENumAudioFiles::Exception'                       => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },         
84                'Corpus::Quarantine::Submission::Audio::AudioTypeNotSupported::Exception'       => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },
85               
86                'Corpus::Quarantine::Submission::Audio::juliusError::Exception'                         => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },
87                'Corpus::Quarantine::Submission::Audio::HVite_Error::Exception'                         => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' }, 
88
89                'Corpus::Quarantine::Submission::Audio::MethodNotImplementedInSubClass::Exception'      => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },
90                'Corpus::Quarantine::Submission::Audio::juliusTriphoneNotFound::Exception' => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },
91                'Corpus::Quarantine::Submission::Audio::wordsMissingFromDict::Exception' => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },
92                'Corpus::Quarantine::Submission::Audio::CantFindAudioFile::Exception' => { isa => 'Corpus::Quarantine::Submission::Audio::Exception' },
93);
94     
95#use Audio::Wav;  # not used
96#use Audio::FLAC::Header; # Fedora: needs flac-devel installed
97use File::Basename;
98use File::Spec;
99use diagnostics;
100use Carp;
101use File::Temp qw(tempdir);
102use Cwd;
103use IPC::System::Simple qw(system capture);
104use Log::Log4perl;
105use Switch;
106use File::Copy::Recursive qw(dircopy fmove);
107use Encode;
108
109use Data::Dumper; # !!!!!!
110
111use Corpus::Quarantine::Submission::Audio::AudioFile::Wav();
112use Corpus::Quarantine::Submission::Audio::AudioFile::Flac();
113use Corpus::Quarantine::Submission::Audio::AudioFile::Raw();
114use Corpus::Quarantine::Submission::Readme;
115
116my $command;
117my $logger = Log::Log4perl->get_logger();
118
119=head2 Constructor
120
121=cut
122 
123sub BUILD {
124        my ($self) = @_;               
125        my $ad = $self->audioDirName;
126        my $pa = $self->parms; 
127        my $qd = $pa->{"QuarantineDir"};
128        my $sl = $self->get_suffixlist(); # array ref
129               
130        opendir(DIR, "$qd/$ad") || Corpus::Quarantine::Submission::Audio::CantOpenDirectory::Exception->throw ("Unable to open file: $qd/$ad");
131        my @dirlist = readdir(DIR);
132        close(DIR);
133        my $audioFileCount = 0;
134        foreach my $file (@dirlist) {
135                chomp ($file);
136                if ($file ne "." and $file ne ".." and $file ne ".svn") {
137                        my ($name,$path,$suffix) = fileparse($file,@$sl);
138                        $name =~ s/\.//;
139                        #if ( $suffixList{$suffix} ) {
140                        if ( grep(/$suffix/, @$sl) ) {  # $suffix could be blank as a result of fileparse...                   
141                                $audioFileCount++;
142                                my $audioType = ucfirst (lc $suffix);
143                                my $audioFile = "Corpus::Quarantine::Submission::Audio::AudioFile::$audioType"->new (
144                                        'audioFile' => $file,
145                                        'path' => "$qd/$ad",
146                                        'filenameNoSuffix' => $name,                                           
147                                        'suffix' => $suffix,   
148                                );
149                                #$self->set_audioFile( $file => $audioFile );           
150                                $self->set_audioFile( $name => $audioFile );    # uses audio file name without a suffix                                                                         
151                        } elsif ($file =~ /\..*/ and $file !~ /\.txt$/ and $file !~ /\~/) {
152                                my $m = "$file wrong suffix (suffix=[$suffix]) type - only " . join(', ', @$sl) . " supported!";
153                                $logger->warn($m);                             
154                                Corpus::Quarantine::Submission::Audio::AudioTypeNotSupported::Exception->throw($m);
155                        }
156                }
157        }       
158        if ($audioFileCount) {
159                $self->audioFileCount( $audioFileCount );
160        } else {
161                my $m = "no audio files in $qd/$ad";
162                Corpus::Quarantine::Submission::Audio::noAudioFiles::Exception->throw (error => $m );           
163        }                               
164}
165
166=head21 downsample
167
168Overloading Class/Instance methods
169
170=cut
171
172sub downsample {
173        my ($type,$p) = @_;
174        if (ref $type) { # being called as an object
175                $type->_downsample_object($p); 
176        } else { # being called as a class (called by Repository.pm)
177                _downsample_class($type,$p);
178        }
179}
180       
181=head3 _downsample_class
182
183=cut
184
185sub _downsample_class {
186        my ($class, $p) = @_;
187        my $dir = $p->{'audioDir'};
188
189        opendir(DIR, "$dir") || Corpus::Quarantine::Submission::Audio::CantOpenDirectory::Exception->throw("Unable to open directory: $dir");
190        my $sl = ["wav", "raw", "flac"]; # Object has not been created yet (i.e. 'new' method not yet called on this class), therefore, Moose has not populated the suffixList attribute yet...
191        while (my $filename = readdir(DIR)) {
192                chomp ($filename);
193                if ( $filename ne "." and $filename ne ".." and $filename ne ".svn" ) {
194                        my ($filename_nosuffix, $path, $suffix) = fileparse($filename, @$sl);
195                        $filename_nosuffix =~ s/\.//;
196                        if ( grep(/$suffix/, @$sl) ) { # $suffix could be blank as a result of fileparse...                     
197                                $logger->debug( "downsampling:$dir/$filename");
198                                my $audioType = ucfirst (lc $suffix);
199                                $p->{'filename'} = $filename;
200                                "Corpus::Quarantine::Submission::Audio::AudioFile::$audioType"->downsampleAudioFile($p);
201                        } else {
202                                $logger->warn( "audio type not supported : $filename" );
203                        }
204
205                } else {
206                        $logger->info( "not an audio file: $filename" );
207                }
208        }
209        close(DIR);
210        return 1;
211}
212
213=head3 _downsample_object
214
215=cut   
216
217sub _downsample_object { # required for forced alignment testing...
218        my ($self, $p) = @_;
219        foreach my $file (sort $self->get_keys_from_audioFiles) {
220                my $afe = $self->get_audioFile($file)->audioFileExceptions;                     
221                unless (grep { $_->isa('Corpus::Quarantine::Submission::Audio::AudioFile::BadAudioFile::Exception') } @$afe) { # don't process if audio file is empty or unreadable
222                        $self->get_audioFile($file)->downsampleAudioFile($p);
223                }
224        }
225}
226
227=head2 copy2ToBeProcessed
228
229The commands used here work on many audio files at once... therefore no subclassing
230
231=cut
232
233sub copy2ToBeProcessed {
234        my ($self, $p) = @_;
235        my $ad = $p->{'audioDirName'};
236        my $ft = $p->{'fileType'};
237        my $pa = $self->parms; 
238        my $qd = $pa->{"QuarantineDir"};       
239        my $tb = $pa->{"ToBeProcessedDir"};
240
241        my $validFileType = grep(/$ft/, @{$self->get_suffixlist});
242        if ( $validFileType ) {
243                switch ($ft) {
244                        case "flac"     {
245                                $command = ("mkdir $tb/$ad/flac");  $logger->debug ( $command ); system ( $command );   
246                                $command = ("cp -f $qd/$ad/flac/*.flac $tb/$ad/flac");  $logger->debug ( $command ); system ( $command );       
247                        } case "wav" {
248                                $command = ("mkdir $tb/$ad/wav");   $logger->debug ( $command ); system ( $command );   
249                                $command = ("cp -f $qd/$ad/wav/*.wav $tb/$ad/wav"); $logger->debug ( $command );system ( $command );   
250                        } else {
251                                my $message = "UserSubmission: copy2ToBeProcessed() error wrong file type (only accept flac or wav) $?" ;       
252                                $logger->debug( $message );             
253                                confess $message;               
254                        }
255                }
256                $logger->info( "***copy2ToBeProcessed: [$ad] [$ft]");
257        } else {
258                my $m = "[$ad] has invalid file type [$ft]";
259                $logger->error($m);                     
260                Corpus::Quarantine::Submission::Audio::invalidAudioType::Exception->throw($m); 
261        }
262}
263
264=head2 finalize
265
266Move audio files to final subdirectory to get them ready for processing
267
268The commands used here work on many audio files at once... therefore no subclassing
269
270=cut
271
272sub finalize {
273        my ($self, $p) = @_;   
274        my $ad = $p->{'audioDirName'};
275        my $ft = $p->{'filetype'};
276        my $pa = $self->{'parms'};
277        my $qd = $pa->{"QuarantineDir"};
278
279        my $validFileType = grep(/$ft/, @{$self->get_suffixlist});
280        if ( $validFileType ) {
281                switch ($ft) {
282                        case "flac"     {               
283                                #$command = ("rm -f $qd/$ad/*.wav");  system($command);
284                                $command = ("mkdir $qd/$ad/etc/wav");  $logger->debug ( $command ); system ( $command );                       
285                                $command = ("mv -f $qd/$ad/*.wav $qd/$ad/etc/wav");$logger->debug ( $command ); system ( $command );   
286                        } case "wav" {                         
287                                $command = ("mkdir $qd/$ad/wav");  $logger->debug ( $command ); system ( $command );   
288                                $command = ("mv -f $qd/$ad/*.wav $qd/$ad/wav");$logger->debug ( $command ); system ( $command );       
289                        } else {
290                                my $m = "UserSubmission: error wrong file type (only accept flac or wav): $?" ;
291                                $logger->error( $m );                           
292                                confess $m;             
293                        }
294                }               
295        } else {
296                my $m = "[$ad] has invalid file type [$ft]";
297                $logger->error($m);                     
298                Corpus::Quarantine::Submission::Audio::invalidAudioType::Exception->throw($m); 
299        }
300        $command = ("rm -f $qd/$ad/*~ $qd/$ad/*.*~"); $logger->debug ( $command ); system ( $command );         
301}
302
303=head2 readSampleData
304
305#todo  optimizing... should downsampling be done here????? (smaller audio file to deal with, same result...quicker to graph things too...)
306
307=cut
308
309sub readSampleData {
310        my ($self, $p) = @_;
311        my $readme = $p->{'readme'};   
312        my $pa = $self->parms; 
313        # !!!!!!
314        my $numberOfFiles = $self->numberOfFiles;
315        my $numberOfBadFiles = 0;
316        # !!!!!!
317       
318        foreach my $file (sort $self->get_keys_from_audioFiles) {
319                eval {
320                        $self->get_audioFile($file)->audioFileSamples( {'readme' => $readme} );
321                };
322                # !!!!!!
323                if (  my $e = Exception::Class->caught('Corpus::Quarantine::Submission::Audio::AudioFile::BadAudioFile::Exception') ) {
324                        $numberOfBadFiles++;
325                # !!!!!!
326                } elsif (  $e = Exception::Class->caught('Corpus::Quarantine::Submission::Audio::AudioFile::DoNotProcessAnyAudioInSubmission::Exception') ) {
327                        $self->doNotProcessAudio(1);
328                        $e->rethrow;
329                } elsif (  $e = Exception::Class->caught() ) {
330                        $e->rethrow;
331                }
332        }
333        # !!!!!!
334        if ($numberOfFiles == $numberOfBadFiles) { # do not process audio if all audio files are bad (i.e. all have undefined samples)
335                        $self->doNotProcessAudio(1);                   
336        }
337        # !!!!!!
338}
339
340=head2 validate2Prompts
341
342Compares prompt count to number of audio files in submission, throws exception if they are different
343
344Check for extra audio files not listed in prompts file
345
346=cut
347
348sub validate2Prompts{
349        my ($self,$p) = @_;     
350        my $prompts = $p->{'prompts'};
351       
352        eval {         
353                if ( $self->audioFileCount != $prompts->get_promptCount ) {
354                        my $m = "Number of prompt lines not equal to number of wav files";
355                        $self->doNotProcessAudio(1);                   
356                        Corpus::Quarantine::Submission::Audio::NumPromptsNENumAudioFiles::Exception->throw (error => $m );                             
357                }
358        };
359        if (  my $e = Exception::Class->caught('Corpus::Quarantine::Submission::Audio::NumPromptsNENumAudioFiles::Exception') ) { $e->rethrow }
360        elsif (  $e = Exception::Class->caught() ) { $e->rethrow }; # known exceptions already caught, this is an unknown error...
361               
362        my $promptsRef = $prompts->get_prompts();
363        foreach my $file (sort $self->get_keys_from_audioFiles) {
364                my $afe = $self->get_audioFile($file)->audioFileExceptions;
365                unless (grep { $_->isa('Corpus::Quarantine::Submission::Audio::AudioFile::BadAudioFile::Exception') } @$afe) { # don't process if audio file is empty or unreadable
366                        eval {
367                                my $fi = $self->get_audioFile($file)->get_filenameNoSuffix;
368                                unless ( $promptsRef->{ $fi } ) {        # look for audio file in prompt list, if cannot find, throw exception
369                                        my $m =  "can't find audio file in prompt list: $file\n";
370                                        $logger->warn($m);
371                                        Corpus::Quarantine::Submission::Audio::AudioFileNotInPrompts::Exception->throw (error => $m );
372                                }                                               
373                        };
374                        if (  my $e = Exception::Class->caught('Corpus::Quarantine::Submission::Audio::Exception') ) { push @$afe, $e; }
375                        elsif (  $e = Exception::Class->caught() ) { $e->rethrow }                                             
376                }                               
377        }
378}
379
380
381=head2 validate2Readme
382
383makes sure that audio corresponds to readme info, if not, throws exception
384
385=cut
386
387sub validate2Readme {
388        my ($self,$p) = @_;     
389        my $readme = $p->{'readme'};
390        eval {
391                foreach my $file (sort $self->get_keys_from_audioFiles) {       
392                        my $afe = $self->get_audioFile($file)->audioFileExceptions;
393                        unless (grep { $_->isa('Corpus::Quarantine::Submission::Audio::AudioFile::BadAudioFile::Exception') } @$afe) { # don't process if audio file is empty or unreadable
394                                $self->get_audioFile($file)->audioFile2Readme( {'readme' => $readme} );
395                        }                               
396                }       
397        };
398        if (  my $e = Exception::Class->caught('Corpus::Quarantine::Submission::Audio::AudioFile::DoNotProcessAnyAudioInSubmission::Exception') ) {
399                $self->doNotProcessAudio(1);   
400                $e->rethrow
401        } elsif (  $e = Exception::Class->caught() ) { $e->rethrow };
402}
403
404=head2 validate
405
406performs 3 types of simplistic audio validation:
407
408audioFileZeroOffset
409audioFileVolume
410audioFileHeadTailSilenceE (using short-term Energy)
411
412=cut
413
414sub validate {
415        my ($self,$p) = @_;     
416        my $readme = $p->{'readme'};
417
418        eval { # try   
419                foreach my $file (sort $self->get_keys_from_audioFiles) {
420                        my $afe = $self->get_audioFile($file)->audioFileExceptions;
421                        unless (grep { $_->isa('Corpus::Quarantine::Submission::Audio::AudioFile::BadAudioFile::Exception') } @$afe) { # don't process if audio file is empty or unreadable             
422                                $self->get_audioFile($file)->audioFileZeroOffset;
423                                $self->get_audioFile($file)->audioFileVolume;
424                                $self->get_audioFile($file)->audioFileHeadTailSilenceE;                         
425                        }
426                }
427        };
428        if (  my $e = Exception::Class->caught() ) { $e->rethrow }; # known exceptions already caught, this is an unknown error...
429}
430
431=head2 validateAudio2Prompts
432
433Uses HTK and Julius to perform validation on audio:
434  audioForceAlign (HTK)
435  audioConfidence (Julius)
436
437        # todo need to force align and get confidence scores on a single audio file at a time, therefore can get partial processing....
438        # if updating this or other languages, need to set VALIDATION-PROMPTS for the new language in PROMPTS->_clean in PROMPTS subclass
439
440        # audioExceptions attribute is required because we want to perform both forcealign and confidence testing
441        # on the audio, in order to get as much info on the audio as possible...
442       
443=cut
444
445sub validateAudio2Prompts {
446        my ($self,$p) = @_;
447        my $pa = $self->parms; 
448        my $prompts = $p->{'prompts'}; 
449        my $ad = $self->audioDirName;
450        my $qd = $pa->{"QuarantineDir"};       
451        my $ae = $self->get_audioExceptions();
452        my $dir = $self->get_tempDir;
453        $logger->debug ( "validateAudio2Prompts TempDir: $dir" );
454
455        $command = ("rsync -r --exclude=.svn $qd/$ad $dir"); $logger->debug ( $command ); system ( $command );         
456       
457        # todo why do this here, why not downsample when samples are being read
458        eval {
459                $self->downsample( { 'audioDir' => "$dir/$ad", 'targetRate'=> 16000} )
460        };
461        if (  my $e = Exception::Class->caught() ) { $e->rethrow }
462       
463        # todo !!!!!! wav format not abstracted out???
464        # todo this might be a good spot to pass in the audio object and remove prompts whose
465        #      audio files are borked... need to make sure this is reflected in prompts list
466        $prompts->createFileList({'dir'=>$dir, 'suffix'=>'wav'});
467       
468        eval {
469                $self->audioForceAlign($p);
470        };
471        if (  my $e = Exception::Class->caught('Corpus::Quarantine::Submission::Audio::Exception') ) {
472                push @$ae, $e;
473        }
474        elsif (  $e = Exception::Class->caught() ) { $e->rethrow }
475       
476        eval {
477                $self->processForceAlign();
478        }; # exceptions processed in AudioFile.pm
479        if (  my $e = Exception::Class->caught('Corpus::Quarantine::Submission::Audio::Exception') ) {
480                push @$ae, $e;
481        }
482        elsif (  $e = Exception::Class->caught() ) { $e->rethrow }
483       
484        eval {
485                $self->audioConfidence($p);
486        };
487        if (  my $e = Exception::Class->caught('Corpus::Quarantine::Submission::Audio::Exception') ) {
488                push @$ae, $e;
489        }
490        elsif (  $e = Exception::Class->caught() ) { $e->rethrow }
491       
492        eval {
493                $self->processAudioConfidence ($p);
494        }; # exceptions processed in AudioFile.pm
495        if (  my $e = Exception::Class->caught('Corpus::Quarantine::Submission::Audio::Exception') ) {
496                push @$ae, $e;
497        }
498        elsif (  $e = Exception::Class->caught() ) { $e->rethrow }
499}
500
501=head2 audioForceAlign
502
503 # uses HVite Forced Alignment; only really catches major prompt speech audio mismatches
504
505=cut
506
507sub audioForceAlign {
508        my ($self,$p) = @_;
509        my $prompts = $p->{'prompts'};
510        my $parms = $self->parms;
511        my $audioDirName = $self->audioDirName;
512        my $quarantineDir = $parms->{"QuarantineDir"};
513        my $htk = $parms->{"HTKBin"};   
514        my $dir = $self->get_tempDir;
515        my $lexiconDirectory = $parms->{"LexiconDirectory"};   
516        my $amDir = $parms->getValidationAcousticModel( $p->{'language'} );
517
518        $prompts->createWordsMlf({'dir'=>$dir});
519        my $cwd = getcwd;       
520        #my $amDir = "$cwd/$acousticModel";
521    $logger->debug ( "amDir = " . $amDir );
522    if (! -e "$amDir/macros")
523    {
524       $self->doNotProcessAudio(1);
525           Corpus::Quarantine::Submission::Audio::FileError::Exception->throw("HVite can't find $amDir/macros") ;
526    }
527    if (! -e "$amDir/hmmdefs")
528    {
529       $self->doNotProcessAudio(1);
530       Corpus::Quarantine::Submission::Audio::FileError::Exception->throw("HVite can't find $amDir/hmmdefs") ;
531    }   
532       
533        $command = (
534                "cd $dir/$audioDirName && " .
535                "$htk/HVite -A -D -T 1 -l '*' -a -b SENT-END -m " .
536                "-C $cwd/lib/Corpus/Quarantine/Submission/Audio/wav_config " .
537                "-H $amDir/macros " .
538                "-H $amDir/hmmdefs " .
539                "-m -t 250.0 150.0 1000.0 " .
540                "-I $dir/words.mlf " .
541                "-i $dir/aligned.out " .
542                "-S $dir/fileList " .
543                "$lexiconDirectory/VoxForge/VoxForgeDict " .
544                "$amDir/tiedlist " .
545                "2>&1"
546        );
547        $logger->debug ( $command );
548        my @htk_output;
549        eval {  # todo does capture even work within an eval???
550                #@htk_output = capture ($command);
551                @htk_output = `$command`;               
552        };
553        warn "audioForceAlign $@" if $@; # !!!!!!  is this correct?????
554       
555        $logger->debug( $self->_addProcessID( {'message'=>\@htk_output, 'type'=>'INFO'} ) );           
556
557        $self->forcedAlignment(\@htk_output);
558        open (HVite_Log, ">$quarantineDir/$audioDirName/HVite_log") || Corpus::Quarantine::Submission::Audio::FileError::Exception->throw("Unable to open file for writing: $quarantineDir/$audioDirName/HVite_log");
559        foreach my $line (@htk_output) {
560                print HVite_Log $line;
561        }
562        close (HVite_Log);
563       
564        # !!!!!! move this???
565        $command = ("rm -f $quarantineDir/$audioDirName/VALIDATION-PROMPTS"); $logger->debug ( $command ); system ( $command );         
566}
567
568=head2 processForceAlign
569
570# process HVite Forced Alignment output
571
572=cut
573
574sub processForceAlign {
575        my ($self) = @_;
576        my $ad = $self->audioDirName;
577                       
578        my $filename;
579        my $maxBeam = 250;
580        my $audioFile;
581        my $suffixlist = $self->get_suffixlist(); # array ref           
582       
583        my $arrayRef = $self->get_forcedAlignment;
584        foreach my $line ( @$arrayRef ) {
585                chomp $line;
586                switch ($line) {
587                        case /Aligning File:/   {               
588                                my @line=split(/ /, $line);
589                                my $wavFilePath = pop (@line);
590                                $filename = basename("$wavFilePath");
591                               
592                                # !!!!!! this is not working for flac audio, since file name has .wav suffix and flac file has flac suffix in audioFilesCollection
593                                #$audioFile = $self->get_audioFile($filename);
594                                my ($name,$path,$suffix) = fileparse($filename,@$suffixlist);
595                                $name =~ s/\.//g;                                       
596                                $audioFile = $self->get_audioFile($name);# need to lookup audioFilesCollection using audio file name without suffix     
597                                if (! defined $audioFile) { # !!!!!!
598                                        my $m =  "can't find audio $name; likely an audio file suffix ($suffix) issue...\n";
599                                        $logger->error($m);
600                                        Corpus::Quarantine::Submission::Audio::CantFindAudioFile::Exception->throw (error => $m );
601                                }                               
602                        } case /No tokens survived to final node of network at beam (\d+)/      {                                       
603                                my @line=split(/ /, $line);
604                                my $beam = pop (@line);
605                                $beam =~ s/ //g;
606                                my $m =  "$filename check that audio corresponds to prompt in file: beam:[$beam]" ;                                     
607                                if ($beam > $maxBeam) {
608                                        eval {
609                                                $audioFile->audioFileForceAlignException($m);
610                                        };
611                                        if ( my $e = Exception::Class->caught() ) { $e->rethrow }       ;
612                                }       
613                        } case /No tokens survived to final node of network at beam$/   { # past threshold...
614                                my @line=split(/ /, $line);
615                                my $beam = pop (@line);
616                                $beam =~ s/ //g;
617                                my $m =  "$filename No tokens survived to final node of network at beam" ;                                     
618                                eval {
619                                        $audioFile->audioFileForceAlignException($m);
620                                };
621                                if ( my $e = Exception::Class->caught() ) { $e->rethrow }       ;
622                        }
623                }       
624        }
625        return 1;
626}
627
628=head2 audioConfidence
629
630The audioConfidence method is using a full VoxForge acoustic model to do some rudimentary recognition using a simple grammar that contains
631the actual prompts that were read by the user. 
632
633uses Julius Grammar recognition to obtain grammar scores
634
635        # todo need to add random grammar entries to make recognition results more accurate, or use a statistical language model.
636
637        # todo need to recompile Julius... currently using Fast Julius...
638        # todo might make more sense to try to recognize each file individually - easier to create objects from the results...
639
640=cut
641
642sub audioConfidence {
643        my ($self,$p) = @_;
644        my $parms = $self->parms;
645        my $jl = $parms->{"JuliusBin"};
646        my $ad = $self->audioDirName;
647        my $qd = $parms->{"QuarantineDir"};     
648        my $prompts = $p->{'prompts'};
649        my $dir = $self->get_tempDir;           
650        my $amDir = $parms->getValidationAcousticModel( $p->{'language'} );
651               
652        # todo throwing back a reference to prompts in $p???
653        $prompts->createJuliusGrammar( {'tempDir' => $dir } );
654
655        #my $cwd = getcwd;              #
656        #my $amDir = "$cwd/$acousticModel";
657       
658        $logger->debug ( "amDir = " . $amDir );
659    if (! -e "$amDir/macros")
660    {
661       $self->doNotProcessAudio(1);
662       Corpus::Quarantine::Submission::Audio::FileError::Exception->throw("Julius can't find $amDir/macros") ;
663    }
664    if (! -e "$amDir/hmmdefs")
665    {
666       $self->doNotProcessAudio(1);
667       Corpus::Quarantine::Submission::Audio::FileError::Exception->throw("Julius can't find $amDir/hmmdefs") ;
668    }   
669       
670        $command = ("$jl/julius -multipath -norealtime -b 500 -b2 500 -input rawfile -filelist $dir/fileList -dfa $dir/$ad.dfa -v $dir/$ad.dict -h $amDir/hmmdefs -hlist $amDir/tiedlist -smpFreq 16000  2>&1 "); $logger->debug ( $command );
671
672    $logger->debug( $command );     
673        my @julius_output;
674
675        eval {
676                @julius_output = `$command`; # use backtick; capture not working as expect
677        }; # to isolate Julius bombs
678        warn "audioConfidence $@" if $@; # !!!!!!  is this correct?????
679       
680        $logger->debug( $self->_addProcessID( {'message'=>\@julius_output, 'type'=>'INFO'} ) );         
681       
682        # eval/catch does not work with external command like Julius
683       
684        $self->confidenceScores(\@julius_output);       
685        open (Julius_Log, ">$qd/$ad/Julius_log") || Corpus::Quarantine::Submission::Audio::FileError::Exception->throw("Unable to open file for writing: $qd/$ad/Julius_log");
686        foreach my $line (@julius_output) {
687                print Julius_Log $line;
688        }
689        close (Julius_Log);     
690}
691
692=head2 processAudioConfidence
693
694# process Confidence Scoring
695
696=cut
697
698sub processAudioConfidence {
699        my ($self,$p) = @_;     
700        my $prompts = $p->{'prompts'};
701        #my $ad = $self->audioDirName;         
702        my $pr = $prompts->get_prompts;         
703        my $speechFile;
704        my @recognizedPrompts;
705        my $filename;
706        my $promptId;
707        my $audioFile;
708        my $suffixlist = $self->get_suffixlist(); # array ref   
709       
710        my $arrayRef = $self->get_confidenceScores();
711       
712        my $arrayScalar = join(' ',@$arrayRef );
713        if ($arrayScalar =~ /ERROR: failed to read dictionary/ ) {
714                # word exists in pronunciation dictionary because the HDMan_log was reviewed in Prompts->validateAgainstDict method
715                my $m = "Julius Error: word exists pronunciation dict, but AM is missing a triphone hmm for this word - no audio processed, see log file (acoustic model needs to be trained with words containing missing triphones)";
716                $logger->debug( $self->_addProcessID( {'message'=>$m, 'type'=>'ERROR'} ) );                             
717                Corpus::Quarantine::Submission::Audio::juliusTriphoneNotFound::Exception->throw ( $m );                         
718        }
719        foreach my $line ( @$arrayRef ) {
720                chomp $line;
721                # "adin_file: error in parsing wav header at" occurs when Julius tries to process zero length audio files;
722                # Julius doe not create a "input speechfile:" in such cases
723                # todo: remove bad audio from prompts file
724                if ($line =~ /input speechfile:|adin_file: error in parsing wav header at|adin_file: failed to read speech data:/) {
725                        my @lineArray = split (/\s/,$line);
726                        $speechFile = pop @lineArray;
727                        my @speechFile = split (/\//,$speechFile);
728                        $filename = pop @speechFile;
729                        $promptId = $filename;
730                        $promptId =~ s/\.wav//;
731                        # # !!!!!! this is not working for flac audio, since file name has .wav suffix and flac file has flac suffix in audioFilesCollection
732                        #$audioFile = $self->get_audioFile($filename);
733                        my ($name,$path,$suffix) = fileparse($filename,@$suffixlist);   
734                        $name =~ s/\.//g;       
735                        $audioFile = $self->get_audioFile($name); # need to lookup audioFilesCollection using audio file name without suffix                                                   
736                        if (! defined $audioFile) { # !!!!!!
737                                my $m =  "can't find audio $name; likely an audio file suffix ($suffix) issue...\n";
738                                $logger->error($m);
739                                Corpus::Quarantine::Submission::Audio::CantFindAudioFile::Exception->throw (error => $m );
740                        }
741                } elsif ($line =~ /sentence1:/) {       # compare recognized prompts with actual prompts                       
742                        my $newLine = $line;
743                        $newLine =~ s/sentence1: <s> //;
744                        $newLine =~ s/ <s>//;
745                        @recognizedPrompts = split (/\s/,$newLine);
746                        my $error = $self->_comparePromptLists( {'prompts' => $pr->{$promptId}, 'recognized' => \@recognizedPrompts} );                         
747                        if ( $error ) {
748                                my $m = "$promptId: recognized words do not match prompt line!";
749                                eval { $audioFile->audioFileConfidenceScoreException($m) };
750                                if ( my $e = Exception::Class->caught() ) { $e->rethrow }
751                        }
752                } elsif ($line =~ /<search failed>/) { # monitor Julius return value for failed recognition                             
753                        my $m = "$filename <search failed> error";
754                        $audioFile->audioFileConfidenceScoreException($m);
755                } elsif ($line =~ /adin_file: failed to read speech data:/) { # only occurs if there is a problem with the wav file (no audio, ...)                             
756                        my $m;
757                        if ( defined $speechFile) {
758                                $m = "$line $speechFile";
759                        } else { # catches case where first wav file is empty or has problems
760                                my @lineArray = split (/\s/,$line);
761                                $speechFile = pop @lineArray; # pop file name with path in double quotes
762                                $speechFile =~ s/\"//g; # remove double quotes
763                                my @speechFile = split (/\//,$speechFile);
764                                $filename = pop @speechFile; # pop off file name
765                                $m = "Error: audio file is empty: $filename($line)";                                   
766                        }
767                        $audioFile->audioFileJuliusException($m);
768                }
769        }
770}
771
772=head2 _comparePromptLists
773
774Compares two lists of prompts and returns true if they exactly match
775
776        # todo test for deletions - ie return which words were deleted
777        # todo test for insertions - ie return which words were inserted
778        # test for same number of elements in both arrays - not required with current test...
779
780=cut
781
782sub _comparePromptLists {
783        my ($self, $p) = @_;
784        my $prompts = $p->{'prompts'};
785        my $recognized = $p->{'recognized'};
786
787        my $pr = join "", @$prompts;
788        my $re = join "", @$recognized;
789        if ($pr ne $re) {
790                return 1;
791        }
792        return 0;
793}
794
795=head2 _comparePromptLists
796
797# change this to a Moose role
798       
799=cut
800
801sub _addProcessID {
802        my ($self,$p) = @_;
803        my $m = $p->{'message'};
804        my $ty = $p->{'type'} || 'DEBUG';       
805        my $pidMessage = "";
806        if ( (ref $m) =~ /ARRAY/ ) {
807                print "\n";
808                my $pidMessage = "\n";         
809                foreach my $line (@$m) {
810                        $pidMessage = $pidMessage . " $$ $ty $line";
811                }
812                return $pidMessage;
813        } else {   # assume it is a string
814                my @message = split /\n/, $m;
815                my $pidMessage = "\n";         
816                foreach my $line (@message) {
817                        $pidMessage = $pidMessage . " $$ $ty $line\n";
818                }
819                return $pidMessage;             
820        }
821}
822
823=head2 graph
824
825Loops over the list of audio files and calls graphAudioFile for each
826       
827=cut
828
829sub graph {
830        my ($self,$p) = @_;     
831        foreach my $file (sort $self->get_keys_from_audioFiles) {
832                my $afe = $self->get_audioFile($file)->audioFileExceptions;
833                unless (grep { $_->isa('Corpus::Quarantine::Submission::Audio::AudioFile::BadAudioFile::Exception') } @$afe) { # don't process if audio file is empty or unreadable
834                        eval { 
835                                $self->get_audioFile($file)->graphAudioFile( $p );                             
836                        };
837                        if (  my $e = Exception::Class->caught() ) { $e->rethrow }
838                }
839        }
840}
841
842=head2 HTML
843
844generates audio HTML
845
846todo: perform AudioFile HTML processing in the AudioFile.pm class
847
848=cut
849       
850sub HTML {
851        my ($self, $p) = @_;
852        my $path = $p->{'path'};
853        my $prompts = $p->{'prompts'};
854        my $readme= $p->{'readme'};
855        my $html='';
856       
857        my $exceptionList = $self->get_audioExceptions;
858        if ( $exceptionList ) {
859                foreach my $exception (@$exceptionList) {
860                        $html = $html . "<p><FONT COLOR=\"RED\"><b>". ref ($exception) ." $exception</b></FONT></p>\n";
861                }
862        }
863               
864        my $promptsRef = $prompts->get_prompts();
865        foreach my $file (sort $self->get_keys_from_audioFiles) {
866                my $afe = $self->get_audioFile($file)->audioFileExceptions;
867                my $fn = $self->get_audioFile($file)->get_filenameNoSuffix;
868                my $promptScalar;
869                if (grep { $_->isa('Corpus::Quarantine::Submission::Audio::AudioFileNotInPrompts::Exception') } @$afe) {
870                        $promptScalar = "can\'t find prompt line for: $fn\n";
871                } else {
872                        my $promptArrayref = $promptsRef->{ $fn };
873                        $promptScalar = join(" ", @$promptArrayref );
874                }       
875                if (@$afe) {
876                        $html = $html . "<p><FONT COLOR=\"RED\"><b>$file</b> $promptScalar</FONT></p>\n";
877                } else {
878                        $html = $html . "<p><b>$file</b> $promptScalar</p>\n";                 
879                }
880               
881                $html = $html . "<div align=\"center\">";                       
882                $html = $html . "<UL>\n";
883                foreach my $e (@$afe) {
884                        $html = $html . "<LI><b>" . ref ($e) . "</b></LI>\n";
885                        $html = $html . "<UL><LI>\t$e</LI></UL>\n";
886                }
887                $html = $html . "</UL>\n";                     
888                $html = $html . "</div>\n";
889                if (grep { $_->isa('Corpus::Quarantine::Submission::Audio::AudioFile::BadAudioFile::Exception') } @$afe) { # don't process if audio file is empty or unreadable
890                        $html = $html . "<p>Corpus::Quarantine::Submission::Audio::AudioFile::BadAudioFile::Exception</p>\n";   
891                } else {
892                        $html = $html . "<div align=\"center\">";               
893                        my $tempFile = $self->get_audioFile($file)->get_audioFile; # use get_audioFile for non-Wav audio (Flac & Raw...), since audioFile gets renamed in convert2wav, but the key ($file) does not
894                        if ($path) {
895                                $html = $html . "<audio src=\"$path/wav/$tempFile\" controls=\"controls\">\nYour browser does not support the audio element.</audio>\n";
896                        } else {
897                                if ($readme->filetype eq 'wav') {
898                                        $html = $html . "<audio src=\"../wav/$tempFile\" controls=\"controls\">\nYour browser does not support the audio element.</audio>\n";
899                                } else {
900                                        $html = $html . "<audio src=\"wav/$tempFile\" controls=\"controls\">\nYour browser does not support the audio element.</audio>\n";
901                                }
902                        }
903                        $html = $html . "</div>\n";
904
905                        $html = $html . "<div align=\"center\">";                       
906                        my $graphArray = $self->get_audioFile($file)->get_graphPath;
907                        if ($path) {
908                                foreach my $graph (@$graphArray) {
909                                        $html = $html . "<img src=\"$path/$graph\" >\n";
910                                }
911                        } else {
912                                foreach my $graph (@$graphArray) {
913                                        $html = $html . "<img src=\"$graph\" >\n";
914                                }                               
915                        }
916                        $html = $html . "</div>\n";     
917                        $html = $html . "<hr width=\"75%\" size=2 color=\"black\"> \n";
918                }
919        }
920        $self->html($html);
921}
922
923=head2 compactAudioObjects
924
925        # remove audio samples from AudioFile object - no need to serialize all audio samples (i.e. Freeze/Thaw) ...
926       
927=cut
928
929sub compactAudioObjects {
930        my ($self) = @_;       
931        foreach my $file (sort $self->get_keys_from_audioFiles) {       
932                $self->get_audioFile($file)->graphX( [] );             
933                $self->get_audioFile($file)->zeroCross( [] );           
934                $self->get_audioFile($file)->energy( [] );             
935                $self->get_audioFile($file)->frequencyX( [] );         
936                $self->get_audioFile($file)->frequencyY( [] ); 
937        }       
938}
939
9401;
Note: See TracBrowser for help on using the repository browser.