nixos/test-driver: Add new getScreenText function.

Basically, this creates a screenshot and throws tesseract at it to
recognize the characters from the screenshot. In order to produce a
result that is well enough, we're using lanczos scaling and scale the
image up to 400% of its original size.

This provides the base functionality for a new Machine method which will
be called waitForText. I originally had that idea long ago when writing
the VM tests for VirtualBox and Chromium, but thought it would be
disproportionate to the case.

The downside however is that VM tests now depend on tesseract, but given
the average runtime of our tests it really shouldn't have a too big
impact and it's only a runtime dependency after all.

Another issue is that the OCR process takes quite some time to finish,
but IMHO it's better (as in more deterministic) than to rely on sleep().

Signed-off-by: aszlig <aszlig@redmoonstudios.org>

1 files changed, 25 insertions, 0 deletions

diff --git a/nixos/lib/test-driver/Machine.pm b/nixos/lib/test-driver/Machine.pm
index e0791692d3e..0dddc1dc14b 100644
--- a/nixos/lib/test-driver/Machine.pm
+++ b/nixos/lib/test-driver/Machine.pm
@@ -9,6 +9,7 @@ use FileHandle;
 use Cwd;
 use File::Basename;
 use File::Path qw(make_path);
+use File::Slurp;
 
 
 my $showGraphics = defined $ENV{'DISPLAY'};
@@ -493,6 +494,30 @@ sub screenshot {
 }
 
 
+# Take a screenshot and return the result as text using optical character
+# recognition.
+sub getScreenText {
+    my ($self) = @_;
+
+    my $text;
+    $self->nest("performing optical character recognition", sub {
+        my $tmpbase = Cwd::abs_path(".")."/ocr";
+        my $tmpin = $tmpbase."in.ppm";
+        my $tmpout = "$tmpbase.ppm";
+
+        $self->sendMonitorCommand("screendump $tmpin");
+        system("ppmtopgm $tmpin | pamscale 4 -filter=lanczos > $tmpout") == 0
+            or die "cannot scale screenshot";
+        unlink $tmpin;
+        system("tesseract $tmpout $tmpbase") == 0 or die "OCR failed";
+        unlink $tmpout;
+        $text = read_file("$tmpbase.txt");
+        unlink "$tmpbase.txt";
+    });
+    return $text;
+}
+
+
 # Wait until it is possible to connect to the X server.  Note that
 # testing the existence of /tmp/.X11-unix/X0 is insufficient.
 sub waitForX {