#!/usr/bin/perl # # mkRecCond.pl # # Version 1.0 # # (C) Copyright 1999, Chr. Draxler # # creates a recording condition table file for SpeechDat-Car # recordings from the SpeechDat-Car label files in the local # file system # # History # 1.0: initial release # -- change the following variables to suit your language and system ----- $langCode = 'DE'; # German $lblExt = ".$langCode" . 'C'; # label file extension "DEC" $dbName = 'VEHIC1' . $langCode; # Database name $fileDlm = ':'; # OS file system delimiter (UNIX:/, Windows:\) # -- command line arguments for work (=source) root directory and target directory --- # #if (int(@ARGV) < 2) { # die "\nusage: mkRecCond.pl WORKDIR TARGETDIR\n\n"; #} else { # $workDir = $ARGV[0]; # $targetDir = $ARGV[1]; #} # -- on the Mac, ask for these values interactively ------------------------ # $workDir = MacPerl::Ask('SAM label file root directory',':SAMFiles:VEHIC1DE:PLTM_C:' . $dbName . $fileDlm); $targetDir = MacPerl::Ask('Target directory',':SAMFiles:VEHIC1DE:TABLE:'); # -- create session table in target directory ------------------------------ # -- target directory must exist! $outFile = $targetDir . 'REC_COND.TBL'; $outFileOrg = $outFile; $cnt=0; while(-e $outFile) { $cnt++; $outFile = $outFileOrg . '.' . $cnt; } open(OUT,'>' . $outFile) || die "could not open $outFile"; # -- print header line to recording condition table ------------------------ print OUT "SES\tREG\tNET\tPHM\tCAR\tCEQ\tSPP\tMIP\tMIT\tSCC\tWTC\015\012"; $sessCnt=0; # -- descend SpeechDat-Car directory BLOCKnn/SESSnnMM/ --------------------- $blockGlob = $workDir . 'BLOCK*'; while($blockDir = <${blockGlob}>) { $sessGlob = $blockDir . $fileDlm . 'SES*'; while($sessDir = <${sessGlob}>) { $labelGlob = $sessDir . $fileDlm . "*$lblExt"; $sessCnt++; @lblFiles = <${labelGlob}>; # --- read the first label file into an associative array ------------ if(int(@lblFiles == 0)) { next; } open(LBL,$lblFiles[0]) || die "Could not open SAM label file $lblFiles[0] in $sessDir"; print "$lblFiles[0]\n"; while() { chop; s/[\r\n]//; ($lbl,$lblText) = split(/:/,$_,2); $sL{$lbl} = $lblText; } close(LBL); printf OUT "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\015\012", $sL{'SES'},$sL{'REG'},$sL{'NET'},$sL{'PHM'},$sL{'CAR'},$sL{'CEQ'},$sL{'SPP'},$sL{'MIP'},$sL{'MIT'},$sL{'SCC'},$sL{'WTC'}; } } print "$sessCnt sessions found!\n"; close(OUT); exit(0);