File Coverage

blib/lib/Acme/Tie/Formatted.pm
Criterion Covered Total %
statement 36 36 100.0
branch 6 8 75.0
condition 2 3 66.6
subroutine 9 9 100.0
pod n/a
total 53 56 94.6


line stmt bran cond sub pod time code
1             package Acme::Tie::Formatted;
2 7     7   471773 use strict;
  7         67  
  7         207  
3 7     7   38 use warnings;
  7         12  
  7         176  
4 7     7   34 use Carp;
  7         14  
  7         1373  
5              
6             our $VERSION = '0.06';
7              
8             my $first_char = qr/[_a-zA-Z]/;
9             my $next_char = qr/[_a-zA-Z0-9]/;
10             my $ok_name = qr/^$first_char($next_char)*$/;
11              
12             our %format;
13              
14             sub import {
15 7     7   82 $DB::single=1;
16 7         19 my ($class, $arg) = @_;
17 7         13 my $hash_name = "format";
18              
19 7 100 66     50 if (defined $arg and $arg =~ /$ok_name/) {
20 1         2 $hash_name = $arg;
21             }
22              
23             {
24 7     7   55 no strict 'refs';
  7         21  
  7         1767  
  7         12  
25 7         21 *{"main::$hash_name"} = \%format;
  7         34  
26             }
27              
28             # Connect the magic to the hash.
29 7         29 tie %format, 'Acme::Tie::Formatted';
30             }
31              
32              
33             sub TIEHASH {
34 7     7   18 my $class = shift;
35              
36             # Someplace to hang our hat.
37 7         1458 bless \my($self), $class;
38             }
39              
40             sub FETCH {
41 5     5   2388 my ($self, $key) = @_;
42 5 100       21 return '' unless $key;
43              
44 4         55 my @args = split $;, $key, -1;
45              
46             # Return a null string if nothing was passed in.
47 4 50       18 return '' unless @args;
48              
49 4         32 my $format = pop @args;
50              
51             # Return a null string if there were no arguments
52             # to be formatted.
53 4 50       42 return '' unless @args;
54              
55             # Format arguments and return.
56 4         9 local $_;
57 4         12 return join($", map { sprintf($format, $_) } @args);
  10         79  
58             }
59              
60             # Stolen directly from Tie::Comma.
61             # Invalidate all other hash access.
62 7         33 use subs qw(
63 7     7   3732 STORE EXISTS CLEAR FIRSTKEY NEXTKEY );
  7         200  
64             *STORE = *EXISTS = *CLEAR = *FIRSTKEY = *NEXTKEY =
65             sub {
66 1     1   274 croak "You can only use %format by accessing it";
67             };
68              
69              
70             1; # Magic true value required at end of module
71              
72             __END__