File Coverage

blib/lib/ByteBeat.pm
Criterion Covered Total %
statement 9 39 23.0
branch 0 16 0.0
condition 0 6 0.0
subroutine 3 5 60.0
pod 0 2 0.0
total 12 68 17.6


line stmt bran cond sub pod time code
1             package ByteBeat;
2             our $VERSION = '0.0.3';
3              
4 1     1   1028 use Mo;
  1         451  
  1         4  
5 1     1   718 use Getopt::Long;
  1         8333  
  1         6  
6 1     1   440 use ByteBeat::Compiler;
  1         2  
  1         393  
7              
8             has args => ();
9              
10             my $code = '';
11             my $file;
12             my $second = 2**13;
13             my $length = 0;
14             my $debug = 0;
15             my $shell = 0;
16             my $play = 0;
17              
18             sub run {
19 0     0 0   my ($self) = shift;
20 0           $self->get_options;
21              
22 0 0 0       if ($shell or not $code) {
23 0           require ByteBeat::Shell;
24 0           ByteBeat::Shell->new(file => $file)->run;
25 0           return;
26             }
27              
28 0           my $function = ByteBeat::Compiler->new(code => $code)->compile;
29              
30 0 0         if ($debug) {
31 0           print "RPN: @{$function->{rpn}}\n";
  0            
32 0           for (my $t = 1; $t <= $length; $t++) {
33 0           print $function->run($t) % 256, "\n";
34             }
35 0           return;
36             }
37              
38 0   0       $length ||= 60 * $second;
39              
40 0 0         if ($play) {
41 0           require IPC::Run;
42 0           my $bytes;
43             my $out;
44              
45 0           my $process = IPC::Run::start(['aplay'], \$bytes, \$out, \$out);
46 0           for (my $t = 1; $t <= $length; $t++) {
47 0           $bytes .= chr ($function->run($t) % 256);
48 0           IPC::Run::pump($process);
49             }
50             }
51              
52 0           for (my $t = 1; $t <= $length; $t++) {
53 0           print chr ($function->run($t) % 256);
54             }
55             }
56              
57             sub get_options {
58 0     0 0   my ($self) = shift;
59 0           local @ARGV = @{$self->args};
  0            
60 0           GetOptions(
61             'file=s' => \$file,
62             'length=s' => \$length,
63             'debug' => \$debug,
64             'shell' => \$shell,
65             'play' => \$play,
66             );
67 0 0         $length =
    0          
    0          
68             $length =~ /^(\d+)s$/ ? $1 * $second :
69             $length =~ /^(\d+)m$/ ? $1 * $second * 60 :
70             $length =~ /^(\d+)$/ ? $1 :
71             die "Invalid value for '-l'\n";
72 0 0         $code = @ARGV ? shift(@ARGV) : -t STDIN ? '' : <>;
    0          
73 0           chomp $code;
74             }
75              
76             1;