File Coverage

examples/Example/Exporter.pm
Criterion Covered Total %
statement 20 20 100.0
branch 5 6 83.3
condition 1 3 33.3
subroutine 7 7 100.0
pod 0 1 0.0
total 33 37 89.1


line stmt bran cond sub pod time code
1 5     5   349803 use 5.006001;
  5         56  
2 5     5   25 use strict;
  5         11  
  5         99  
3 5     5   20 use warnings;
  5         15  
  5         187  
4              
5             package Example::Exporter;
6              
7             # Inherit from Exporter::Tiny.
8             #
9 5     5   23 use base 'Exporter::Tiny';
  5         8  
  5         2632  
10              
11             # The list of functions to export by default.
12             # Be conservative.
13             #
14             our @EXPORT = qw( fib );
15              
16             # The list of functions which are allowed to
17             # be exported. Be liberal.
18             #
19             our @EXPORT_OK = qw( embiggen );
20              
21             # Note that there was no need to list "fib"
22             # in @EXPORT_OK. It was in @EXPORT, so it's
23             # implicitly ok.
24              
25             # This is the definition of the "fib" function
26             # that we want to export.
27             #
28             sub fib {
29 175     175 0 5134 my $n = $_[0];
30            
31 175 50 33     443 (int($n) eq $n) && ($n >= 0)
32             or die "Expected natural number as argument; got '$n'";
33            
34 175 100       360 return $n if $n < 2;
35            
36 84         168 fib($n - 1) + fib($n - 2);
37             }
38              
39             # We won't define a standard embiggen function.
40             # Instead we will generate one when requested.
41             #
42             sub _generate_embiggen {
43 4     4   11 my ($class, $name, $arg, $globals) = @_;
44            
45 4 100       10 my $embiggen_amount = exists($arg->{amount}) ? $arg->{amount} : 1;
46            
47             # This is the sub that will be installed into
48             # the caller's namespace.
49             #
50             return sub ($) {
51 4     4   147 my $n = $_[0];
52 4         26 return $n + $embiggen_amount;
53             }
54 4         35 }
55              
56             1; # Make Perl Happy™