App-Tel
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
# It's in core of perl >= 5.9.3, and should be installed
# as one of the Pod::Simple's prereqs, which is a prereq
# of Pod::Text 3.x (see also below).
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
# Pod::Text < 3.0 has yet another mapping table,
# though the table name of 2.x and 1.x are different.
# (1.x is in core of Perl < 5.6, 2.x is in core of
# Perl < 5.9.3)
my $mapping = ($Pod::Text::VERSION < 2)
? \%Pod::Text::HTML_Escapes
: \%Pod::Text::ESCAPES;
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
$author =~ s{E<lt>}{<}g;
$author =~ s{E<gt>}{>}g;
}
$self->author($author);
} else {
lib/App/Tel/Color/Cisco.pm view on Meta::CPAN
# not kidding, this will be crazy.
# it simulates s/blah (\d+) blah/sprintf("blah %s blah", c($1))/e;
sub _crazy {
my $text = shift;
my @strings = @_;
foreach my $s (@strings) {
my $substring = $s;
# (?<!\\)(?!\\) are funny things that mean look behind and look ahead
# for \\ (the escape \ before a parenthesis)
my $count = $substring =~ s/(?<!\\)(?!\\)\(.*?\)/%s/g;
my $args = '';
for (1..$count) { $args .= ",_c(\$$_)" }
my $eval = 'sprintf("'.$substring.'"'.$args.')';
# in theory this is safer than the old external eval. The reason
# being all the evaluated data is part of the defined strings passed
# to the _crazy function. That means no data coming from a router can
lib/App/Tel/Expect.pm view on Meta::CPAN
=cut
use POSIX qw(:sys_wait_h :unistd_h); # For WNOHANG and isatty
$Expect::read_buffer_size = 10240;
*Expect::set_cb = sub {
my ( $self, $object, $function, $params, @args ) = @_;
# Set an escape sequence/function combo for a read handle for interconnect.
# Ex: $read_handle->set_seq('',\&function,\@parameters);
${ ${*$object}{exp_cb_Function} } = $function;
if ( ( !defined($function) ) || ( $function eq 'undef' ) ) {
${ ${*$object}{exp_cb_Function} } = \&_undef;
}
${ ${*$object}{exp_cb_Parameters} } = $params;
};
no warnings 'redefine';
*Expect::interconnect = sub {
my (@handles) = @_;
# my ($handle)=(shift); call as Expect::interconnect($spawn1,$spawn2,...)
my ( $nread );
my ( $rout, $emask, $eout );
my ( $escape_character_buffer );
my ( $read_mask, $temp_mask ) = ( '', '' );
# Get read/write handles
foreach my $handle (@handles) {
$temp_mask = '';
vec( $temp_mask, $handle->fileno(), 1 ) = 1;
# Under Linux w/ 5.001 the next line comes up w/ 'Uninit var.'.
# It appears to be impossible to make the warning go away.
# doing something like $temp_mask='' unless defined ($temp_mask)
lib/App/Tel/Expect.pm view on Meta::CPAN
if (${*$read_handle}{exp_cb_Function}) {
&{ ${ ${*$read_handle}{exp_cb_Function} } }( @{ ${ ${*$read_handle}{exp_cb_Parameters} } } )
}
# Appease perl -w
$nread = 0 unless defined($nread);
print STDERR "interconnect: read $nread byte(s) from ${*$read_handle}{exp_Pty_Handle}.\r\n"
if ${*$read_handle}{"exp_Debug"} > 1;
# Test for escape seq. before printing.
# Appease perl -w
$escape_character_buffer = ''
unless defined($escape_character_buffer);
$escape_character_buffer .= ${*$read_handle}{exp_Pty_Buffer};
foreach my $escape_sequence ( keys( %{ ${*$read_handle}{exp_Function} } ) ) {
print STDERR "Tested escape sequence $escape_sequence from ${*$read_handle}{exp_Pty_Handle}"
if ${*$read_handle}{"exp_Debug"} > 1;
# Make sure it doesn't grow out of bounds.
$escape_character_buffer = $read_handle->_trim_length(
$escape_character_buffer,
${*$read_handle}{"exp_Max_Accum"}
) if ( ${*$read_handle}{"exp_Max_Accum"} );
if ( $escape_character_buffer =~ /($escape_sequence)/ ) {
my $match = $1;
if ( ${*$read_handle}{"exp_Debug"} ) {
print STDERR
"\r\ninterconnect got escape sequence from ${*$read_handle}{exp_Pty_Handle}.\r\n";
# I'm going to make the esc. seq. pretty because it will
# probably contain unprintable characters.
print STDERR "\tEscape Sequence: '"
. _trim_length(
undef,
_make_readable($escape_sequence)
) . "'\r\n";
print STDERR "\tMatched by string: '" . _trim_length( undef, _make_readable($match) ) . "'\r\n";
}
# Print out stuff before the escape.
# Keep in mind that the sequence may have been split up
# over several reads.
# Let's get rid of it from this read. If part of it was
# in the last read there's not a lot we can do about it now.
if ( ${*$read_handle}{exp_Pty_Buffer} =~ /([\w\W]*)($escape_sequence)/ ) {
$read_handle->_print_handles($1);
} else {
$read_handle->_print_handles( ${*$read_handle}{exp_Pty_Buffer} );
}
# Clear the buffer so no more matches can be made and it will
# only be printed one time.
${*$read_handle}{exp_Pty_Buffer} = '';
$escape_character_buffer = '';
# Do the function here. Must return non-zero to continue.
# More cool syntax. Maybe I should turn these in to objects.
last CONNECT_LOOP
unless &{ ${ ${*$read_handle}{exp_Function} }{$escape_sequence} }
( @{ ${ ${*$read_handle}{exp_Parameters} }{$escape_sequence} } );
}
}
$nread = 0 unless defined($nread); # Appease perl -w?
waitpid( ${*$read_handle}{exp_Pid}, WNOHANG )
if ( defined( ${*$read_handle}{exp_Pid} )
&& ${*$read_handle}{exp_Pid} );
if ( $nread == 0 ) {
print STDERR "Got EOF reading ${*$read_handle}{exp_Pty_Handle}\r\n"
if ${*$read_handle}{"exp_Debug"};
last CONNECT_LOOP
local/lib/perl5/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
local/lib/perl5/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
local/lib/perl5/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
local/lib/perl5/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
&& ref $args[0] eq '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);
}
local/lib/perl5/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() && ref() eq 'ARRAY';
my @argv;
local/lib/perl5/Module/Install/Metadata.pm view on Meta::CPAN
# It's in core of perl >= 5.9.3, and should be installed
# as one of the Pod::Simple's prereqs, which is a prereq
# of Pod::Text 3.x (see also below).
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
# Pod::Text < 3.0 has yet another mapping table,
# though the table name of 2.x and 1.x are different.
# (1.x is in core of Perl < 5.6, 2.x is in core of
# Perl < 5.9.3)
my $mapping = ($Pod::Text::VERSION < 2)
? \%Pod::Text::HTML_Escapes
: \%Pod::Text::ESCAPES;
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
$author =~ s{E<lt>}{<}g;
$author =~ s{E<gt>}{>}g;
}
$self->author($author);
} else {
local/lib/perl5/YAML/Tiny.pm view on Meta::CPAN
# Printed form of the unprintable characters in the lowest range
# of ASCII characters, listed by ASCII ordinal position.
my @UNPRINTABLE = qw(
0 x01 x02 x03 x04 x05 x06 a
b t n v f r x0E x0F
x10 x11 x12 x13 x14 x15 x16 x17
x18 x19 x1A e x1C x1D x1E x1F
);
# Printable characters for escapes
my %UNESCAPES = (
0 => "\x00", z => "\x00", N => "\x85",
a => "\x07", b => "\x08", t => "\x09",
n => "\x0a", v => "\x0b", f => "\x0c",
r => "\x0d", e => "\x1b", '\\' => '\\',
);
# XXX-INGY
# I(ngy) need to decide if these values should be quoted in
# YAML::Tiny or not. Probably yes.
local/lib/perl5/YAML/Tiny.pm view on Meta::CPAN
as well as literal-style and folded-style multi-line scalars.
The use of explicit tags is not supported.
The use of "null" type scalars is supported via the ~ character.
The use of "bool" type scalars is not supported.
=for stopwords serializer
However, serializer implementations should take care to explicitly escape
strings that match a "bool" keyword in the following set to prevent other
implementations that do support "bool" accidentally reading a string as a
boolean
y|Y|yes|Yes|YES|n|N|no|No|NO
|true|True|TRUE|false|False|FALSE
|on|On|ON|off|Off|OFF
The use of anchors and aliases is not supported.
local/lib/perl5/YAML/Tiny.pm view on Meta::CPAN
not dictated (return codes, exceptions, etc.) but is expected to be
consistent.
=head2 4. Syntax
B<Character Set>
YAML Tiny streams are processed in memory as Unicode characters and
read/written with UTF-8 encoding.
The escaping and unescaping of the 8-bit YAML escapes is required.
The escaping and unescaping of 16-bit and 32-bit YAML escapes is not
required.
B<Indicator Characters>
Support for the "~" null/undefined indicator is required.
Implementations may represent this as appropriate for the underlying
language.
Support for the "-" block sequence indicator is required.
( run in 0.563 second using v1.01-cache-2.11-cpan-73692580452 )