The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Locale::TextDomain::OO::TiedInterface; ## no critic (TidyCode)

use strict;
use warnings;

our $VERSION = '1.000';

use Carp qw(confess);
use Tie::Sub;

my %method_name = map { $_ => undef } qw(
    __begin_d
    __begin_c
    __begin_dc
    __end_d
    __end_c
    __end_dc
    __
    __x
    __n
    __nx
    __p
    __px
    __np
    __npx
    __d
    __dx
    __dn
    __dnx
    __dp
    __dpx
    __dnp
    __dnpx
    __c
    __cx
    __cn
    __cnx
    __cp
    __cpx
    __cnp
    __cnpx
    __dc
    __dcx
    __dcn
    __dcnx
    __dcp
    __dcpx
    __dcnp
    __dcnpx
    N__
    N__x
    N__n
    N__nx
    N__p
    N__px
    N__np
    N__npx
    N__d
    N__dx
    N__dn
    N__dnx
    N__dp
    N__dpx
    N__dnp
    N__dnpx
    N__c
    N__cx
    N__cn
    N__cnx
    N__cp
    N__cpx
    N__cnp
    N__cnpx
    N__dc
    N__dcx
    N__dcn
    N__dcnx
    N__dcp
    N__dcpx
    N__dcnp
    N__dcnpx
    maketext
    maketext_p
    loc
    loc_p
    localize
    localize_p
    Nmaketext
    Nmaketext_p
    Nloc
    Nloc_p
    Nlocalize
    Nlocalize_p
);

our $loc_ref = do { my $loc; \$loc }; ## no critic(PackageVars)

sub import {
    my (undef, @imports) = @_;

    if (! @imports) {
        @imports = (
            qw($loc_ref),
            map { ("\%$_", "\$$_") } keys %method_name,
        );
    }

    my $caller  = caller;
    my $package = __PACKAGE__;

    IMPORT:
    for my $import (@imports) {
        defined $import
            or confess 'An undefined value is not a variable name';
        if ($import eq '$loc_ref') { ## no critic (InterpolationOfMetachars)
            no strict qw(refs);       ## no critic (NoStrict)
            no warnings qw(redefine); ## no critic (NoWarnings)
            *{"$caller\::loc_ref"} = \$loc_ref;
            next IMPORT;
        }
        (my $method = $import) =~ s{\A (?: (\$) | % )}{}xms
            or confess qq{"$import" is not a hash or a hash reference};
        my $is_ref = $1;
        exists $method_name{$method}
            or confess qq{"$import" is not exported};
        {
            no strict qw(refs);       ## no critic (NoStrict)
            no warnings qw(redefine); ## no critic (NoWarnings)
            *{"$caller\::$method"}
                = $is_ref
                ? \${"$package\::$method"}
                : \%{"$package\::$method"};
        }
        my $sub
            = ( index $method, 'N', 0 ) == 0
            ? sub {
                return [ ${$loc_ref}->$method(@_) ];
            }
            : sub {
                return ${$loc_ref}->$method(@_);
            };
        if ($is_ref) {
            no strict qw(refs); ## no critic (NoStrict)
            tie ## no critic (Ties)
                %{ ${$method} },
                'Tie::Sub',
                $sub;
        }
        else {
            no strict qw(refs); ## no critic (NoStrict)
            tie ## no critic (Ties)
                %{$method},
                'Tie::Sub',
                $sub;
        }
    }

    return;
}

1;

__END__

=head1 NAME

Locale::TextDomain::OO::TiedInterface - Call object methods as tied hash

$Id: TiedInterface.pm 268 2010-01-11 09:05:18Z steffenw $

$HeadURL: https://perl-gettext-oo.svn.sourceforge.net/svnroot/perl-gettext-oo/module/tags/0.07/lib/Locale/TextDomain/OO/TiedInterface.pm $

=head1 VERSION

1.000

=head1 DESCRIPTION

This module wraps the object into a tied hash
and allows to call a method as fetch hash.

=head1 SYNOPSIS

import all

    use Locale::TextDomain::OO;
    use Locale::TextDomain::OO::TiedInterface $loc_ref;
    ${loc_ref} = Locale::TextDomain::OO->new(
        ...
    );

