Dave Cross: Still Munging Data With Perl: Online event - Mar 27 Learn more

#!/usr/bin/perl -w
#
# Copyright (C) 2007, 2009 by Mark Hindess
use strict;
use t::Helpers qw/:all/;
my %msg;
BEGIN {
my $case = $ENV{DEVICE_RFXCOM_TESTCASE};
my $tests = 1;
my $dir = 't/rf';
opendir my $dh, $dir or die "Open of $dir directory: $!\n";
local $/ = "\n\n";
foreach (sort readdir $dh) {
next if ($case && !/$case/);
next if (!/^(.*)\.txt$/);
my $name = $1;
my $f = $dir.'/'.$_;
open my $fh, '<', $f or die "Failed to open $f: $!\n";
my ($message, $summary, $warn, $rem, $flags) = <$fh>;
chomp $message;
$summary =~ s/\n+$//;
$warn && $warn =~ s/\n+$//;
$rem && $rem =~ s/\n+$//;
$flags && chomp $flags;
$msg{$name} =
{
msg => $message,
summary => $summary,
warn => $warn,
rem => $rem || '',
flags => $flags,
};
$tests += 3;
close $fh;
}
closedir $dh;
require Test::More;
import Test::More tests => $tests;
}
{
package My::RX;
sub _open {
}
sub _init {
}
1;
}
my $rf = My::RX->new();
ok($rf, 'instantiated mock device');
foreach my $m (sort keys %msg) {
my $rec = $msg{$m};
my $res;
if ($rec->{flags} && $rec->{flags} =~ s/^pause//) {
diag "Sleeping to cause timeout\r";
sleep 1;
}
if ($rec->{flags} && $rec->{flags} =~ s/^clear//) {
# clear unit code cache and try again - trash non-X10 decoders, nevermind
$_->{unit_cache} = {} foreach (@{$rf->{plugins}});
$rf->{_cache} = {}; # clear duplicate cache to avoid hitting it
}
my $buf = pack "H*", $rec->{msg}.'deadbeef';
my $w = test_warn( sub { $res = $rf->read_one(\$buf); });
is((unpack 'H*', $buf), $rec->{rem}.'deadbeef', $m.' - buffer remaining');
is($w || "none\n", $rec->{warn} ? $rec->{warn}."\n" : "none\n",
$m.' - test warning');
is_deeply($res ? $res->summary : '', $rec->{summary},
$m.' - correct summary');
}