File Coverage

blib/lib/Acme/Morse/Audible.pm
Criterion Covered Total %
statement 21 21 100.0
branch 4 4 100.0
condition n/a
subroutine 5 5 100.0
pod 1 2 50.0
total 31 32 96.8


line stmt bran cond sub pod time code
1             package Acme::Morse::Audible;
2 3     3   83 use 5.006;
  3         9  
  3         129  
3 3     3   17 use strict;
  3         6  
  3         221  
4 3     3   19 use warnings;
  3         7  
  3         2101  
5            
6             our $VERSION = '1.10';
7            
8             my $hearable = "\x4d\x54\x68\x64\0\0\0\6\0\0\0\1\x60\0\115\124\162\153";
9             my($long,$short)=("\xFF\x40\x90\x56\x50\x82\xDF\0\x80\x56\x00","\xFF\x40\x90\x56\x50\xFF\x40\x80\x56\x00");
10            
11             sub record{
12 1     1 1 30 local $_ = unpack 'b*', pop;
13 1 100       6 s/(.)/$1?$long:$short/eg;
  2488         14110  
14 1         222 $_="\0\xC0\x11\0\xFF\x59\x02\0\0$_\0\xFF\x2F";
15 1         230 $hearable . pack('L', length($_)) . $_;
16             }
17            
18             sub play{
19 2     2 0 4 local $_ = pop;
20 2         5 chomp;
21 2         41 s/^$hearable.{4}.+?\0{2}//;s/\0\xFF\x2F$//;
  2         9  
22 2 100       12 s/\xFF\x40(.+?)\x56\0/length($1)==7?1:0/ge;
  32         144  
23 2         57 pack 'b*', $_;
24             }
25            
26             open 0 or die "Cannot hear '$0'.\n";
27             (my $telegram = do{local $/=undef;<0>}) =~ s/.*^\s*(use|no)\s+Acme::Morse::Audible\s*;\n//sm;
28             close 0;
29            
30             if($1 eq 'use'){
31             if($telegram =~ /^$hearable/){
32             eval play $telegram;
33             }else{
34             open my $rec,'>',$0 or die "Cannot record '$0'.\n";
35             binmode($rec);
36             print $rec "use Acme::Morse::Audible;\n" . record $telegram;
37             close $rec;
38             }
39             exit;
40             }else{
41             if($telegram =~ /^$hearable/){
42             open my $pl,'>',$0 or die "Cannot record '$0'.\n";
43             print $pl "no Acme::Morse::Audible;\n" . play $telegram;
44             close $pl;
45             exit;
46             }
47             }
48             1;
49            
50            
51             __END__