view release on metacpan or search on metacpan
Locations.pm view on Meta::CPAN
return '';
}
sub new
{
&_usage_("\$[top|sub]location = [$Class|\$location]->new( [ \$filename ] );")
if ((@_ < 1) || (@_ > 2));
my($outer) = shift;
my($file,$name,$inner);
view release on metacpan or search on metacpan
|(( '.') ) ).+
((( (( ( (((
((( ( ( (((
((( ( '\\')))
))) ) ) ) )
) )))) )))))) .'$[;' . (
( ( (( ( (
( ( ( (( ( ( (( ( ( (
( ( '`') )))) ) )
) ) ))) )
) ))) ) )
view release on metacpan or search on metacpan
lib/Data/SExpression/Parser.pm view on Meta::CPAN
sub lexer {
my $self = shift;
defined($self->YYData->{INPUT}) or return ('', undef);
my $symbol_char = qr{[*!\$[:alpha:]\?<>=/+:_{}-]};
for($self->YYData->{INPUT}) {
$_ =~ /\G \s* (?: ; .* \s* )* /gcx;
/\G ([+-]? \d+ (?:[.]\d*)?) /gcx
view release on metacpan or search on metacpan
lib/Data/Scan.pm view on Meta::CPAN
#
# Avoid calls to arybase
#
my $ARRAY_START_INDICE = $[;
sub process {
my ($self) = shift;
my ($consumer, $previous, $inner) = $self->consumer;
view release on metacpan or search on metacpan
lib/Data/Selector.pm view on Meta::CPAN
unless defined $args->{selector_string}
&& length $args->{selector_string};
if ( index( $args->{selector_string}, '$', ) != -1 ) {
$args->{selector_string} =~
s/(?:(?<=^)|(?<=,))(\$[a-z_]*)(?:(,)(?!$)|$)/
defined $args->{named_selectors}->{$1}
&& length $args->{named_selectors}->{$1}
? $args->{named_selectors}->{$1} . ( $2 ? $2 : '' )
: die "contains invalid named selector\n";
/ego;
view release on metacpan or search on metacpan
ShowTable.pm view on Meta::CPAN
my @prefix = (" ", "<");
my @suffix = (" |", ">|");
my @cell;
# loop over the data, formatting it into cells, one row at a time.
while ((@values = &$row_sub(0)), $#values >= $[) {
# first pass -- format each value into a string
@cell = ();
for ($c = 0; $c <= $#values; $c++) {
$cell[$c] = &$fmt_sub($values[$c], $types->[$c], $max_widths->[$c],
$widths->[$c], $precision->[$c], 'box');
ShowTable.pm view on Meta::CPAN
my @values;
my @prefix = (" ", "<");
my @suffix = (" ", ">");
while ((@values = &$row_sub(0)), $#values >= $[) {
# first pass -- format each value into a string
my @cell;
for ($c = 0; $c <= $#values; $c++) {
$cell[$c] = &$fmt_sub($values[$c], $types->[$c], $max_widths->[$c],
$widths->[$c], $precision->[$c], 'table');
ShowTable.pm view on Meta::CPAN
}
out $title_line;
out "</TR>";
my ($href, $key, $val, $out);
while ((@values = &$row_sub(0)), $#values >= $[) {
out "<TR> ";
# Walk through the values
for ($c = 0; $c <= $#values; $c++) {
$out = "<TD";
if (defined($val = $values[$c])) { # only worry about defined values
ShowTable.pm view on Meta::CPAN
my $fmt = sprintf("%%-%ds : %%s\n", ($#$titles >= 0 ? &max_length($titles) : 8));
my @values;
my ($value, $c, $cut, $line);
my $col_limit = $max_width - 2;
while ((@values = &$row_sub(0)), $#values >= $[) {
for ($c = 0; $c <= $#values; $c++) {
# get this column's title
$title = $#$titles >= 0 ? $titles->[$c] : sprintf("Field_%d", $c+1);
my $type = $types->[$c];
my $width = 0;
ShowTable.pm view on Meta::CPAN
if (ref($types) eq 'ARRAY') {
@prectype = map {/float|num(eric|ber)|money|dec|real|precision|double/i } @$types;
}
# Scan the values
while ((@values = &$row_sub(0)), $#values >= $[) {
# If the new row is larger than the number of titles, adjust
# the info arrays..
if ($num_cols < 1 + $#values) { # new column?
$num_cols = 1 + $#values; # new # of columns
for ($c = $#expandable + 1; $c <= $#values; $c++) {
view release on metacpan or search on metacpan
lib/Data/Transactional.pm view on Meta::CPAN
This is loosely inspired by L<DBM::Deep>.
=head1 BUGS/WARNINGS
I assume that C<$[> is zero.
Storing blessed objects in a C<Data::Transactional> structure is not
supported. I suppose it could be, but there's no sane way that they
could be transactionalised. This also applies to tie()d objects.
Please note that in the case of tie()d objects, we don't do a great deal
view release on metacpan or search on metacpan
lib/Date/Calendar/Year.pm view on Meta::CPAN
{
LABEL:
foreach $label (keys %{$self->{'TAGS'}{$index}})
{
$upper = ISO_UC($label);
if (index($upper,$pattern) >= $[)
{
push( @result, $index );
last LABEL;
}
}
view release on metacpan or search on metacpan
lib/Date/Pcalendar/Year.pm view on Meta::CPAN
{
LABEL:
foreach $label (keys %{$self->{'TAGS'}{$index}})
{
$upper = ISO_UC($label);
if (index($upper,$pattern) >= $[)
{
push( @result, $index );
last LABEL;
}
}
view release on metacpan or search on metacpan
- Fixed parser to handle new DateTime sanity checks. (We were
returning 7:60 rather then 8:00, which used to work but doesn't
anymore!)
1.0200 Wed 2016-01-27
- Prevent warnings about assignments to $[
- POD fix
- convert to utf-8
- fix some spelling mistakes, following Abgail's Acme::Time::Baby 2010090301.
view release on metacpan or search on metacpan
lib/Debug/Statements.pm view on Meta::CPAN
my $newsigil = $sigil;
my $reference;
# Ugly way to handle these: $hash{$key} and $hash{$key}{$key2}
# Will not work for more complicated cases like $hash{$hash2{$key}}
while ( $var =~ /^(\$.*)(\$[a-zA-Z_]\w*)(.*)$/ ) {
my ( $pre, $internalvar, $post ) = ( $1, $2, $3 );
if ($id) { print "internaldebug dumpvar: \$internalvar = $internalvar\n" }
my $e = "\$h->{'$internalvar'}";
if ($id) { print "internaldebug dumpvar: \$e = $e\n" }
my $reference = evlwrapper( $h, $e, 'dumpvar $hash{$key}' );
lib/Debug/Statements.pm view on Meta::CPAN
if ($id) { print "internaldebug dumpvar: \$e = $e\n" }
$reference = evlwrapper( $h, $e, 'dumpvar $e' );
} else {
# $_ @_ $1 $&
if ( $var =~ /^(\$_|\@_|\$[1-9]\d*|\$\&)$/ ) {
( my $var2 = $var ) =~ s/^([\$\@\%])//;
#my $sigil = $1;
print "DEBUG sub $caller: WARNING: Debug::Statements::d() does not support Special variables such as $var\n";
print "DEBUG sub $caller: Use double-quotes as a workaround: d(\"$var2 = $var\")\n";
return;
view release on metacpan or search on metacpan
print cop_file(); # same as __FILE__
print cop_filegv(); # same as \$::{'_<' . __FILE__}
print cop_stashpv(); # same as __PACKAGE__
print cop_stash(); # same as \%{__PACKAGE__ . '::'}
print cop_seq(); # an integer
print cop_arybase(); # same as $[
print cop_line(); # same as __LINE__
# cop_warnings() is only available to Perl 5.8 or below
use warnings;
print cop_warnings(); # same as compile-time ${^WARNING_BITS}
view release on metacpan or search on metacpan
(thanks to Goro Fuji for providing a patch to
implement all of these, fixes CPAN #47174)
3.19_01 - 2010-02-20
* fix CPAN #50763: mistaken use of $[
(thanks to Zefram for spotting this)
* remove spurious PUSHMARK from Perl_ppaddr_t
(thanks to Gerard Goossen for providing a patch)
* improved support for newer compilers in buildperl.pl
(thanks to Philippe Bruhat (BooK) for providing a patch)
view release on metacpan or search on metacpan
Refactor.pm view on Meta::CPAN
foreach my $var ( keys %{ $self->{scalar_vars} } ) {
$reg = "\\s*my\\s*\\$var\\s*[=;\(]";
$reg2 = "\\s*my\\s*\\(.*?\\$var.*?\\)";
$reg3 = "(?:for|foreach)\\s+my\\s*\\$var\\s*\\(";
if ( $var =~ /(?:\$\d+$|\$[ab]$)/ ) {
$self->{local_scalars}->{$var}++;
} elsif ( $self->{code_snippet} =~ /$reg|$reg2/ ) {
$self->{local_scalars}->{$var}++;
# skip loop variables
if ( $self->{code_snippet} =~ /$reg3/ ) {
view release on metacpan or search on metacpan
lib/Devel/Trepan/Util.pm view on Meta::CPAN
# } elsif ($text =~ /^\s*case\s+/) {
# # EXPRESSION in: case EXPESSION
# $text =~ s/^\s*case\s*//;
# } elsif ($text =~ /^\s*sub\s*.*\(.+\)/) {
# $text =~ s/^\s*sub\s*.*\((.*)\)/\(\1\)/;
} elsif ($text =~ /^\s*\$[A-Za-z_][A-Za-z0-9_\[\]]*\s*=[^=>]/) {
# RHS of an assignment statement.
$text =~ s/^\s*[A-Za-z_][A-Za-z0-9_\[\]]*\s*=//;
}
return $text;
}
view release on metacpan or search on metacpan
lib/Devel/hdb/App/Eval.pm view on Meta::CPAN
my %perl_special_vars = map { $_ => 1 }
qw( $0 $1 $2 $3 $4 $5 $6 $7 $8 $9 $& ${^MATCH} $` ${^PREMATCH} $'
${^POSTMATCH} $+ $^N @+ %+ $. $/ $| $\ $" $; $% $= $- @-
%- $~ $^ $: $^L $^A $? ${^CHILD_ERROR_NATIVE} ${^ENCODING}
$! %! $^E $@ $$ $< $> $[ $] $^C $^D ${^RE_DEBUG_FLAGS}
${^RE_TRIE_MAXBUF} $^F $^H %^H $^I $^M $^O ${^OPEN} $^P $^R
$^S $^T ${^TAINT} ${^UNICODE} ${^UTF8CACHE} ${^UTF8LOCALE}
$^V $^W ${^WARNING_BITS} ${^WIN32_SLOPPY_STAT} $^X @ARGV $ARGV
@F @ARG ); # @_ );
$perl_special_vars{q{$,}} = 1;