view release on metacpan or  search on metacpan

lib/i18n.pm  view on Meta::CPAN

        *{"$caller\::loc"}      = $class->can('loc');
        *{"$caller\::loc_lang"} = $class->can('loc_lang');

        *{"$class\::loc"}      = \&_loc;
        *{"$class\::loc_lang"} = \&_loc_lang;
    }

    @_ = ( warnings => $class );
    goto &warnings::import;
}

sub unimport {
    my $class = shift;
    overload::remove_constant('q');

    @_ = ( warnings => $class );
    goto &warnings::unimport;
}

sub loc      { goto \&_loc }
sub loc_lang { goto \&_loc_lang }

sub _loc {
    my $class = shift;
    return $_[0] unless UNIVERSAL::can( $_[0], '_negate' );
    goto &_do_loc;
}

sub _loc_lang {
    my $class    = shift;
    my $caller   = caller;
    my $loc_lang = $caller->can('loc_lang') or return;
    goto &$loc_lang;
}

sub _negate {
    my $class = ref $_[0];

    return ~_stringify( $_[0] ) unless warnings::enabled($class);

    goto &_do_loc if $_[0][NEGATED];

    bless(
        [
            [ @{ $_[0][DATA] } ],    # DATA
            $_[0][LINE],             # LINE
            $_[0][PACKAGE],          # PACKAGE
            1,                       # NEGATED
        ],
        $class
    );
}

sub _concat {
    my $class = ref $_[0];
    my $pkg   = $_[0][PACKAGE];

    @_ = reverse(@_) if pop;
    return join( '', @_ ) unless warnings::enabled($class);

    my $line = (caller)[2];
    my ( $seen, @data );

    foreach (@_) {
        ( push( @data, bless( \\$_, "$class\::var" ) ), next )
          unless ref($_)
              and UNIVERSAL::isa( $_, $class );
        $seen++;

        ( push( @data, bless( \\$_, "$class\::var" ) ), next )
          unless $_->[LINE] == $line and !$_->[NEGATED];
        $seen++;

        $pkg = $_->[PACKAGE];
        push @data, @{ $_->[DATA] };
    }

    return join( '', @data ) if $seen < 2;

    return bless(
        [
            \@data,    # DATA
            $line,     # LINE
            $pkg,      # PACKAGE
        ],
        $class
    );
}

sub _stringify {
    ( $_[0][NEGATED] )
      ? ~join( '', map { ( ref $_ ) ? "$$$_" : "$_" } @{ $_[0][DATA] } )
      : join( '', map { ( ref $_ ) ? "$$$_" : "$_" } @{ $_[0][DATA] } );
}

sub _do_loc {
    my $class = ref $_[0];
    my $pkg   = $_[0][PACKAGE];

    my $loc = $pkg->can('loc')
      or return ~"$_[0]";

    my @vars;
    my $format = join(
        '',
        map {
            UNIVERSAL::isa( $_, "$class\::var" )
              ? do { push( @vars, $$$_ ); "[_" . @vars . "]" }
              : do { my $str = $_; $str =~ s/(?=[\[\]~])/~/g; $str };
          } @{ $_[0][DATA] }
    );

    # Defeat constant folding
    return bless( [ $loc => $format ], 'i18n::string' ) if !@vars;

    @_ = ( $format, @vars );
    goto &$loc;
}

package
    i18n::string;