package Apache::MP3::L10N::Aliases;
$VERSION = '1.01';
use strict;
# This is a clunky class-autoloading system for subclasses that are
# totally vacuous.
#
# We need this only for languages with lots of subvariants that aren't
# any different from eachother. It saves us from having to create a
# file for each subvariant.
my %Aliases = (
'en' =>
[qw< en_au en_ca en_gb en_ie en_in
en_jm en_nz en_ph en_us en_za i_default
>],
'de' =>
[qw< de_at de_be de_ch de_de de_li de_lu >],
'fr' =>
[qw< fr_be fr_ca fr_ch fr_fr fr_lu fr_mc >],
'es' =>
[qw< es_ar es_bo es_cl es_co es_cr es_do es_ec
es_es es_gt es_hn es_mx es_pa es_pe es_pr
es_py es_sv es_us es_uy es_ve
es_cu
>],
'ar' =>
[qw< ar_ae ar_bh ar_dz ar_eg ar_iq ar_jo ar_kw
ar_lb ar_ly ar_ma ar_om ar_qa ar_sa ar_sy
ar_tn ar_ye
ar_ps
>],
);
sub autoload_and_new {
my $superclass = shift @_;
my $subclass = shift @_;
#print "Loading $superclass\n";
eval "require $superclass;";
#print "No loading: $@" if $@;
die $@ if $@;
{
no strict 'refs';
@{$subclass . '::ISA'} = $superclass;
#print "Setting \@$subclass\::ISA to ", @{$subclass . '::ISA'}, "\n";
undef *{$subclass . '::new'};
# Take out the autoloader new() that called us
}
return $subclass->new(@_);
}
{
# Drop in place the autoloader new()s
require UNIVERSAL;
my($superclass,$subclasses);
while( ($superclass, $subclasses) = each %Aliases ) {
my $superclass = 'Apache::MP3::L10N::' . lc($superclass);
foreach my $subclass (ref($subclasses) ? @$subclasses : $subclasses) {
no strict 'refs';
my $subclass = 'Apache::MP3::L10N::' . lc($subclass);
#print "setting \@$subclass\::ISA\n";
@{$subclass . '::ISA'} = 'UNIVERSAL'; # just so it looks defined
*{ $subclass . '::new'} = sub {
unshift @_, $superclass;
goto &autoload_and_new;
};
}
}
}
1;