File Coverage

blib/lib/JavaScript/Const/Exporter.pm

Criterion	Covered	Total	%
statement	83	86	96.5
branch	20	26	76.9
condition			n/a
subroutine	18	18	100.0
pod	1	1	100.0
total	122	131	93.1

package JavaScript::Const::Exporter;

# ABSTRACT: Convert exported Perl constants to JavaScript

use v5.10;

use Moo 1.002000;
use MooX::Options
    protect_argv => 0,
    usage_string => '%c %o [output-filename]';

use Carp;
use JSON::MaybeXS ();
use Module::Load qw/ load /;
use Package::Stash;
use Ref::Util qw/ is_scalarref /;
use Sub::Identify 0.06 qw/ is_sub_constant /;
use Try::Tiny;
use Types::Common::String qw/ NonEmptySimpleStr /;
use Types::Standard qw/ ArrayRef Bool HashRef InstanceOf /;

# RECOMMEND PREREQ: Cpanel::JSON::XS
# RECOMMEND PREREQ: Package::Stash::XS
# RECOMMEND PREREQ: Ref::Util::XS
# RECOMMEND PREREQ: Type::Tiny::XS

use namespace::autoclean;

our $VERSION = 'v0.1.6';


option use_var => (
    is        => 'ro',
    isa       => Bool,
    default   => 0,
    negatable => 0,
    short     => 'u',
    doc       => 'use var instead of const',
);


option module => (
    is       => 'ro',
    isa      => NonEmptySimpleStr,
    required => 1,
    format   => 's',
    short    => 'm',
    doc      => 'module name to extract constants from',
);


option constants => (
    is         => 'ro',
    isa        => ArrayRef [NonEmptySimpleStr],
    predicate  => 1,
    format     => 's',
    repeatable => 1,
    short      => 'c',
    doc        => 'constants or export tags to extract',
);


option include => (
    is         => 'ro',
    isa        => ArrayRef [NonEmptySimpleStr],
    predicate  => 1,
    short      => 'I',
    format     => 's',
    repeatable => 1,
    doc        => 'paths to include',
);


option pretty => (
    is        => 'ro',
    isa       => Bool,
    default   => 0,
    short     => 'p',
    doc       => 'enable pretty printed JSON',
);


has stash => (
    is      => 'lazy',
    isa     => InstanceOf ['Package::Stash'],
    builder => sub {
        my ($self) = @_;
        if ($self->has_include) {
            push @INC, @{$self->include};
        }
        my $namespace = $self->module;
        load($namespace);
        return Package::Stash->new($namespace);
    },
    handles => [qw/ has_symbol get_symbol /],
);


has tags => (
    is      => 'lazy',
    isa     => HashRef,
    builder => sub {
        my ($self) = @_;
        if ( $self->has_symbol('%EXPORT_TAGS') ) {
            return $self->get_symbol('%EXPORT_TAGS');
        }
        else {
            my $namespace = $self->module;
            croak "No \%EXPORT_TAGS were found in ${namespace}";
        }
    }
);


has json => (
    is      => 'lazy',
    builder => sub {
        my ($self) = @_;
        return JSON::MaybeXS->new(
            utf8         => 1,
            allow_nonref => 1,
            pretty       => $self->pretty,
        );
    },
    handles => [qw/ encode /],
);


sub process {
    my ($self) = @_;

    my @imports;

    if ( $self->has_constants ) {
        @imports = @{ $self->constants };
    }
    elsif ( $self->has_symbol('@EXPORT_OK') ) {
        @imports = @{ $self->get_symbol('@EXPORT_OK') };
    }
    else {
        croak "No \@EXPORT_OK in " . $self->module;
    }

    my %symbols = map { $self->_import_to_symbol($_) } @imports;

    my $decl = $self->use_var ? "var" : "const";

    my $buffer = "";
    for my $name ( sort keys %symbols ) {
        my $val = $symbols{$name};
        my $json = $self->encode($val);
        $json =~ s/\n$// if $self->pretty;
        $buffer .= "${decl} ${name} = ${json};\n";
    }
    return $buffer;
}

sub _import_to_symbol {
    my ( $self, $import ) = @_;

    state $reserved = {
        map { $_ => 1 }
          qw/
          abstract arguments await boolean break byte case catch char class
          const continue debugger default delete do double else enum eval
          export extends false final finally float for function goto if
          implements import in instanceof int interface let long native new
          null package private protected public return short static super
          switch synchronized this throw throws transient true try typeof
          var void volatile while with yield
          /
    };

    return ( ) if $reserved->{$import};

    if ( my ($name) = $import =~ /^[\$\@\%](\w.*)$/ ) {
        my $ref = $self->get_symbol($import);
        my $val = is_scalarref($ref) ? $$ref : $ref;
        return ( $name => $val );
    }
    elsif ( my ($tag) = $import =~ /^[:\-](\w.*)$/ ) {
        my $imports = $self->tags->{$tag}
          or croak "No tag '${tag}' found in " . $self->module;
        return ( map { $self->_import_to_symbol($_) } @{$imports} );
    }
    else {
        my $fn  = $self->get_symbol( '&' . $import )
            or croak "Cannot find symbol '${import}' in " . $self->module;
        is_sub_constant($fn) or carp "Symbol '${import}' is not a constant in " . $self->module;
        my $val = $fn->();
        return ( $import => $val );
    }

}


1;

__END__