1:#!/usr/bin/perl
       2:
       3:# |
       4:# | AUTOMATED TESTS FOR QT_TOOLS
       5:# | 2006 March
       6:# |
       7:# | These tests exercise qt_tools just a little bit.
       8:# | They each run some command line and then look at the resulting files.
       9:# | Often they use qt_info to peek inside a QuickTime movie or other
      10:# | kind of file, and check the results that way.
      11:# |
      12:# | They aren't much, but for an afternoon's coding they
      13:# | sure do improve my confidence about each build!
      14:# |
      15:# | david van brink / poly@omino.com
      16:# |
      17:
      18:use strict;
      19:
      20:
      21:my $appsLoc = "./";
      22:
      23:# Trivia: this is the first computer-graphic QuickTime movie ever made...
      24:my $sweepMov = "./sweep.mov";
      25:
      26:
      27:sub sys($;$)
      28:    {
      29:    my $cmdLine = shift;
      30:    my $errIsOK = shift;
      31:
      32:    $cmdLine = $appsLoc . $cmdLine;
      33:    print "\n-------\nEXECUTING: $cmdLine\n-------\n";
      34:    my $result = system($cmdLine);
      35:    assertZero($result) unless $errIsOK;
      36:    return $result;
      37:    }
      38:
      39:sub getFileSize($)
      40:    {
      41:    my $filename = shift;
      42:    my @stats = stat($filename);
      43:    my $result = $stats[7];
      44:    return $result;
      45:    }
      46:
      47:# +-------------------
      48:# | return reference to hash
      49:# | of each --key=value
      50:# |
      51:
      52:sub mp_new_opts
      53:  {
      54:  my $arg;
      55:  my $argVal;
      56:  my $argc;
      57:  my %hash;
      58:
      59:  $argc = 0;
      60:
      61:
      62:  while($arg = shift)
      63:    {
      64:    if($arg =~ /^--/)
      65:      {
      66:      if($arg =~ /^--(.*)\=(.*)$/)
      67:        {
      68:        $arg = $1;
      69:        $argVal = $2;
      70:        }
      71:      elsif($arg=~ /^--(.*)$/)
      72:        {
      73:        $arg = $1;
      74:        $argVal = "_";   # a true-but-zero value
      75:        }
      76:
      77:      $hash{$arg} = $argVal;
      78:      }
      79:    else
      80:      {
      81:      $hash{$argc++} = $arg;
      82:      }
      83:    }
      84:
      85:  $hash{_argc} = $argc;
      86:
      87:  return \%hash;
      88:  }
      89:
      90:# +---------------------
      91:# | return hash of values for the qt_info
      92:# | each track in a subhash
      93:# | result{movie_name} = "foo.mov"
      94:# | result{1}{track_dimensions} = "(10,10)"
      95:# |
      96:
      97:sub getQTInfo($)
      98:{
      99:    my %result;
     100:    my $fileName = shift;
     101:
     102:    my $qtInfoCmd = "$appsLoc/qt_info $fileName";
     103:    my $result = snagParseableOutput($qtInfoCmd);
     104:    my $assnCount = scalar(keys(%$result));
     105:    print "qt_info on $fileName got $assnCount values, dur=$$result{movie_duration}\n";
     106:    return $result;
     107:}
     108:
     109:sub snagOutput($)
     110:{
     111:    my $cmdLine = shift;
     112:    print "snagOutput backticking: $cmdLine\n";
     113:    my $out = `$cmdLine`;
     114:    return $out;
     115:}
     116:
     117:sub snagParseableOutput($)
     118:{
     119:    my $cmdLine = shift;
     120:    print "snagParseableOutput backticking: $cmdLine\n";
     121:    my $parseableInfo = `$cmdLine`;
     122:    my @infoLines = split(/[\n\r]+/, $parseableInfo);
     123:    my $assnCount = 0;
     124:    my $trackIndex = 0;
     125:    my %result;
     126:    foreach my $line (@infoLines)
     127:    {
     128:        if($line =~ /^\+ *(.*?) : (.*?) *$/)
     129:        {
     130:            my $key = $1;
     131:            my $value = $2;
     132:            $key =~ tr/ /_/;
     133:            #print "$key = $value\n";
     134:            $trackIndex++ if($key eq "track_index");
     135:            if($trackIndex)
     136:            {
     137:                $result{$trackIndex}{$key} = $value;
     138:                $assnCount++;
     139:            }
     140:            else
     141:            {
     142:                $result{$key} = $value;
     143:                $assnCount++;
     144:            }
     145:        }
     146:    }
     147:    return \%result;
     148:}
     149:
     150:
     151:
     152:my $assertCount = 0;
     153:sub assertFileExists($)
     154:{
     155:    my ($f) = (@_);
     156:    open(F,$f) || die "\nERROR: missing file $f\n";
     157:    close F;
     158:    print("good: $f exists\n");
     159:    $assertCount++;
     160:}
     161:
     162:sub assertTrue($$)
     163:{
     164:    my ($msg,$bool) = (@_);
     165:    die "($assertCount) $msg" if !$bool;
     166:    $assertCount++;
     167:}
     168:
     169:sub assertZero($)
     170:{
     171:    my ($x) = (@_);
     172:    die "ERROR nonzero $x" if($x != 0);
     173:    $assertCount++;
     174:}
     175:
     176:sub fail($)
     177:{
     178:    my $what = shift;
     179:    die "ERROR $what";
     180:}
     181:
     182:sub assertEquals($$$)
     183:{
     184:    my ($what,$want,$got) = (@_);
     185:    die "ERROR $what: $want != $got" if $want != $got;
     186:    print("good: $what == $got\n");
     187:    $assertCount++;
     188:}
     189:
     190:
     191:sub assertEq($$$)
     192:{
     193:    my ($what,$want,$got) = (@_);
     194:    die "ERROR $what: --$want-- ne --$got--" if $want ne $got;
     195:    print("good: $what is $got\n");
     196:    $assertCount++;
     197:}
     198:
     199:sub assertStarts($$$)
     200:{
     201:    my ($what,$want,$got) = (@_);
     202:    my $len = length($want);
     203:    my $gotStart = substr($got,0,$len);
     204:    die "ERROR $what: $want doesn't begin $got" if $want ne $gotStart;
     205:    print("good: $what -- $got begins with $want\n");
     206:    $assertCount++;
     207:}
     208:
     209:sub testHaveTools()
     210:{
     211:    assertFileExists("$appsLoc/qt_export");
     212:    assertFileExists("$appsLoc/qt_info");
     213:    assertFileExists("$appsLoc/qt_thing");
     214:    assertFileExists("$appsLoc/qt_atom");
     215:    assertFileExists("$appsLoc/qt_proofsheet");
     216:}
     217:
     218:
     219:sub testQtInfo
     220:{
     221:    print "testQtInfo\n";
     222:    my $qtInfo = getQTInfo($sweepMov);
     223:    assertEquals("movie_duration",2,$$qtInfo{movie_duration});
     224:    assertStarts("sound_format","twos",$$qtInfo{1}{sound_format});
     225:    assertStarts("video_format","rle",$$qtInfo{2}{video_format});
     226:    assertEquals("movie_track_count",2,$$qtInfo{movie_track_count});
     227:
     228:    assertEquals("media_average_sample_rate",60,$$qtInfo{2}{media_average_sample_rate});
     229:}
     230:
     231:sub test1
     232:{
     233:    my $dm = "testoutput/t1.mov"; # dest movie
     234:    print ("test1");
     235:    my $result = sys("qt_export $sweepMov --duration=1 $dm");
     236:    assertFileExists($dm);
     237:    my $qtInfo = getQTInfo($dm);
     238:    assertEquals("movie_duration",1,$$qtInfo{movie_duration});
     239:    assertStarts("video_format","SVQ3",$$qtInfo{2}{video_format});
     240:    assertEq("movie_box","(0,0,256,256)",$$qtInfo{movie_box});
     241:}
     242:
     243:sub test2
     244:{
     245:    my $dm = "testoutput/t2.mov"; # dest movie
     246:    print ("test2");
     247:    my $result = sys("qt_export $sweepMov --duration=1 --video=jpeg $dm");
     248:    assertZero($result);
     249:    assertFileExists($dm);
     250:    my $qtInfo = getQTInfo($dm);
     251:    assertEquals("movie_duration",1,$$qtInfo{movie_duration});
     252:    assertStarts("video_format","jpeg",$$qtInfo{2}{video_format});
     253:}
     254:
     255:sub test3
     256:{
     257:    my $dm = "testoutput/t3.jpg"; # dest pix
     258:    print ("test3");
     259:    my $result = sys("qt_proofsheet $sweepMov --duration=1 --video=jpeg $dm --framerate=4 --framesize=40 --framesperrow=4 --spacing=0 --title=0");
     260:    assertZero($result);
     261:    assertFileExists($dm);
     262:    my $qtInfo = getQTInfo($dm);
     263:    assertEq("movie_box","(0,0,160,40)",$$qtInfo{movie_box});
     264:    assertStarts("video_format","jpeg",$$qtInfo{1}{video_format});
     265:}
     266:
     267:sub test4
     268:{
     269:    my $dm = "testoutput/t4.jpg"; # dest pix
     270:    print ("test4");
     271:    my $result = sys("qt_proofsheet $sweepMov --duration=1 --video=jpeg $dm --framerate=4 --framesize=40 --framesperrow=4 --spacing=10 --title=0");
     272:    assertZero($result);
     273:    assertFileExists($dm);
     274:    my $qtInfo = getQTInfo($dm);
     275:    assertEq("movie_box","(0,0,210,60)",$$qtInfo{movie_box});
     276:    assertStarts("video_format","jpeg",$$qtInfo{1}{video_format});
     277:}
     278:
     279:sub test5
     280:{
     281:    # verify data rate...
     282:    # doesnt have MUCh effect, but 1000 vs 5000 should
     283:    # affect it some...
     284:    my $dm1 = "testoutput/sdr1.mov"; # dest pix
     285:    my $dm2 = "testoutput/sdr2.mov"; # dest pix
     286:    print "test5\n";
     287:    my $result = sys("qt_export --audio=0 $sweepMov $dm1 --datarate=1000");
     288:    my $result = sys("qt_export --audio=0 $sweepMov $dm2 --datarate=5000");
     289:    assertFileExists($dm1);
     290:    assertFileExists($dm2);
     291:    my $s1 = getFileSize($dm1);
     292:    my $s2 = getFileSize($dm2);
     293:    assertTrue("data rate $s1 looks wrong",$s1 < 2000000);
     294:    assertTrue("data rate $s1 looks wrong",$s2 > 3000000);
     295:
     296:    # while we're here, let us verify that audio doesnt exist...
     297:    my $qtInfo = getQTInfo($dm1);
     298:    assertEq("track_count",1,$$qtInfo{movie_track_count});
     299:}
     300:
     301:sub test6
     302:{
     303:    print "test6\n";
     304:    # image sequence out and in
     305:    #qt_export sweep.mov --exporter=grex --loadsettings=image_sequence.st testoutput/sweep_seq.jpg
     306:
     307:    my $seqOutBaseName = "testoutput/sweep1_seq";
     308:    my $seqOut = "$seqOutBaseName.jpg"; # will become 001 to 120
     309:    my $rebuiltMov = "testoutput/rebuilt.mov";
     310:
     311:    my $result = sys("qt_export sweep.mov --exporter=grex --loadsettings=image_sequence.st $seqOut");
     312:    assertFileExists("${seqOutBaseName}001.jpg");
     313:    assertFileExists("${seqOutBaseName}010.jpg");
     314:    assertFileExists("${seqOutBaseName}100.jpg");
     315:    assertFileExists("${seqOutBaseName}120.jpg");
     316:
     317:    # and reimport the movie...
     318:    # 10 fps down from 60 leads to a 12 second movie
     319:
     320:    my $result = sys("qt_export --sequencerate=10 ${seqOutBaseName}002.jpg $rebuiltMov");
     321:    assertFileExists($rebuiltMov);
     322:    my $qtInfo = getQTInfo($rebuiltMov);
     323:    assertEquals("movie_duration",12,$$qtInfo{movie_duration});
     324:    assertEq("movie_box","(0,0,256,256)",$$qtInfo{movie_box});
     325:}
     326:
     327:sub testOddSequenceRates()
     328:{
     329:    my $srcImgName = "clock1.jpg";
     330:    
     331:    foreach my $rate (500,501,550,597,1.1,29.97)
     332:    {
     333:        my $movOutName = "testoutput/oddrate$rate.mov";
     334:        my $result = sys("qt_export $srcImgName $movOutName --sequencerate=$rate");
     335:        my $qtInfo = getQTInfo($movOutName);
     336:        my $mediaDurationInfo = $$qtInfo{1}{media_duration};
     337:        if($mediaDurationInfo =~ /^(.*) \((.*)\/(.*)\)$/)
     338:        {
     339:           my $dur = $1;
     340:           my $num = $2;
     341:           my $den = $3;
     342:
     343:           my $reportedMediaDuration = "none";
     344:           if($num != 0)
     345:           {
     346:             $reportedMediaDuration = $den / $num;
     347:           }
     348:           assertEquals("media frame fraction [$mediaDurationInfo]",$rate,$reportedMediaDuration);
     349:        }
     350:        else
     351:        {
     352:            assertEquals("no media duration",1,2);
     353:        }
     354:    }
     355:}
     356:
     357:sub testDirectoryWithNumbers()
     358:{
     359:    mkdir("testoutput/frames4u/");
     360:    assertTrue("dir not made",-d "testoutput/frames4u/");
     361:
     362:    my $cmd = "${appsLoc}qt_export $sweepMov testoutput/frames4u/sweep90frames.jpg --duration=0,1.5";
     363:    print "cmd = $cmd\n";
     364:    my $assns = snagParseableOutput("$cmd");
     365:
     366:    my $cmd = "${appsLoc}qt_export testoutput/frames4u/sweep90frames02.jpg testoutput/sweepframes.mov --sequencerate=60";
     367:    print "cmd = $cmd\n";
     368:    my $assns = snagParseableOutput("$cmd");
     369:    my $qtInfo = getQTInfo("testoutput/sweepframes.mov");
     370:    # make sure we got all the frame -- even though there was a number in the directory
     371:    my $duration = $$qtInfo{movie_duration};
     372:    assertEquals("sequence with tricky numbers in file name (duration)",1.5,$duration);
     373:}
     374:
     375:sub testExporterSelecting()
     376:{
     377:# make sure we auto-select the exporter & stuff just from the file suffix
     378:    foreach my $try (
     379:            "aif,AIFF,soun",
     380:            "aiff,AIFF,soun",
     381:            "dv,dvc!,appl",
     382:            "jpg,grex,appl,1",
     383:            "png,grex,appl,1",
     384:            "tga,grex,appl,1",
     385:            # needs dvdsp installed"mp2,MPEG,....",
     386:# mp3 is often not around, either... boo hoo. "mp3,mp3,PYEh",
     387:            "wav,WAVE,soun",
     388:            "mp4,mpg4,appl",
     389:            "m4a,mpg4,appl",   # an audio-only mpeg-4 file
     390:            "m4v,M4V,appl",   # ipod file...
     391:            "avi,VfW,appl"
     392:            )
     393:    {
     394:        my ($extension,$subtype,$mfr,$isStillFormat) = split(/,/,$try);
     395:        my $resultFile = "testoutput/fooxport_$extension.$extension";
     396:        my $duration = "--duration=0,.1";
     397:        if($isStillFormat)
     398:        {
     399:            $duration = "";  # a duration on jpg would cause an image sequence. we want 1 file.
     400:        }
     401:        my $cmd = "${appsLoc}qt_export $sweepMov $duration $resultFile";
     402:        print "cmd = $cmd\n";
     403:        my $assns = snagParseableOutput("$cmd");
     404:        assertEq("choosing exporter subtype for $extension",$subtype,$$assns{exporter_subtype});
     405:        assertEq("choosing exporter mfr for $extension",$mfr,$$assns{exporter_mfr});
     406:        assertFileExists($resultFile);
     407:        $assns = getQTInfo($resultFile);
     408:        assertEq("qtinfo reading movie",$resultFile,$$assns{movie_name});
     409:    }
     410:}
     411:
     412:sub testM4aAudioOnly()
     413:{
     414:    my $resultFile = "testoutput/sweepmoveAudio.m4a";
     415:    my $cmd = "${appsLoc}qt_export $sweepMov $resultFile";
     416:    print "cmd = $cmd\n";
     417:    my $assns = snagParseableOutput("$cmd");
     418:    my $qtInfo = getQTInfo($resultFile);
     419:    assertEq("audio has empty movie_box pls?","(0,0,0,0)",$$qtInfo{movie_box});
     420:}
     421:
     422:sub testManPages()
     423:{
     424:    print "checking man pages...";
     425:    my $cmd = "${appsLoc}qt_export --man";
     426:    print "cmd = $cmd\n";
     427:    my $out = snagOutput($cmd);
     428:
     429:    if($out =~ /.*No man .*/mi)
     430:    {
     431:        fail("No man page!");
     432:    }
     433:}
     434:
     435:sub main(@)
     436:{
     437:    my $opts = mp_new_opts(@_);
     438:    my $file = $$opts{0};
     439:    $appsLoc = $$opts{"apps"};
     440:    my $dontdelete = $$opts{"keep"};
     441:    $appsLoc = "../build/app" if(!$appsLoc);
     442:    $appsLoc .= "/";
     443:
     444:    print "{options --apps=<qt_tools> --keep (wont delete test results)}\n";
     445:    print "\n\n\n";
     446:    print "QT_TOOLS AUTOMATED TESTS\n";
     447:    system(date);
     448:    sys("qt_export --version",1);
     449:    print "\n\n\n";
     450:
     451:    print "apps in: $appsLoc\n";
     452:
     453:    #print $file;
     454:    #my $qtInfo = getQTInfo($file);
     455:    #print $$qtInfo{movie_box};
     456:
     457:    system("mkdir -p testoutput");
     458:    system("rm -rf testoutput/* testoutput/.Q*");
     459:
     460:    my $tests = $$opts{"testlist"};
     461:    if($tests)
     462:    {
     463:        my @testList = split(/,/,$tests);
     464:        foreach my $oneTest (@testList)
     465:        {
     466:            my $doString = "$oneTest()";
     467:            print "(About to eval: $doString)\n";
     468:            eval($doString);
     469:        }
     470:    }
     471:    else
     472:    {    
     473:        testHaveTools();
     474:        testQtInfo();
     475:        testManPages();
     476:        testM4aAudioOnly();
     477:        testDirectoryWithNumbers();
     478:        testExporterSelecting();
     479:        testOddSequenceRates();
     480:        test6();
     481:        test1();
     482:        test2();
     483:        test3();
     484:        test4();
     485:        test5();
     486:    }
     487:
     488:    print "\n\n\nDone. If you see this, the tests passed.\n";
     489:    print "$assertCount assertions correctly assertively asserted.\n\n";
     490:    if(!$dontdelete)
     491:        {
     492:        system("rm -rf testoutput/*");
     493:        print "(deleted testoutput/*)\n";
     494:        }
     495:}
     496:
     497:main(@ARGV);
     498:
     499:#end of file
     500:
     501: