File Coverage

blib/lib/Locale/Maketext/Pseudo.pm
Criterion Covered Total %
statement 14 43 32.5
branch 3 28 10.7
condition 0 12 0.0
subroutine 4 13 30.7
pod 11 11 100.0
total 32 107 29.9


line stmt bran cond sub pod time code
1             package Locale::Maketext::Pseudo;
2              
3 2     2   50793 use warnings;
  2         5  
  2         69  
4 2     2   10 use strict;
  2         4  
  2         1479  
5              
6             $Locale::Maketext::Pseudo::VERSION = '0.6';
7             require Exporter;
8             @Locale::Maketext::Pseudo::ISA = qw(Exporter);
9             @Locale::Maketext::Pseudo::EXPORT_OK = qw(env_maketext env_print env_fetch env_say env_get);
10              
11             sub new {
12 1     1 1 353 my($class, $args_ref) = @_;
13 1         4 my $self = bless {}, $class;
14 1 50       19 $ENV{'maketext_obj'} = $self if !$args_ref->{'skip_env'};
15 1         5 return $self;
16             }
17              
18             sub env_maketext {
19 0     0 1 0 my ($string, @args) = @_;
20            
21 0         0 my $needs_elp = 1;
22 0 0       0 if( exists $ENV{'maketext_obj'} ) {
23 0 0       0 if( $ENV{'maketext_obj'} ) {
24 0 0       0 if( $ENV{'maketext_obj'}->can('maketext') ) {
25 0         0 $string = $ENV{'maketext_obj'}->maketext( $string, @args );
26 0         0 $needs_elp = 0;
27             }
28             }
29             }
30            
31 0 0       0 if( $needs_elp ) {
32 0         0 require Local::Maketext::Pseudo;
33 0         0 Local::Maketext::Pseudo->new({
34             'skip_env' => $ENV{'maketext_obj_skip_env'}
35             })->maketext( $string, @args );
36             }
37            
38 0         0 return $string;
39             }
40              
41             sub env_print {
42 0     0 1 0 print env_maketext(@_);
43             }
44              
45             sub env_fetch {
46 0     0 1 0 return env_maketext(@_);
47             }
48            
49             sub env_say {
50 0     0 1 0 my $text = env_maketext(@_);
51 0 0 0     0 local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid
52 0 0       0 print $text . $/ if $text;
53             }
54            
55             sub env_get {
56 0     0 1 0 my $text = env_maketext(@_);
57 0 0 0     0 local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid
58 0 0       0 return $text . $/ if $text;
59 0         0 return;
60             }
61              
62             sub maketext {
63 5     5 1 688 my ($fake, $string, @args) = @_;
64              
65 5         15 for my $idx ( 1 .. scalar(@args)) {
66 10 100       271 $string =~ s{ \[ [_]( [-]?$idx ) \] }{$args[ substr($1, 0, 1) eq '-' ? $1 : ($1 - 1) ]}xmsg;
67             }
68              
69 5         31 return $string;
70             }
71              
72             sub print {
73 0     0 1   print shift->maketext(@_);
74             }
75              
76             sub fetch {
77 0     0 1   return shift->maketext(@_);
78             }
79            
80             sub say {
81 0     0 1   my $text = shift->maketext(@_);
82 0 0 0       local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid
83 0 0         print $text . $/ if $text;
84             }
85            
86             sub get {
87 0     0 1   my $text = shift->maketext(@_);
88 0 0 0       local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid
89 0 0         return $text . $/ if $text;
90 0           return;
91             }
92              
93             1;
94              
95             __END__