The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
BIGPRESH / CGI-FormBuilder-3.10 / t / 1d-messages.t 
#!/usr/bin/perl

# Copyright (c) Nate Wiger http://nateware.com.
# All Rights Reserved. If you're reading this, you're bored.
# 1d-messages.t - messages and localization

use strict;

our $TESTING = 1;
our $DEBUG = $ENV{DEBUG} || 0;
our $LOGNAME = $ENV{LOGNAME} || '';
our $VERSION;
BEGIN { $VERSION = '3.10'; }

use Test;
use FindBin;
use File::Find;

# use a BEGIN block so we print our plan before CGI::FormBuilder is loaded
my @pm;
my %messages;
BEGIN { 
    die $! unless -d "$FindBin::Bin/../lib";
    unshift @INC, "$FindBin::Bin/../lib";
    %messages = (
        form_invalid_text   => 'You fucked up',
        js_invalid_text     => 'Yep, shit sucks!',
        form_select_default => '*<- choose ->*',
        taco_salad          => 'is delicious',
        parade              => [1,2,3],

        form_invalid_text     => '<font color="red"><b>%s</b></font>',
        form_invalid_input    => 'Invalid entry',
        form_invalid_select   => 'Select an option from this list',
        form_invalid_checkbox => 'Check one or more options',
        form_invalid_radio    => 'Choose an option',
        form_invalid_password => 'Invalid entry',
        form_invalid_textarea => 'Please fill this in',
        form_invalid_file     => 'Invalid filename',
        form_invalid_default  => 'Invalid entry',
    );

    # try to load all the messages .pm files
    find(sub{
      push @pm, $File::Find::name if -f $_ && $File::Find::name =~ m#Messages/[a-z]+_[A-Z]+\.pm$#;
    }, "$FindBin::Bin/../lib");
    die "Found 0 Messages.pm files in $FindBin::Bin/../lib, this is wrong" if @pm == 0;
    # die "pm = @pm";

    #
    # There are 34 keys, times the number of modules, plus one load of the module.
    # Then, also add in our custom tests as well, which is two passes over
    # the %messages hash (above) plus 4 charset/dtd checks
    #
    require CGI::FormBuilder::Messages::default;
    my %hash = CGI::FormBuilder::Messages::default->messages;
    my $numkeys = keys %hash;
    my $numtests = ($numkeys * @pm) + @pm + (keys(%messages) * 2) + 4;

    plan tests => $numtests;

    # success if we said NOTEST
    if ($ENV{NOTEST}) {
        ok(1) for 1..$numtests;
        exit;
    }
}

# Messages, both inline and file
my $locale = "fb_FAKE";
my $messages = "messages.$locale";
open(M, ">$messages") || warn "Can't write $messages: $!";
while (my($k,$v) = each %messages) {
    print M join(' ', $k, ref($v) ? @$v : $v), "\n";
}
close(M);

# Fake a submission request
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING}   = 'ticket=111&user=pete&replacement=TRUE&action=Unsubscribe&name=Pete+Peteson&email=pete%40peteson.com&extra=junk&_submitted=1&blank=&two=&two=';

use CGI::FormBuilder 3.10;

# Now manually try a whole bunch of things
my $hash = CGI::FormBuilder->new(
                debug => $DEBUG,
                fields => [qw/user name email/],
                messages => \%messages
           );

for my $k (sort keys %messages) {
    #local $" = ', ';
    ok($hash->messages->$k, ref($messages{$k}) ? "@{$messages{$k}}" : $messages{$k});
}

my $file = CGI::FormBuilder->new(
                debug => $DEBUG,
                fields => [qw/user name email/],
                messages => $messages,
           );

for my $k (sort keys %messages) {
    #local $" = ', ';
    ok($file->messages->$k, ref($messages{$k}) ? "@{$messages{$k}}" : $messages{$k});
}

unlink $messages;

# Check to ensure our lang and charset work correctly
{   local $TESTING = 0;
    ok($file->charset, 'iso-8859-1');
    ok($file->lang,    'en_US');
    ok($file->dtd, <<EOD);
<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html
        PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
         "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en_US" xml:lang="en_US">
EOD
    ok($file->charset('yo.momma'), 'yo.momma');
}

# Final test set is to just make sure we have all the keys for all modules
require CGI::FormBuilder::Messages::default;
my %need = CGI::FormBuilder::Messages::default->messages;
my @keys = keys %need;
for my $pm (@pm) {
    my($lang) = $pm =~ /([a-z]+_[A-Z]+)/;
    my $skip = $lang ? undef : "skip: Can't get language from $pm";
    my $form;
    eval { $form = CGI::FormBuilder->new(messages => ":$lang"); };
    skip($skip, !$@);
    for (@keys) {
        skip($skip, $form->{messages}->$_) || warn "Locale $lang: missing $_\n";
    }
}