view release on metacpan or  search on metacpan

lib/Coro/Amazon/SimpleDB.pm  view on Meta::CPAN

    require Time::HiRes and Time::HiRes->import('time') if $debug;
    my ($start, $duration) = (0, 0);
    my @responses = ();
    $self->bug("starting async enqueues");
    $start = time() if $debug;
    for ($[ .. $#requests) {
        my $idx = $_;
        my $request = $requests[$idx];
        $self->bug("adding request $request");
        my $coro = async {
            my ($start, $duration) = (0, 0);

lib/Coro/Amazon/SimpleDB.pm  view on Meta::CPAN

                      } @{ $response->getGetAttributesResult->getAttribute }
                  }
            :     $response
            ;
        ($item_name => $attributes);
    } $[ .. $#items;
    return \%items;
}

 view release on metacpan or  search on metacpan

t/12_blessed.t  view on Meta::CPAN

ok ($js->encode ($o2) eq "null");
ok ($js->encode ($o3) eq "null");
$js->allow_blessed->convert_blessed;
ok ($js->encode ($o1) eq '{"__":""}', 'allow_blessed + convert_blessed');
SKIP: {
  skip "5.6", 2 if $[ < 5.008;
  # PP returns null
  $r = $js->encode ($o2);
  ok ($r eq 'null', "$r");
  $r = $js->encode ($o3);
 TODO: {

 view release on metacpan or  search on metacpan

eg/chat2new.pl  view on Meta::CPAN

# returns undef if can't find a pty.
# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik.

sub _getpty { ## private
	local($_PTY,$_TTY) = @_;
	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
	local($pty, $tty, $kind);
	if( -e "/dev/pts000" ){		## mods by Joe Doupnik Dec 1992
		$kind = "pts";		## SVR4 Streams
	} else {
		$kind = "pty";		## BSD Clist stuff

 view release on metacpan or  search on metacpan

t/01-crypt-password.t  view on Meta::CPAN

    }
};
$special->{modular} = sub {
    diag "modular special";
    my $c = password("hello0");
    like $c, qr/^\$5\$(........)\$[a-zA-Z0-9\.\/]{43}$/, "crypted";
    my $c2 = password("hello0");
    like $c2, qr/^\$5\$(........)\$[a-zA-Z0-9\.\/]{43}$/, "another crypted";
    isnt $c, $c2, "generated different salts";
    $DB::single = 1;
    ok(check_password($c, "hello0"), "check passed");
    ok(check_password($c2, "hello0"), "check passed");
    ok(!check_password($c, "helu"), "check failed");

 view release on metacpan or  search on metacpan

src/aclocal.m4  view on Meta::CPAN

lt_cl_help="\
\`$as_me' creates a local libtool stub from the current configuration,
for use in further configure time tests before the real libtool is
generated.

Usage: $[0] [[OPTIONS]]

  -h, --help      print this help, then exit
  -V, --version   print version number, then exit
  -q, --quiet     do not print progress messages
  -d, --debug     don't remove temporary files

src/aclocal.m4  view on Meta::CPAN

Report bugs to <bug-libtool@gnu.org>."

lt_cl_version="\
m4_ifset([AC_PACKAGE_NAME], [AC_PACKAGE_NAME ])config.lt[]dnl
m4_ifset([AC_PACKAGE_VERSION], [ AC_PACKAGE_VERSION])
configured by $[0], generated by m4_PACKAGE_STRING.

Copyright (C) 2008 Free Software Foundation, Inc.
This config.lt script is free software; the Free Software Foundation
gives unlimited permision to copy, distribute and modify it."

while test $[#] != 0
do
  case $[1] in
    --version | --v* | -V )
      echo "$lt_cl_version"; exit 0 ;;
    --help | --h* | -h )
      echo "$lt_cl_help"; exit 0 ;;
    --debug | --d* | -d )
      debug=: ;;
    --quiet | --q* | --silent | --s* | -q )
      lt_cl_silent=: ;;

    -*) AC_MSG_ERROR([unrecognized option: $[1]
Try \`$[0] --help' for more information.]) ;;

    *) AC_MSG_ERROR([unrecognized argument: $[1]
Try \`$[0] --help' for more information.]) ;;
  esac
  shift
done

if $lt_cl_silent; then

src/aclocal.m4  view on Meta::CPAN

AC_MSG_RESULT([$xsi_shell])
_LT_CONFIG_LIBTOOL_INIT([xsi_shell='$xsi_shell'])

AC_MSG_CHECKING([whether the shell understands "+="])
lt_shell_append=no
( foo=bar; set foo baz; eval "$[1]+=\$[2]" && test "$foo" = barbaz ) \
    >/dev/null 2>&1 \
  && lt_shell_append=yes
AC_MSG_RESULT([$lt_shell_append])
_LT_CONFIG_LIBTOOL_INIT([lt_shell_append='$lt_shell_append'])

src/aclocal.m4  view on Meta::CPAN

}

# func_arith arithmetic-term...
func_arith ()
{
  func_arith_result=$(( $[*] ))
}

# func_len string
# STRING may not start with a hyphen.
func_len ()

src/aclocal.m4  view on Meta::CPAN

}

# func_arith arithmetic-term...
func_arith ()
{
  func_arith_result=`expr "$[@]"`
}

# func_len string
# STRING may not start with a hyphen.
func_len ()
{
  func_len_result=`expr "$[1]" : ".*" 2>/dev/null || echo $max_cmd_len`
}

_LT_EOF
esac

src/aclocal.m4  view on Meta::CPAN

# func_append var value
# Append VALUE to the end of shell variable VAR.
func_append ()
{
  eval "$[1]+=\$[2]"
}
_LT_EOF
    ;;
  *)
    cat << \_LT_EOF >> "$cfgfile"

# func_append var value
# Append VALUE to the end of shell variable VAR.
func_append ()
{
  eval "$[1]=\$$[1]\$[2]"
}

_LT_EOF
    ;;
  esac

src/aclocal.m4  view on Meta::CPAN

# symlink; some systems play weird games with the mod time of symlinks
# (eg FreeBSD returns the mod time of the symlink's containing
# directory).
if (
   set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null`
   if test "$[*]" = "X"; then
      # -L didn't work.
      set X `ls -t "$srcdir/configure" conftest.file`
   fi
   rm -f conftest.file
   if test "$[*]" != "X $srcdir/configure conftest.file" \
      && test "$[*]" != "X conftest.file $srcdir/configure"; then

      # If neither matched, then we have a broken ls.  This can happen
      # if, for instance, CONFIG_SHELL is bash and it inherits a
      # broken ls alias from the environment.  This has actually
      # happened.  Such a system could not be considered "sane".
      AC_MSG_ERROR([ls -t appears to fail.  Make sure there is not a broken
alias in your environment])
   fi

   test "$[2]" = conftest.file
   )
then
   # Ok.
   :
else

 view release on metacpan or  search on metacpan

Tea_JS.pm  view on Meta::CPAN

}
sub binary2ascii {
	return str2ascii(binary2str(@_));
}
sub ascii2binary {
	return str2binary(ascii2str($_[$[]));
}
sub str2binary {   my @str = split //, $_[$[];
	my @intarray = (); my $ii = $[;
	while (1) {
		last unless @str; $intarray[$ii]  = (0xFF & ord shift @str)<<24;
		last unless @str; $intarray[$ii] |= (0xFF & ord shift @str)<<16;
		last unless @str; $intarray[$ii] |= (0xFF & ord shift @str)<<8;
		last unless @str; $intarray[$ii] |=  0xFF & ord shift @str;

Tea_JS.pm  view on Meta::CPAN

		push @str, chr(0xFF & ($i>>24)), chr(0xFF & ($i>>16)),
		 chr(0xFF & ($i>>8)), chr(0xFF & $i);
	}
	return join '', @str;
}
sub ascii2str {   my $a = $_[$[]; # converts pseudo-base64 to string of bytes
	local $^W = 0;
	$a =~ tr#-A-Za-z0-9+_##cd;
	my $ia = $[-1;  my $la = length $a;   # BUG not length, final!
	my $ib = $[;  my @b = ();
	my $carry;
	while (1) {   # reads 4 ascii chars and produces 3 bytes
		$ia++; last if ($ia>=$la);
		$b[$ib]  = $a2b{substr $a, $ia+$[, 1}<<2;
		$ia++; last if ($ia>=$la);
		$carry=$a2b{substr $a, $ia+$[, 1};  $b[$ib] |= ($carry>>4); $ib++;
		# if low 4 bits of $carry are 0 and its the last char, then break
		$carry = 0xF & $carry; last if ($carry == 0 && $ia == ($la-1));
		$b[$ib]  = $carry<<4;
		$ia++; last if ($ia>=$la);
		$carry=$a2b{substr $a, $ia+$[, 1};  $b[$ib] |= ($carry>>2); $ib++;
		# if low 2 bits of $carry are 0 and its the last char, then break
		$carry = 03 & $carry; last if ($carry == 0 && $ia == ($la-1));
		$b[$ib]  = $carry<<6;
		$ia++; last if ($ia>=$la);
		$b[$ib] |= $a2b{substr $a, $ia+$[, 1}; $ib++;
	}
	return pack 'C*', @b;   # 2.16
}
sub str2ascii {   my $b = $_[$[]; # converts string of bytes to pseudo-base64
	my $ib = $[;  my $lb = length $b;  my @s = ();
	my $b1; my $b2; my $b3;
	my $carry;
	while (1) {   # reads 3 bytes and produces 4 ascii chars
		if ($ib >= $lb) { last; };
		$b1 = ord substr $b, $ib+$[, 1;  $ib++;
		push @s, $b2a{$b1>>2}; $carry = 03 & $b1;
		if ($ib >= $lb) { push @s, $b2a{$carry<<4}; last; }
		$b2 = ord substr $b, $ib+$[, 1;  $ib++;
		push @s, $b2a{($b2>>4) | ($carry<<4)}; $carry = 0xF & $b2;
		if ($ib >= $lb) { push @s, $b2a{$carry<<2}; last; }
		$b3 = ord substr $b, $ib+$[, 1;  $ib++;
		push @s, $b2a{($b3>>6) | ($carry<<2)}, $b2a{077 & $b3};
		if (!$ENV{REMOTE_ADDR} && (($ib % 36) == 0)) { push @s, "\n"; }
	}
	return join('', @s);
}
sub asciidigest {   # returns 22-char ascii signature
	return binary2ascii(binarydigest($_[$[]));
}
sub binarydigest { my $str = $_[$[];  # returns 4 32-bit-int binary signature
	# warning: mode of use invented by Peter Billam 1998, needs checking !
	return '' unless $str;
	if ($] > 5.007 && Encode::is_utf8($str)) {
		Encode::_utf8_off($str);
		# $str = Encode::encode_utf8($str);

Tea_JS.pm  view on Meta::CPAN

	my $npads = 7 - ((length $str) % 8);
	$str  = chr($npads|(0xF8 & rand_byte())) . $str;
	if ($npads) {
		my $padding = pack 'CCCCCCC', rand_byte(), rand_byte(),
		 rand_byte(), rand_byte(), rand_byte(), rand_byte(), rand_byte(); 
		$str  = $str . substr($padding,$[,$npads);
	}
	my @pblocks = str2binary($str);
	my $v0; my $v1;
	my $c0 = 0x61626364; my $c1 = 0x62636465; # CBC Initial Value. Retain !
	my @cblocks;

Tea_JS.pm  view on Meta::CPAN

		push @pblocks, $v0, $v1;
		$lastc0 = $c0;   $lastc1 = $c1;
	}
	my $str = binary2str(@pblocks);
	# remove no of pad chars at end specified by 1 char ('0'..'7') at front
	my $npads = 0x7 & ord $str; substr ($str, $[, 1) = '';
	if ($npads) { substr ($str, 0 - $npads) = ''; }
	return $str;
}
sub triple_encrypt { my ($plaintext,  $long_key) = @_;  # not yet ...
}

 view release on metacpan or  search on metacpan

t/extvec.t  view on Meta::CPAN

_bt/.77CwjdXLFI2Q2Ic :SDZ(GDNc&ymwKdq7p^hbk'@MKUEg]ntSb(a%L)!/VCET8kD7
_u3..o5G7CGXmiVftl0w si(Nb<8@D](~h47m[>+*Wh,k1s7`9o
_JV/.sK/chaBabs.r22w p,C75=:/\CO$b<1N/2sGuu#2%HSp,cBHy}3Ny3$/V
_Fu/.NqA1A3UXZwNqEBM g9__a,ax3"k?wn|CF
_L8..aopATqOIbENUckQ PSI\/&4hqrNJyiuR&p';mAP`/~5$4)d\FfcgSU&hD
_d3/.WrKw/puBiAtrruc l$4ktBjKxG=^qYdw&B#b!^wed!X6ModOot_Q;io8]:&$[F.xJ
_1v..LSxgR45HzV/dWMI -I1?<:Q[}'W:P
_C1...3IJaLhgpP5yl2Q j;H@$Z
_5H0.PjD9w2E.ud.LTIs 7CmnUws(=h*pn;d0=QM9Oj=I

 view release on metacpan or  search on metacpan

lib/Ecyrillic.pm  view on Meta::CPAN

        $slash = 'div';
        return $1;
    }
    #                $ $ $ $ $ $ $ $ $ $ $ $ $ $
    #                $ @ # \ ' " / ? ( ) [ ] < >
    elsif (/\G ( \$[\$\@\#\\\'\"\/\?\(\)\[\]\<\>] ) /oxmsgc) {
        $slash = 'div';
        return $1;
    }

# while (<FILEHANDLE>)

lib/Ecyrillic.pm  view on Meta::CPAN

            $e_string .= $1;
            $slash = 'div';
        }
        #                           $ $ $ $ $ $ $ $ $ $ $ $ $ $
        #                           $ @ # \ ' " / ? ( ) [ ] < >
        elsif ($string =~ /\G ( \$[\$\@\#\\\'\"\/\?\(\)\[\]\<\>] ) /oxmsgc) {
            $e_string .= $1;
            $slash = 'div';
        }

# qq//

 view release on metacpan or  search on metacpan

t/9050-pod.t  view on Meta::CPAN

    }
    my @missing_diag;
    for my $msg (sort keys %die_msgs) {
        next if exists $diag_items{$msg};
        (my $pat = $msg) =~ s/\$\w+/<VAR>/g;
        $pat =~ s/\$[@!]/<VAR>/g;
        $pat =~ s/\\n$//;
        my $found = 0;
        for my $item (keys %diag_items) {
            (my $norm = $item) =~ s/<[A-Za-z][^>]*>/<VAR>/g;
            $norm =~ s/'[^']*'/'<VAR>'/g;

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

    my $cmd = $orig;
    my $debug = $::opt_d || $::opt_v;
    print "Evaluating `$orig`\n"
	if $debug && !$expand_shellescape{$orig};
    # ensure we have no $(...) vars left - strip out undefined ones:
    $cmd =~ s/\$[({](\w+)[})]/mkvar("$1", 1, 0, $level+1)/ge;
    print "  expanded `$cmd`\n" if $debug and $cmd ne $orig;
    my $result = `$cmd`;
    $result =~ s/\s+$/ /; # newlines etc to single space
    print "  returned '$result'\n"
	if $debug && !$expand_shellescape{$orig};

Makefile.PL  view on Meta::CPAN

    $level ||= 1;
    local($_) = $string;
    print "$level Expanding $_\n" if $::opt_d;
    # handle whizzo AIX make feature used by Oracle
    s/\$[({] (\w+) \? ([^(]*?) : ([^(]*?) [})]/
	my ($vname, $vT, $vF) = ($1,$2,$3);
	$MK{$vname} = (mkvar($vname, 1, $backtick, $level+1)) ? $vT : $vF
    /xge; # can recurse
    s/\$[({] (\w+) [})]/
	mkvar("$1", $strip, $backtick, $level+1, $maxlevel)
    /xge; # can recurse
    s/`(.*?[^\\])`/expand_shellescape("$1", $level+1)/esg if $backtick; # can recurse
    s/\s*\\\n\s*/ /g;	# merge continuations
    s/\s+/ /g;	# shrink whitespace

 view release on metacpan or  search on metacpan

lib/DBD/PgPP.pm  view on Meta::CPAN

            redo Parse;
        }
        elsif (m{\G( -- [^\n]* )}xmsgc) { }
        elsif (m{\G( \' (?> [^\\\']* (?> \\. [^\\\']*)* ) \' )}xmsgc) { }
        elsif (m{\G( \" [^\"]* \" )}xmsgc) { }
        elsif (m{\G( \s+ | \w+ | ::? | \$[0-9]+ | [-/*\$]
                 | [^[:ascii:]]+ | [\0-\037\177]+)}xmsgc) { }
        elsif (m{\G( [+<>=~!\@\#%^&|`,;.()\[\]{}]+ )}xmsgc) { }
        elsif (m{\G( [\'\"\\] )}xmsgc) { } # unmatched: a bug in your query
        else {
            my $pos = pos;

 view release on metacpan or  search on metacpan

lib/DBD/PgPPSjis.pm  view on Meta::CPAN

            push @tokens, \(my $tmp = $param_num++), '';
            redo Parse;
        }

        # key words, numeric constants, etc
###     elsif (m{\G( \s+             | \w+                                                         | ::? | \$[0-9]+ | [-/*\$] | [^[:ascii:]]+                            | [\0-\037\177]+ )}xmsgc) {
        elsif (m{\G( [\t\n\f\r\x20]+ | [_ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0-9]+ | ::? | \$[0-9]+ | [-/*\$] | (?:$sjis_mbcs|[\x80\xA0-\xDF\xFD-\xFF])+ | [\0-\037\177]+ )}xmsgc) {
        }

        # operators are + - * / < > = ~ ! @ # % ^ & | ` ?
        # special characters are $ ( ) [ ] , ; : * .
        elsif (m{\G( [+<>=~!\@\#%^&|`,;.()\[\]{}]+ )}xmsgc) {

 view release on metacpan or  search on metacpan

sqlite3.c  view on Meta::CPAN

    }else if( (flags & JSON_ABPATH) ){
      /* The -> and ->> operators accept abbreviated PATH arguments.  This
      ** is mostly for compatibility with PostgreSQL, but also for
      ** convenience.
      **
      **     NUMBER   ==>  $[NUMBER]     // PG compatible
      **     LABEL    ==>  $.LABEL       // PG compatible
      **     [NUMBER] ==>  $[NUMBER]     // Not PG.  Purely for convenience
      **
      ** Updated 2024-05-27:  If the NUMBER is negative, then PG counts from
      ** the right of the array.  Hence for negative NUMBER:
      **
      **     NUMBER   ==>  $[#NUMBER]    // PG compatible
      */
      jsonStringInit(&jx, ctx);
      if( sqlite3_value_type(argv[i])==SQLITE_INTEGER ){
        jsonAppendRawNZ(&jx, "[", 1);
        if( zPath[0]=='-' ) jsonAppendRawNZ(&jx,"#",1);

 view release on metacpan or  search on metacpan

lib/JSprite.pm  view on Meta::CPAN

				$errdetails = $i;
				return (-525);
			}
		}
	}
	#$single  = ($#columns) ? $columns[$[] : $column_string;
	$single  = ($#columns) ? $columns[$#columns] : $column_string;
	$rowcnt = 0;

	my (@these_results);
	my ($skipreformat) = 0;