Speech::Recognizer::ScLite - Object-based wrapper around the C<sclite>

  # gather the correct and hypothesized readings any way you like. 
  # here I assume you have them in two text files that can be parsed
  # successfully by the toy sub read_trans below.
  my (%correct_readings) = read_trans('correct.txt');
  my (%hyp_readings) = read_trans('hypotheses.txt');

  # real work begins here
  use Speech::Recognizer::ScLite;

  # alter the default ('sclite') executable-name or a path to it
  Speech::Recognizer::ScLite->executable( 
				 '/usr/site/bin/SCTK-1-04/sclite-1-04' );

  my ($scorer) = 
    Speech::Recognizer::ScLite->new( 'result_location' => './test_17',
				     id => 'Sex'); 
                                     # that oughtta increase the CPAN hits

  foreach my $line (sort keys %hyp_readings) {
    # construct an object to represent this version
    # construct any sort key you want. Here we assume that we're
    # interested in breaking out the files based on which directory
    # they're in.
    my ($l) = 
      Speech::Recognizer::ScLite::Line->new( 
					 ref => $correct_readings{$line},
					 hyp => hyp_readings{$line},
					 sort_key => getSort($line)
					 );

    $scorer->lines_push($l);

  } # end of looping over the filenames.

  # computes actual ASR performance, given above information
  $scorer->score();

  # dumps a wordy report into the ->result_location;
  #  $scorer->report(); # currently a no-op since score() invokes
  # reporting function within the sclite utility itself




  ################################################################
  # toy subs defined below for the sake of the completeness of the
  # example. 
  sub read_trans {
    my (%transcriptions);
    open (FILE, shift); # or die, of course
    while (<FILE>) {
      chomp;
      my ($trans, $file) = split;
      $transcriptions{$file} = $trans;
    }
    close FILE; # or die, of course
    return %transcriptions;
  }
  # this toy sort routine returns the sex of the speaker as the sort
  # key, rather than the (default) speaker directory.
  sub getSort {
    my ($filename) = shift;
    return ($filename =~ /female/i ? 'Female' : 'Male');
  }

  http://www.nist.gov/speech/tools/index.htm

package Speech::Recognizer::ScLite;

use 5.006;
use strict;
use warnings;
use Carp;

# directory maintenance
use Cwd 'cwd', 'chdir';
use File::Spec::Functions 'rel2abs', 'curdir';

our $VERSION = '0.01';
##################################################################
# set up a whole bunch of default object management code.
# ask Class::MethodMaker to build methods:
use Class::MethodMaker
    # constructor that calls 'init'
    new_with_init => 'new',

    # initializer that sets an instance's data from a hash
    new_hash_init => '_hash_init',

    # methods to access/modify scalar data fields
    get_set => [ qw / result_location _invoke_loc / ], 

    static_get_set => [ 'executable' ],

    # scalars must be unique within class:
    key_attrib => 'id',

    # methods to access the internal list of lines
    object_list => [ 'Speech::Recognizer::ScLite::Line' =>
		     { 
			 slot => 'lines',
#			 comp_mthds => [ ]
		     } 
		   ],

    # methods to access internal state
    # (private by convention of leading _)
    boolean => '_scored'; 

##################################################################
# defaults to be overridden during init()
my (%init_defaults) = 
    (result_location => curdir, # default current location
     id => 'ScLite'); # if ya don't like it, change it
##################################################################
sub init($;%) {

    my ($self) = shift;
    my ($class) = ref $self;

    # override init_defaults with user supplied values
    my (%args) = (%init_defaults, @_); 
    
    # any missing error checking?

    if (not defined $class->executable) {
	$class->executable ( 'sclite' );
    }
   
    my ($cwd) = cwd();

    # absolutize the result_location
    $args{result_location} = rel2abs( $args{result_location}, $cwd );

    if ($class->find_id($args{id})) {
	carp "value '" . $args{id} . " already registered, " .
	    "overwriting files";
    }

    # remember directory in which I was invoked
    $args{_invoke_loc} = $cwd;

    # illegal user values will throw exceptions inside _hash_init
    $self->_hash_init(%args);
}
##################################################################
sub clear($) {
    my ($self) = shift;
    croak "expect 0 arguments to ->clear()" if scalar @_;
    
    $self->lines_clear();
}
##################################################################
sub id_keys($) {
    my ($class) = shift;
    return sort keys %{$class->find_id};
}
##################################################################
sub all($) {
    my ($class) = shift;
    return $class->find_id($class->id_keys);
}
##################################################################
sub score($) {
    my ($self) = shift;

    # check for user argument errors
    croak "unexpected arguments to ->score()" if scalar @_;

    # check that $self 's appropriate fields have been set?
    carp "already scored '" . $self->id . "', re-scoring"
	if $self->_scored;
    
    # get a temporary dir
    use File::Temp 'tempdir';
    my ($tempdir) = tempdir(CLEANUP => 1); 

    # hang on to the working directory so we can go back to it.
    my ($wd) = cwd(); 

    # chdir to the tempdir:
    chdir $tempdir or die "couldn't chdir to $tempdir";

    # get filehandles for new files
    my ($reffile) = $self->id . '.ref';
    my ($hypfile) = $self->id . '.hyp';
    my ($refFH) = _getFH($reffile);
    my ($hypFH) = _getFH($hypfile);

    # write the hyp & ref files
    foreach my $l ($self->lines) {
	$l->_write_ref($refFH);
	$l->_write_hyp($hypFH);
    }

    # close the filehandles
    $refFH->close() or die "couldn't close $reffile";
    $hypFH->close() or die "couldn't close $hypfile";
    
    # do the actual scoring
    my ($rc) = system ($self->_get_cmd($reffile, $hypfile, $wd));

    # decide what to do based on return code?

    # chdir back to original working directory
    chdir $wd or die "couldn't chdir back to $wd after scoring";

    # remember that we've done this
    $self->set__scored();

    return $rc << 8;
}
##################################################################
sub score_all {
    my ($class) = shift;
    foreach ($class->all) {
	$_->score();
    }
}    
##################################################################
# private instance method to determine all the necessary command
# options 
sub _get_cmd ($$$$) {
    my ($self) = shift;
    my ($class) = ref ($self);
    my ($ref, $hyp, $wd) = @_;
    confess "bad args to _get_cmd" unless @_ == 3;

    my (@items) = $class->executable;
    
    push @items, '-i', 'swb'; # why do I need this?
    push @items, '-o', 'dtl', 'spk', 'all'; # check these scoring options

    # this makes report() function a no-op in this version
    push @items, '-O', rel2abs( $self->result_location, $self->_invoke_loc );

    push @items, '-r', $ref;
    push @items, '-h', $hyp;

    return @items;
}     
##################################################################
sub _getFH ($) {
    use FileHandle;
    my ($filename) = shift;
    my ($fh) = new FileHandle ">$filename";
    if (not defined $fh) {
	die "couldn't open $filename in " . cwd() . "\n";
    }
    return $fh;
}
##################################################################
sub report() {
#      my ($self) = shift;

#      # check for user argument errors
#      croak "unexpected arguments to ->report()" if scalar @_;

#      # check that $self's appropriate fields have been set
#      if (not defined $self->result_location) {
#  	use Cwd 'cwd';
#  	$self->result_location( '.' );
#  	$self->result_location( rel2abs( $self->result_location )  );
#      }
	

#      # ensure we've actually done the score() call
#      croak "you seem to have called ->report() without calling " .
#  	"->score()." unless $self->_scored;

#      # copy the files to the right location
}
    
##################################################################
1;
__END__
# Documentation below