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

package Locale::Maketext::Pseudo;

use warnings;
use strict;

$Locale::Maketext::Pseudo::VERSION = '0.6';
require Exporter;
@Locale::Maketext::Pseudo::ISA = qw(Exporter);
@Locale::Maketext::Pseudo::EXPORT_OK = qw(env_maketext env_print env_fetch env_say env_get);

sub new {
    my($class, $args_ref) = @_;
    my $self = bless {}, $class;
    $ENV{'maketext_obj'} = $self if !$args_ref->{'skip_env'};
    return $self;
}

sub env_maketext {
    my ($string, @args) = @_;

    my $needs_elp = 1;
    if( exists $ENV{'maketext_obj'} ) {
        if( $ENV{'maketext_obj'} ) {
            if( $ENV{'maketext_obj'}->can('maketext') ) {
                $string = $ENV{'maketext_obj'}->maketext( $string, @args );
                $needs_elp = 0;
            }
        }
    }

    if( $needs_elp ) {
        require Local::Maketext::Pseudo;
        Local::Maketext::Pseudo->new({
            'skip_env' => $ENV{'maketext_obj_skip_env'}
        })->maketext( $string, @args );
    }

    return $string;
}

sub env_print {
    print env_maketext(@_);
}

sub env_fetch {
    return env_maketext(@_);
}

sub env_say {
    my $text = env_maketext(@_);
    local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid
    print $text . $/ if $text;
}

sub env_get {
    my $text = env_maketext(@_);
    local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid
    return $text . $/ if $text;
    return;
}

sub maketext {
    my ($fake, $string, @args) = @_;

    for my $idx ( 1 .. scalar(@args)) {
        $string =~ s{ \[ [_]( [-]?$idx ) \] }{$args[ substr($1, 0, 1) eq '-' ? $1 : ($1 - 1) ]}xmsg;
    }

    return $string;
}

sub print {
    print shift->maketext(@_);
}

sub fetch {
    return shift->maketext(@_);
}

sub say {
    my $text = shift->maketext(@_);
    local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid
    print $text . $/ if $text;
}

sub get {
    my $text = shift->maketext(@_);
    local $/ = !defined $/ || !$/ ? "\n" : $/; # otherwise assume they are not stupid
    return $text . $/ if $text;
    return;
}

1;

__END__