view release on metacpan or  search on metacpan

inc/Inline.pm  view on Meta::CPAN

    goto &maker_utils if $_[0] =~ /^(install|makedist|makeppd)$/i;

    my $control = shift;

    if (uc $control eq uc 'with') {
        return handle_with($pkg, @_);
    }
    elsif (uc $control eq uc 'Config') {
        return handle_global_config($pkg, @_);
    }
    elsif (exists $shortcuts{uc($control)}) {
        handle_shortcuts($pkg, $control, @_);
        $version_requested = $CONFIG{$pkg}{template}{PRINT_VERSION};
        return;
    }
    elsif ($control =~ /^\S+$/ and $control !~ /\n/) {
        my $language_id = $control;
        my $option = shift || '';
        my @config = @_;
        my $next = 0;
        for (@config) {
            next if $next++ % 2;
            croak M02_usage() if /[\s\n]/;
        }
        $o = bless {}, $class;
        $o->{INLINE}{version} = $VERSION;
        $o->{API}{pkg} = $pkg;
        $o->{API}{script} = $script;
        $o->{API}{language_id} = $language_id;
        if ($option =~ /^(FILE|BELOW)$/i or
            not $option and
            defined $INC{File::Spec::Unix->catfile('Inline','Files.pm')} and
            Inline::Files::get_filename($pkg)
           ) {
            $o->read_inline_file;
            $o->{CONFIG} = handle_language_config(@config);
        }
        elsif ($option eq 'DATA' or not $option) {
            $o->{CONFIG} = handle_language_config(@config);
            push @DATA_OBJS, $o;
            return;
        }
        elsif (uc $option eq uc 'Config') {
            $CONFIG{$pkg}{$language_id} = handle_language_config(@config);
            return;
        }
        else {
            $o->receive_code($option);
            $o->{CONFIG} = handle_language_config(@config);
        }
    }
    else {
        croak M02_usage();
    }
    $o->glue;
}

#==============================================================================
# Run time version of import (public method)
#==============================================================================
sub bind {
    local ($/, $") = ("\n", ' '); local ($\, $,);

    my ($code, @config);
    my $o;
    my ($pkg, $script) = caller;
    my $class = shift;
    croak M03_usage_bind() unless $class eq 'Inline';

    $CONFIG{$pkg}{template} ||= $default_config;

    my $language_id = shift or croak M03_usage_bind();
    croak M03_usage_bind()
      unless ($language_id =~ /^\S+$/ and $language_id !~ /\n/);
    $code = shift or croak M03_usage_bind();
    @config = @_;

    my $next = 0;
    for (@config) {
        next if $next++ % 2;
        croak M03_usage_bind() if /[\s\n]/;
    }
    $o = bless {}, $class;
    $o->{INLINE}{version} = $VERSION;
    $o->{API}{pkg} = $pkg;
    $o->{API}{script} = $script;
    $o->{API}{language_id} = $language_id;
    $o->receive_code($code);
    $o->{CONFIG} = handle_language_config(@config);

    $o->glue;
}

#==============================================================================
# Process delayed objects that don't have source code yet.
#==============================================================================
# This code is an ugly hack because of the fact that you can't use an
# INIT block at "run-time proper". So we kill the warning and tell users
# to use an Inline->init() call if they run into problems. (rare)

eval <<END;
no warnings;
\$INIT = \$INIT; # Needed by Sarathy's patch.
sub INIT {
    \$INIT++;
    &init;
}
END

sub init {
    local ($/, $") = ("\n", ' '); local ($\, $,);

    while (my $o = shift(@DATA_OBJS)) {
        $o->read_DATA;
        $o->glue;
    }
}

sub END {
    warn M51_unused_DATA() if @DATA_OBJS;
    print_version() if $version_requested && not $version_printed;
}

#==============================================================================
# Print a small report about the version of Inline
#==============================================================================
sub print_version {
    return if $version_printed++;
    print STDERR <<END;

    You are using Inline.pm version $VERSION

END
}

#==============================================================================
# Compile the source if needed and then dynaload the object
#==============================================================================
sub glue {
    my $o = shift;
    my ($pkg, $language_id) = @{$o->{API}}{qw(pkg language_id)};

inc/Inline.pm  view on Meta::CPAN

               _mkdir(File::Spec->catdir($cwd, $did), 0777)) {
            $temp_dir = File::Spec->catdir($cwd, $did);
        }
        elsif (defined $bin and $bin and
          -d $bin and
          -w $bin and
               _mkdir(File::Spec->catdir($bin, $did), 0777)) {
            $temp_dir = File::Spec->catdir($bin, $did);
        }
       }

    croak M56_no_DIRECTORY_found()
      unless $temp_dir;
    return $TEMP_DIR = abs_path($temp_dir);
}

sub _mkdir {
    my $dir = shift;
    my $mode = shift || 0777;
    ($dir) = ($dir =~ /(.*)/) if UNTAINT;
    $dir =~ s|[/\\:]$||;
    return mkdir($dir, $mode);
}

#==============================================================================
# Error messages
#==============================================================================

sub M01_usage_use {
    my ($module) = @_;
    return <<END;
It is invalid to use '$module' directly. Please consult the Inline
documentation for more information.

END
}

sub M02_usage {
    my $usage = <<END;
Invalid usage of Inline module. Valid usages are:
    use Inline;
    use Inline language => "source-string", config-pair-list;
    use Inline language => "source-file", config-pair-list;
    use Inline language => [source-line-list], config-pair-list;
    use Inline language => 'DATA', config-pair-list;
    use Inline language => 'Config', config-pair-list;
    use Inline Config => config-pair-list;
    use Inline with => module-list;
    use Inline shortcut-list;
END
# This is broken ????????????????????????????????????????????????????
    $usage .= <<END if defined $Inline::languages;

Supported languages:
    ${\ join(', ', sort keys %$Inline::languages)}

END
    return $usage;
}

sub M03_usage_bind {
    my $usage = <<END;
Invalid usage of the Inline->bind() function. Valid usages are:
    Inline->bind(language => "source-string", config-pair-list);
    Inline->bind(language => "source-file", config-pair-list);
    Inline->bind(language => [source-line-list], config-pair-list);
END

    $usage .= <<END if defined $Inline::languages;

Supported languages:
    ${\ join(', ', sort keys %$Inline::languages)}

END
    return $usage;
}

sub M04_error_nocode {
    my ($language) = @_;
    return <<END;
No $language source code found for Inline.

END
}

sub M05_error_eval {
    my ($subroutine, $msg) = @_;
    return <<END;
An eval() failed in Inline::$subroutine:
$msg

END
}

sub M06_code_file_failed_open {
    my ($file) = @_;
    return <<END;
Couldn't open Inline code file '$file':
$!

END
#'
}

sub M07_code_file_does_not_exist {
    my ($file) = @_;
    return <<END;
Inline assumes '$file' is a filename,
and that file does not exist.

END
}

sub M08_no_DATA_source_code {
    my ($lang) = @_;
    return <<END;
No source code in DATA section for Inline '$lang' section.

END
}

sub M09_marker_mismatch {
    my ($marker, $lang) = @_;
    return <<END;
Marker '$marker' does not match Inline '$lang' section.