File Coverage

lib/CGI/FormBuilder/Messages.pm

Criterion	Covered	Total	%
statement	67	77	87.0
branch	21	36	58.3
condition	9	22	40.9
subroutine	8	8	100.0
pod	0	2	0.0
total	105	145	72.4

###########################################################################
# Copyright (c) Nate Wiger http://nateware.com. All Rights Reserved.
# Please visit http://formbuilder.org for tutorials, support, and examples.
###########################################################################

package CGI::FormBuilder::Messages;

=head1 NAME

CGI::FormBuilder::Messages - Localized message support for FormBuilder

=head1 SYNOPSIS

    use CGI::FormBuilder::Messages;

    my $mesg = CGI::FormBuilder::Messages->new(
                    $file || \%hash || ':locale'
               );

    print $mesg->js_invalid_text;

=cut

use strict;
use warnings;
no  warnings 'uninitialized';

use CGI::FormBuilder::Util;

our $VERSION = '3.10';
our $AUTOLOAD;

sub new {
    my $self = shift;
    my $class = ref($self) || $self;
    my $src   = shift;
    debug 1, "creating Messages object from ", $src || '(default)';
    my %hash;

    if (my $ref = ref $src) {
        # hashref, get values directly
        puke "Argument to 'messages' option must be a \$file, \\\%hash, or ':locale'"
            if $ref eq 'ARRAY' || $ref eq 'SCALAR';

        # load defaults from English
        # anonymize the %hash or we get fucked with refs later
        require CGI::FormBuilder::Messages::default;
        %hash = CGI::FormBuilder::Messages::default->messages;

        while(my($k,$v) = each %$src) {
            $hash{$k} = $v;     # just override individual messages
        }
    } elsif ($src =~ s/^:+//) {
        # A manual ":locale" specification ("auto" is handled by FB->new)
        puke "Bad FormBuilder locale specification ':$src'" unless $src && $src ne '';

        # load defaults from English, in case we can't find translators
        # as we add new features
        require CGI::FormBuilder::Messages::default;
        %hash = CGI::FormBuilder::Messages::default->messages;
        my %h2 = ();

        # Note that the $src may be comma-separated, since this is the
        # way that browsers present it
        for (split /\s*,\s*/, $src) {
            debug 2, "trying to load '$_.pm' for messages";
            my $mod = __PACKAGE__.'::'.$_;
            eval "require $mod";
            if ($@) {
                # try locale's "basename"
                debug 2, "not found; trying locale basename";
                $mod = __PACKAGE__.'::'.substr($_,0,2);
                eval "require $mod";
            }
            next if $@;
            debug 2, "loading messages from $mod";
            %h2 = CGI::FormBuilder::Messages::locale->messages;
            last;
        }
        belch "Could not load messages module '$src.pm': $@" unless %h2;
        while (my($k,$v) = each %h2) {
          $hash{$k} = $v;
        }
    } elsif ($src) {
        # filename, just *warn* on missing, and use defaults
        debug 2, "trying to open the '$src' file for messages";
        if (-f $src && -r _ && open(M, "<$src")) {
            # load defaults from English
            require CGI::FormBuilder::Messages::default;
            %hash = CGI::FormBuilder::Messages::default->messages;

            while() {
                next if /^\s*#/ || /^\s*$/;
                chomp;
                my($k,$v) = split ' ', $_, 2;
                $hash{$k} = $v;
            }
            close M;
        }
        belch "Could not read messages file '$src': $!" unless %hash;
    }
    # Load default messages if no/invalid source given
    unless (%hash) {
        require CGI::FormBuilder::Messages::default;
        %hash = CGI::FormBuilder::Messages::default->messages;
    }

    return bless \%hash, $class;
}

*messages = \&message;
sub message {
    my $self = shift;
    my $key  = shift;
    unless ($key) {
        if (ref $self) {
            return wantarray ? %$self : $self;
        } else {
            # requesting a byname dump
            for my $k (sort keys %$self) {
                printf "    %-20s\t%s\n", $k, $self->{$k};
            }
            exit;
        }
    }
    $self->{$key} = shift if @_;
    unless (exists $self->{$key}) {
        my @keys = sort keys %$self;
        puke "No message string found for '$key' (keys: @keys)";
    }
    if (ref $self->{$key} eq 'ARRAY') {
        # hack catch for external file
        $self->{$key} = "@{$self->{$key}}";
    }
    return $self->{$key} || '';
}

sub DESTROY { 1 }
sub AUTOLOAD {
    # This allows direct addressing by name, for subclassable usage
    my $self = shift;
    my($name) = $AUTOLOAD =~ /.*::(.+)/;
    return $self->message($name, @_);
}

1;
__END__