or import only the given variables, as example all

    use Locale::TextDomain::OO;
    use Locale::TextDomain::OO::TiedInterface $loc_ref, qw(
        %__begin_d
        %__begin_c
        %__begin_dc
        %__end_d
        %__end_c
        %__end_dc
        %__
        %__x
        %__n
        %__nx
        %__p
        %__px
        %__np
        %__npx
        %__d
        %__dx
        %__dn
        %__dnx
        %__dp
        %__dpx
        %__dnp
        %__dnpx
        %__c
        %__cx
        %__cn
        %__cnx
        %__cp
        %__cpx
        %__cnp
        %__cnpx
        %__dc
        %__dcx
        %__dcn
        %__dcnx
        %__dcp
        %__dcpx
        %__dcnp
        %__dcnpx
        %N__
        %N__x
        %N__n
        %N__nx
        %N__p
        %N__px
        %N__np
        %N__npx
        %N__d
        %N__dx
        %N__dn
        %N__dnx
        %N__dp
        %N__dpx
        %N__dnp
        %N__dnpx
        %N__c
        %N__cx
        %N__cn
        %N__cnx
        %N__cp
        %N__cpx
        %N__cnp
        %N__cnpx
        %N__dc
        %N__dcx
        %N__dcn
        %N__dcnx
        %N__dcp
        %N__dcpx
        %N__dcnp
        %N__dcnpx
        %maketext
        %maketext_p
        %loc
        %loc_p
        %localize
        %localize_p
        %Nmaketext
        %Nmaketext_p
        %Nloc
        %Nloc_p
        %Nlocalize
        %Nlocalize_p
        $__begin_d
        $__begin_c
        $__begin_dc
        $__end_d
        $__end_c
        $__end_dc
        $__
        $__x
        $__n
        $__nx
        $__p
        $__px
        $__np
        $__npx
        $__d
        $__dx
        $__dn
        $__dnx
        $__dp
        $__dpx
        $__dnp
        $__dnpx
        $__c
        $__cx
        $__cn
        $__cnx
        $__cp
        $__cpx
        $__cnp
        $__cnpx
        $__dc
        $__dcx
        $__dcn
        $__dcnx
        $__dcp
        $__dcpx
        $__dcnp
        $__dcnpx
        $N__
        $N__x
        $N__n
        $N__nx
        $N__p
        $N__px
        $N__np
        $N__npx
        $N__d
        $N__dx
        $N__dn
        $N__dnx
        $N__dp
        $N__dpx
        $N__dnp
        $N__dnpx
        $N__c
        $N__cx
        $N__cn
        $N__cnx
        $N__cp
        $N__cpx
        $N__cnp
        $N__cnpx
        $N__dc
        $N__dcx
        $N__dcn
        $N__dcnx
        $N__dcp
        $N__dcpx
        $N__dcnp
        $N__dcnpx
        $maketext
        $maketext_p
        $loc
        $loc_p
        $localize
        $localize_p
        $Nmaketext
        $Nmaketext_p
        $Nloc
        $Nloc_p
        $Nlocalize
        $Nlocalize_p
    );
    ${loc_ref} = Locale::TextDomain::OO->new(
        ...
    );

=head1 SUBROUTINES/METHODS

none

=head1 EXAMPLE

Inside of this distribution is a directory named example.
Run this *.pl files.

=head1 DIAGNOSTICS

confess

=head1 CONFIGURATION AND ENVIRONMENT

none

=head1 DEPENDENCIES

L<Carp|Carp>

L<Tie::Sub|Tie::Sub>

=head1 INCOMPATIBILITIES

not known

=head1 BUGS AND LIMITATIONS

none

=head1 SEE ALSO

L<Locale::TextDoamin::OO|Locale::TextDoamin::OO>

=head1 AUTHOR

Steffen Winkler

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2009 - 2013,
Steffen Winkler
C<< <steffenw at cpan.org> >>.
All rights reserved.

This module is free software;
you can redistribute it and/or modify it
under the same terms as Perl itself.