Alien-ROOT
view release on metacpan or search on metacpan
inc/inc_File-Fetch/File/Fetch.pm view on Meta::CPAN
my $file = $self->file;
$file =~ s/\?.*$//g;
$file ||= $self->file_default;
return $file;
}
### XXX do this or just point to URI::Escape?
# =head2 $esc_uri = $ff->escaped_uri
#
# =cut
#
# ### most of this is stolen straight from URI::escape
# { ### Build a char->hex map
# my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
#
# sub escaped_uri {
# my $self = shift;
# my $uri = $self->uri;
#
# ### Default unsafe characters. RFC 2732 ^(uric - reserved)
# $uri =~ s/([^A-Za-z0-9\-_.!~*'()])/
# $escapes{$1} || $self->_fail_hi($1)/ge;
#
# return $uri;
# }
#
# sub _fail_hi {
# my $self = shift;
# my $char = shift;
#
# $self->_error(loc(
# "Can't escape '%1', try using the '%2' module instead",
# sprintf("\\x{%04X}", ord($char)), 'URI::Escape'
# ));
# }
#
# sub output_file {
#
# }
#
#
# }
inc/inc_File-Fetch/File/Fetch.pm view on Meta::CPAN
Therefor, we recommend to only use C<lynx> as a last resort. This is
why it is at the back of our list of methods to try as well.
=head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?
C<File::Fetch> is relatively smart about things. When trying to write
a file to disk, it removes the C<query parameters> (see the
C<output_file> method for details) from the file name before creating
it. In most cases this suffices.
If you have any other characters you need to escape, please install
the C<URI::Escape> module from CPAN, and pre-encode your URI before
passing it to C<File::Fetch>. You can read about the details of URIs
and URI encoding here:
http://www.faqs.org/rfcs/rfc2396.html
=head1 TODO
=over 4
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
if( ref $cmd and grep { $sc_lookup{$_} } @$cmd ) {
### since we have special chars, we have to quote white space
### this *may* conflict with the parsing :(
my $fixed;
my @cmd = map { / / ? do { $fixed++; QUOTE.$_.QUOTE } : $_ } @$cmd;
$self->_debug( "# Quoted $fixed arguments containing whitespace" )
if $DEBUG && $fixed;
### stringify it, so the special char isn't escaped as argument
### to the program
$cmd = join ' ', @cmd;
}
return $cmd;
}
}
### Command-line arguments (but not the command itself) must be quoted
### to ensure case preservation. Borrowed from Module::Build with adaptations.
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
&& UNIVERSAL::isa($args[0], 'ARRAY'))
? 1
: 0;
@args = split(/\s+/, $args[0]) unless $got_arrayref || scalar(@args) > 1;
my $cmd = $got_arrayref ? shift @{$args[0]} : shift @args;
### Do not quote qualifiers that begin with '/' or previously quoted args.
map { if (/^[^\/\"]/) {
$_ =~ s/\"/""/g; # escape C<"> by doubling
$_ = q(").$_.q(");
}
}
($got_arrayref ? @{$args[0]}
: @args
);
$got_arrayref ? unshift(@{$args[0]}, $cmd) : unshift(@args, $cmd);
return $got_arrayref ? $args[0]
: join(' ', @args);
}
### XXX this is cribbed STRAIGHT from M::B 0.30 here:
### http://search.cpan.org/src/KWILLIAMS/Module-Build-0.30/lib/Module/Build/Platform/Windows.pm:split_like_shell
### XXX this *should* be integrated into text::parsewords
sub _split_like_shell_win32 {
# As it turns out, Windows command-parsing is very different from
# Unix command-parsing. Double-quotes mean different things,
# backslashes don't necessarily mean escapes, and so on. So we
# can't use Text::ParseWords::shellwords() to break a command string
# into words. The algorithm below was bashed out by Randy and Ken
# (mostly Randy), and there are a lot of regression tests, so we
# should feel free to adjust if desired.
local $_ = shift;
my @argv;
return @argv unless defined() && length();
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
Defaults to false, so it will remove null arguments. Set to true to allow
them.
=head1 Caveats
=over 4
=item Whitespace and IPC::Open3 / system()
When using C<IPC::Open3> or C<system>, if you provide a string as the
C<command> argument, it is assumed to be appropriately escaped. You can
use the C<QUOTE> constant to use as a portable quote character (see above).
However, if you provide an array reference, special rules apply:
If your command contains B<special characters> (< > | &), it will
be internally stringified before executing the command, to avoid that these
special characters are escaped and passed as arguments instead of retaining
their special meaning.
However, if the command contained arguments that contained whitespace,
stringifying the command would loose the significance of the whitespace.
Therefore, C<IPC::Cmd> will quote any arguments containing whitespace in your
command if the command is passed as an arrayref and contains special characters.
=item Whitespace and IPC::Run
When using C<IPC::Run>, if you provide a string as the C<command> argument,
inc/inc_Locale-Maketext-Simple/Locale/Maketext/Simple.pm view on Meta::CPAN
if ($style eq 'maketext') {
$Loc{$pkg} = sub {
$lh->maketext(@_)
};
}
elsif ($style eq 'gettext') {
$Loc{$pkg} = sub {
my $str = shift;
$str =~ s{([\~\[\]])}{~$1}g;
$str =~ s{
([%\\]%) # 1 - escaped sequence
|
% (?:
([A-Za-z#*]\w*) # 2 - function call
\(([^\)]*)\) # 3 - arguments
|
([1-9]\d*|\*) # 4 - variable
)
}{
$1 ? $1
: $2 ? "\[$2,"._unescape($3)."]"
: "[_$4]"
}egx;
return $lh->maketext($str, @_);
};
}
else {
die "Unknown Style: $style";
}
return $Loc{$pkg}, sub {
inc/inc_Locale-Maketext-Simple/Locale/Maketext/Simple.pm view on Meta::CPAN
sub default_loc {
my ($self, %args) = @_;
my $style = lc($args{Style});
if ($style eq 'maketext') {
return sub {
my $str = shift;
$str =~ s{((?<!~)(?:~~)*)\[_([1-9]\d*|\*)\]}
{$1%$2}g;
$str =~ s{((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]}
{"$1%$2(" . _escape($3) . ')'}eg;
_default_gettext($str, @_);
};
}
elsif ($style eq 'gettext') {
return \&_default_gettext;
}
else {
die "Unknown Style: $style";
}
}
inc/inc_Locale-Maketext-Simple/Locale/Maketext/Simple.pm view on Meta::CPAN
$1 ? (
($1 eq 'tense') ? (($3 eq 'present') ? 'ing' : 'ed') :
($1 eq 'quant') ? ' ' . (($digit > 1) ? ($4 || "$3s") : $3) :
''
) : ''
);
}egx;
return $str;
};
sub _escape {
my $text = shift;
$text =~ s/\b_([1-9]\d*)/%$1/g;
return $text;
}
sub _unescape {
join(',', map {
/\A(\s*)%([1-9]\d*|\*)(\s*)\z/ ? "$1_$2$3" : $_
} split(/,/, $_[0]));
}
sub auto_path {
my ($self, $calldir) = @_;
$calldir =~ s#::#/#g;
my $path = $INC{$calldir . '.pm'} or return;
inc/inc_Module-Build/Module/Build/PPMMaker.pm view on Meta::CPAN
print "Using default codebase '$distfile'\n";
@codebase = ($distfile);
}
my %dist;
foreach my $info (qw(name author abstract version)) {
my $method = "dist_$info";
$dist{$info} = $build->$method() or die "Can't determine distribution's $info\n";
}
$self->_simple_xml_escape($_) foreach $dist{abstract}, @{$dist{author}};
# TODO: could add <LICENSE HREF=...> tag if we knew what the URLs were for
# various licenses
my $ppd = <<"PPD";
<SOFTPKG NAME=\"$dist{name}\" VERSION=\"$dist{version}\">
<ABSTRACT>$dist{abstract}</ABSTRACT>
@{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
<IMPLEMENTATION>
PPD
inc/inc_Module-Build/Module/Build/PPMMaker.pm view on Meta::CPAN
# We only include these tags if this module involves XS, on the
# assumption that pure Perl modules will work on any OS.
if (keys %{$build->find_xs_files}) {
my $perl_version = $self->_ppd_version($build->perl_version);
$ppd .= sprintf(<<'EOF', $self->_varchname($build->config) );
<ARCHITECTURE NAME="%s" />
EOF
}
foreach my $codebase (@codebase) {
$self->_simple_xml_escape($codebase);
$ppd .= sprintf(<<'EOF', $codebase);
<CODEBASE HREF="%s" />
EOF
}
$ppd .= <<'EOF';
</IMPLEMENTATION>
</SOFTPKG>
EOF
inc/inc_Module-Build/Module/Build/PPMMaker.pm view on Meta::CPAN
# Append "-5.8" to architecture name for Perl 5.8 and later
if ($] >= 5.008) {
my $vstring = sprintf "%vd", $^V;
$vstring =~ s/\.\d+$//;
$varchname .= "-$vstring";
}
return $varchname;
}
{
my %escapes = (
"\n" => "\\n",
'"' => '"',
'&' => '&',
'>' => '>',
'<' => '<',
);
my $rx = join '|', keys %escapes;
sub _simple_xml_escape {
$_[1] =~ s/($rx)/$escapes{$1}/go;
}
}
1;
__END__
=head1 NAME
Module::Build::PPMMaker - Perl Package Manager file creation
inc/inc_Module-Build/Module/Build/Platform/VMS.pm view on Meta::CPAN
# or if we get a single arg that is an array reference, quote the
# elements of it and return the reference.
my ($self, @args) = @_;
my $got_arrayref = (scalar(@args) == 1
&& UNIVERSAL::isa($args[0], 'ARRAY'))
? 1
: 0;
# Do not quote qualifiers that begin with '/'.
map { if (!/^\//) {
$_ =~ s/\"/""/g; # escape C<"> by doubling
$_ = q(").$_.q(");
}
}
($got_arrayref ? @{$args[0]}
: @args
);
return $got_arrayref ? $args[0]
: join(' ', @args);
}
inc/inc_Module-Build/Module/Build/Platform/Windows.pm view on Meta::CPAN
}
}
return join " ", @quoted;
}
sub split_like_shell {
# As it turns out, Windows command-parsing is very different from
# Unix command-parsing. Double-quotes mean different things,
# backslashes don't necessarily mean escapes, and so on. So we
# can't use Text::ParseWords::shellwords() to break a command string
# into words. The algorithm below was bashed out by Randy and Ken
# (mostly Randy), and there are a lot of regression tests, so we
# should feel free to adjust if desired.
(my $self, local $_) = @_;
return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
my @argv;
inc/inc_Module-Build/Module/Build/WithXSpp.pm view on Meta::CPAN
$self->add_to_cleanup($obj);
}
$self->{properties}{objects} ||= [];
push @{$self->{properties}{objects}}, @objects;
return $self->SUPER::ACTION_code(@_);
}
# I guess I should use a module here.
sub _naive_shell_escape {
my $s = shift;
$s =~ s/\\/\\\\/g;
$s =~ s/"/\\"/g;
$s
}
sub ACTION_generate_main_xs {
my $self = shift;
my $xs_files = $self->find_xs_files;
inc/inc_Module-Build/Module/Build/WithXSpp.pm view on Meta::CPAN
#undef do_close
#ifdef __cplusplus
}
#endif
MODULE = $module_name PACKAGE = $module_name
HERE
my $typemap_args = '';
$typemap_args .= '-t "' . _naive_shell_escape(Cwd::abs_path($_)) . '" ' foreach keys %$xspt_files;
foreach my $xsp_file (keys %$xsp_files) {
my $full_path_file = _naive_shell_escape( Cwd::abs_path($xsp_file) );
my $cmd = qq{INCLUDE_COMMAND: \$^X -MExtUtils::XSpp::Cmd -e xspp -- $typemap_args "$full_path_file"\n\n};
$xs_code .= $cmd;
}
my $outfile = File::Spec->catdir($self->build_dir, 'main.xs');
open my $fh, '>', $outfile
or die "Could not open '$outfile' for writing: $!";
print $fh $xs_code;
close $fh;
( run in 1.201 second using v1.01-cache-2.11-cpan-c21f80fb71c )