Words, words, words

#!/usr/bin/perl use strict; use warnings; use CGI qw/:standard/; use Digest::SHA qw/sha256_hex/; use POSIX qw/WIFEXITED WEXITSTATUS/; use constant SAMPLE_RATE => 22050; use constant MP2_KBIT_RATE => 48; use constant MP2_CACHE_DIR => 'mp2-cache'; use constant MP2_SUFFIX => '.mp2'; use constant WORD_WAVE_DIR => 'wav-source'; use constant WORD_WAVE_SUFFIX => '.wav'; use constant WORD_WAVE_SUFFIX_MATCH => qr/\.wav\z/; use constant WORD_WAVE_SUFFIX_LEN => length(WORD_WAVE_SUFFIX); opendir D, WORD_WAVE_DIR or die "opendir: $!\n"; my @valid_words = map{/^(.+)@{[WORD_WAVE_SUFFIX_MATCH]}\z/? ($1) : ()} readdir(D); closedir D; tr/_/ / for @valid_words; if (defined param('list')) { print header(-type => 'text/html'); for my $word (sort @valid_words) { print '', escapeHTML($word), ''; } exit; } my $valid_word_regexp_body = join('|', map{quotemeta} @valid_words); my $valid_word_regexp = qr/ ($valid_word_regexp_body)/; my $text = ' ' . lc param('w'); $text =~ s/\s+/ /g; $text =~ s/ \z//; my $output_path = MP2_CACHE_DIR . '/' . sha256_hex($text) . MP2_SUFFIX; my @words = (); while ($text =~ s/^$valid_word_regexp//) { push @words, $1; } if (length $text) { print header(-type => 'text/html'); print '

Hmm, invalid input.

'; exit; } generate_mp2($output_path, \@words) unless -r $output_path; print header(-type => 'text/html'); printf '', escapeHTML($output_path); exit; sub generate_mp2 { my ($output_path, $words) = @_; my $twolame_pid; local (*TWOLAME, *TWOLAME_IN, *SOX, $_); pipe(TWOLAME_IN, TWOLAME) or die "pipe: $!\n"; defined($twolame_pid = fork) or die "fork: $!\n"; if ($twolame_pid == 0) { # my $log_path = $output_path . '.log'; my $log_path = '/dev/null'; open STDIN, '<&', \*TWOLAME_IN; open STDOUT, '>>', $log_path or die "reopen stdout: $!\n"; open STDERR, '>>', $log_path or die "reopen stderr: $!\n"; close TWOLAME; exec qw'twolame -r -s', SAMPLE_RATE, qw'-N 1 -b', MP2_KBIT_RATE, qw'-', $output_path or die "exec twolame: $!\n"; } close TWOLAME_IN; binmode TWOLAME or die "binmode twolame: $!\n"; for my $word (@$words) { my $word_basename = $word; $word_basename =~ tr/ /_/; my $word_path = sprintf '%s/%s%s', WORD_WAVE_DIR, $word_basename, WORD_WAVE_SUFFIX; open SOX, '-|', 'sox', $word_path, qw'-r', SAMPLE_RATE, qw'-c 1 -t sw -' or die "open sox: $!\n"; binmode SOX or die "binmode sox: $!\n"; while (read SOX, $_, 4096) { print TWOLAME $_; } close SOX or die "close sox: $!\n"; } close TWOLAME or die "close twolame: $!\n"; waitpid $twolame_pid, 0 or die "waitpid twolame: $!\n"; (WIFEXITED($?) and WEXITSTATUS($?) == 0) or die "twolame exit status: $?\n"; }