view release on metacpan or  search on metacpan

inc/Inline.pm  view on Meta::CPAN

    else {
        $o->{CONFIG} = {(%{$o->{CONFIG}}, @config)};
    }
    $o->print_info if $o->{CONFIG}{PRINT_INFO};
    unless ($o->{INLINE}{object_ready} or
            not length $o->{INLINE}{ILSM_suffix}) {
        $o->build();
        $o->write_inl_file() unless $o->{CONFIG}{_INSTALL_};
    }
    if ($o->{INLINE}{ILSM_suffix} ne 'so' and
        $o->{INLINE}{ILSM_suffix} ne 'dll' and
        $o->{INLINE}{ILSM_suffix} ne 'bundle' and
        $o->{INLINE}{ILSM_suffix} ne 'sl' and
        ref($o) eq 'Inline'
       ) {
        eval "require $o->{INLINE}{ILSM_module}";
        croak M05_error_eval('glue', $@) if $@;
        $o->push_overrides;
        bless $o, $o->{INLINE}{ILSM_module};
        $o->validate(@config);
    }
    $o->load;
    $o->pop_overrides;
}

#==============================================================================
# Set up the USING overrides
#==============================================================================
sub push_overrides {
    my ($o) = @_;
    my ($language_id) = $o->{API}{language_id};
    my ($ilsm) = $o->{INLINE}{ILSM_module};
    for (@{$o->{CONFIG}{USING}}) {
        my $fixed_name = /^Parser?(Pegex|RegExp|RecDescent)$/ ? "Parser::$1" : $_;
        $fixed_name =~ s/^:://;
        my $using_module = /^::/
                           ? "Inline::${language_id}::$fixed_name"
                           : /::/
                             ? $_
                             : "Inline::${language_id}::$fixed_name";
        eval "require $using_module";
        croak "Invalid module '$using_module' in USING list:\n$@" if $@;
        my $register;
        eval "\$register = $using_module->register";
        croak "Invalid module '$using_module' in USING list:\n$@" if $@;
        for my $override (@{$register->{overrides}}) {
            no strict 'refs';
            next if defined $o->{OVERRIDDEN}{$ilsm . "::$override"};
            $o->{OVERRIDDEN}{$ilsm . "::$override"} =
              \&{$ilsm . "::$override"};
            {
            no warnings 'redefine';
            *{$ilsm . "::$override"} =
              \&{$using_module . "::$override"};
            }
        }
    }
}

#==============================================================================
# Restore the modules original methods
#==============================================================================
sub pop_overrides {
    my $nowarn = $] >= 5.006 ? "no warnings 'redefine';" : '';
    eval ($nowarn .
    'my ($o) = @_;
    for my $override (keys %{$o->{OVERRIDDEN}}) {
        no strict "refs";
        *{$override} = $o->{OVERRIDDEN}{$override};
    }
    delete $o->{OVERRIDDEN};')
}

#==============================================================================
# Get source from the DATA filehandle
#==============================================================================
my (%DATA, %DATA_read);
sub read_DATA {
    require Socket;
    my ($marker, $marker_tag);
    my $o = shift;
    my ($pkg, $language_id) = @{$o->{API}}{qw(pkg language_id)};
    unless ($DATA_read{$pkg}++) {
        no strict 'refs';
        *Inline::DATA = *{$pkg . '::DATA'};
        local ($/);
        my ($CR, $LF) = (&Socket::CR, &Socket::LF);
        (my $data = <Inline::DATA>) =~ s/$CR?$LF/\n/g;
        @{$DATA{$pkg}} = split /(?m)^[ \t]{0,}(__\S+?__\n)/, $data;
        shift @{$DATA{$pkg}} unless ($ {$DATA{$pkg}}[0] || '') =~ /__\S+?__\n/;
    }
    ($marker, $o->{API}{code}) = splice @{$DATA{$pkg}}, 0, 2;
    croak M08_no_DATA_source_code($language_id)
      unless defined $marker;
    ($marker_tag = $marker) =~ s/__(\S+?)__\n/$1/;
    croak M09_marker_mismatch($marker, $language_id)
      unless $marker_tag eq $language_id;
}

#==============================================================================
# Validate and store the non language-specific config options
#==============================================================================
sub check_config {
    my $o = shift;
    my @others;
    while (@_) {
        my ($key, $value) = (shift, shift);
        if (defined $default_config->{$key}) {
            if ($key =~ /^(WITH|USING)$/) {
                croak M10_usage_WITH_USING()
                  if (ref $value and ref $value ne 'ARRAY');
                $value = [$value] unless ref $value;
                $o->{CONFIG}{$key} = $value;
                next;
            }
            $o->{CONFIG}{$key} = $value, next if not $value;
            if ($key eq 'DIRECTORY') {
                croak M11_usage_DIRECTORY($value) unless (-d $value);
                $value = abs_path($value);
            }
            elsif ($key eq 'NAME') {