view release on metacpan or  search on metacpan

lib/Acme/Monkey.pm  view on Meta::CPAN

	    $ycoord -= 1;
	
	    my $location = ($ycoord * $self->{WIDTH}) + $xcoord;
	
	    for my $line(@$what) {
		    substr($self->{BUFFER}, $location, length($line), $line);
		    $location += $self->{WIDTH};
	    }
    }

    sub draw {

 view release on metacpan or  search on metacpan

Audible.pm  view on Meta::CPAN

sub record{
	local $_ = unpack 'b*', pop;
	s/(.)/$1?$long:$short/eg;
	$_="\0\xC0\x11\0\xFF\x59\x02\0\0$_\0\xFF\x2F";
	$hearable . pack('L', length($_)) . $_;
}

sub play{
	local $_ = pop;
	chomp;
	s/^$hearable.{4}.+?\0{2}//;s/\0\xFF\x2F$//;
	s/\xFF\x40(.+?)\x56\0/length($1)==7?1:0/ge;
	pack 'b*', $_;
}

open 0 or die "Cannot hear '$0'.\n";
(my $telegram = do{local $/=undef;<0>}) =~ s/.*^\s*(use|no)\s+Acme::Morse::Audible\s*;\n//sm;

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

sub _version {
	my $s = shift || 0;
	   $s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
	   $l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

1;

 view release on metacpan or  search on metacpan

inc/Module/Install/Makefile.pm  view on Meta::CPAN

sub clean_files {
    my $self = shift;
    my $clean = $self->makemaker_args->{clean} ||= {};
    %$clean = (
        %$clean, 
        FILES => join(" ", grep length, $clean->{FILES}, @_),
    );
}

sub libs {
    my $self = shift;

 view release on metacpan or  search on metacpan

lib/Acme/Nyaa.pm  view on Meta::CPAN

    return $self->{'language'} if $lang eq $self->{'language'};
    return $self->{'language'} unless $lang =~ m/\A[a-zA-Z]{2}\z/;

    my $nekoobject = undef;
    my $referclass = $self->loadmodule( $lang );
    return $self->{'language'} unless length $referclass;
    return $self->{'language'} if $referclass eq $self->subclass;

    $nekoobject = $self->findobject( $referclass, 1 );
    return $self->{'language'} unless ref $nekoobject eq $referclass;

lib/Acme/Nyaa.pm  view on Meta::CPAN

    my $list = $self->{'loaded-languages'};

    my $referclass = __PACKAGE__.'::'.ucfirst( lc $lang );
    my $alterclass = __PACKAGE__.'::'.ucfirst( $Default );

    return q() unless length $lang;
    return $referclass if( grep { lc $lang eq $_ } @$list );

    eval {
        Module::Load::load $referclass; 
        push @$list, lc $lang;

lib/Acme/Nyaa.pm  view on Meta::CPAN

    my $name = shift;
    my $new1 = shift || 0;
    my $this = undef;
    my $objs = $self->{'objects'} || [];

    return unless length $name;

    for my $e ( @$objs ) {

        next unless ref($e) eq $name;
        $this = $e;

lib/Acme/Nyaa.pm  view on Meta::CPAN

    my $self = shift;
    my $argv = shift;
    my $text = undef;

    $text = ref $argv ? $$argv : $argv;
    return $text unless length $text;

    $self->reckon( \$text );
    return $text if $self->{'utf8flag'};
    return $text unless $self->{'encoding'};

lib/Acme/Nyaa.pm  view on Meta::CPAN

    my $argv = shift;
    my $text = undef;

    $text = ref $argv ? $$argv : $argv;
    return $text unless $self->{'encoding'};
    return $text unless length $text;

    $text = Encode::encode_utf8 $text if utf8::is_utf8 $text;
    if( $self->{'encoding'} ne 'utf8' ) {
        Encode::from_to( $text, 'utf8', $self->{'encoding'} );
    }

 view release on metacpan or  search on metacpan

lib/Acme/Ook.pm  view on Meta::CPAN

    # Coalesce sequences of increments or decrements
    my $prog = $_[1];
    # print "Before '$prog'\n";
    foreach my $thing ('$Ook', '$Ook[$Ook]') {
	foreach my $op ('+', '-') {
	    my $left = length "$thing$op$op;";
	    $prog =~ s{((?:\Q$thing$op$op\E;){2,})}
	      {"$thing$op=".(length ($1)/$left).';'}ges;
	}
    }
    # print "After '$prog'\n";
    return $prog;
}

lib/Acme/Ook.pm  view on Meta::CPAN

}

sub compile {
    my $self = shift;
    my $prog;
    $prog .= $self->_compile($$self, "(new)", 0) if defined $$self && length $$self;
    if (@_) {
	local *OOK;
	while (@_) {
	    my $code = shift;
	    if (ref $code eq 'IO::Handle') {

 view release on metacpan or  search on metacpan

example/pearl  view on Meta::CPAN

    my @parts = split(/\n/, $now);
    my ($maxy, $maxx) = `stty size` =~ /(\d+) (\d+)/;
    for (my $y = 0;$y < $maxy;$y++) {
        for (my $x = 0;$x < $maxx - 24;$x += 24) {
            my $line = $parts[($y % scalar(@parts))];
            $out .= $line . ' 'x(24 - length(encode('euc-jp', $line)));
        }
        $out .= "\n";
    }
    print $out;
}

 view release on metacpan or  search on metacpan

lib/Acme/PETEK/Testkit/modperl1.pm  view on Meta::CPAN

	return <<HTML;
<html><head><title>Counter: $value</title></head>
<body><form method="post"><input type="hidden" name="cur" value="$value">
<div align="center">
	<p><big>Current Value: <u>$value</u></big></p>
	<p><input type="text" name="decrval" value="1" size="3" maxlength="3"
		/><input type="submit" name="decrn" value="&lt;&lt;"
		/><input type="submit" name="decr1" value="&lt;"
		/><input type="submit" name="reset" value="-0-" 
		/><input type="submit" name="incr1" value="&gt;"
		/><input type="submit" name="incrn" value="&gt;&gt;"
		/><input type="text" name="incrval" value="1" size="3" maxlength="3"
		/></p>
</div>
</body></html>
HTML
}

 view release on metacpan or  search on metacpan

Export.pm  view on Meta::CPAN

	}
	if( ! $self->{"cfg"}->{"client"} ) {
		$self->{"cfg"}->{"client"} = uc($ENV{"hostname"}) || sprintf("%s-%0.5i", "Acme-PIA-Export", rand(99999));
	}
	my $requestbody = "$self->{cfg}->{username}~;~$self->{cfg}->{password}~;~$self->{cfg}->{client}~;~$scopes{$what};~export~;~O~;~~#~";
	my $content_length = length($requestbody);
	
	my $request =	"POST $query_url HTTP/1.1\n" .
			"Pragma: no-cache\n" .
			"Host: www.arcor.de\n" .
			"Accept-Ranges: bytes\n" .
			"Content-Type: text/html\n" .
			"Content-Length: $content_length\n" .
			"\n" .
			$requestbody;
	if( $self->{"cfg"}->{"DEBUG"} ) {
		print "Sending request:$/$request$/-------------------------------$/";
	}

 view release on metacpan or  search on metacpan

lib/Acme/PM/Barcelona/12x5_ca.pod  view on Meta::CPAN

=for latex \scriptsize

  $_=q;Barcelona Perl Mongers;,$/=y,gaudi,,,;map$,+=(split//)*(-1)**$|++
  ,(split)[.11_09,1.714];$.=''!~m~erce~;$"=y,catalunya,,,$;=y,rambles,,,
  $*=$/^$.;$:=$.+length,$@=$***$**$/**$*%$:,$%=$/*$"-$*;print+chr($_<0xA
  ?$.."$[$_":m:^$.:?$..$_:$_)for($**$**$/*$",$"*$@+$**$/,$**$,,$***$,,$/
  *$,,$;,$***$/,$,*$/,$.<<$,,$%-$*,$"+$/,$***$,,(($,*$*)**$*)-$/,$***$/,
  $@+$/,$:-($/**$*),$.,$:+$"+$*,$.<<$*,$,**$/-$:-$,,exp$:/$,,$",$.,$"*$*
  ,$***$,,log$.,$.,-$/+$"*$,,$/+$"*$;,$.,++$@,$***($/&=$/+Barcelona_pm))

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

    my $cwd = Cwd::cwd();

    $Config = [];

    my $maxlen = length(
        (
            sort   { length($b) <=> length($a) }
              grep { /^[^\-]/ }
              map  {
                ref($_)
                  ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
                  : ''

 view release on metacpan or  search on metacpan

lib/Acme/Padre/PlayCode.pm  view on Meta::CPAN

	my $doc  = $main->current->document;
	return unless $doc;
	my $src  = $main->current->text;
	my $code = $src ? $src : $doc->text_get;

	return unless ( defined $code and length($code) );
	
	require Acme::PlayCode;
	my $playapp = new Acme::PlayCode;	
	$playapp->load_plugin( $plugin );
	

 view release on metacpan or  search on metacpan

lib/Acme/Palindrome.pm  view on Meta::CPAN

open 0, ">$0" or print "Cannot reverse '$0'\n" and exit;
print {0} "use Acme::Palindrome;\n", backward $code and exit;

sub palindrome {
    my $max = 0;
    length > $max && ( $max = length ) for @_;
    return join "\n",
      map sprintf( "%${max}s", scalar reverse $_ ),
	reverse @_;
}

 view release on metacpan or  search on metacpan

t/009_http_tiny.t  view on Meta::CPAN

        my $orig_cb = $args->{data_callback};
        my $content = '';
        $args->{data_callback} = sub {
            my ( $data, $response ) = @_;

            # diag 'Progress: Received ' . length($data) . " bytes for $url";
            if ($orig_cb) {
                return $orig_cb->( $data, $response );
            }
            $content .= $data;
            return 1;

t/009_http_tiny.t  view on Meta::CPAN

                    Acme::Parataxis->spawn(
                        sub {
                            # Drain the request headers from client
                            my $buffer = '';
                            while (1) {
                                my $bytes = sysread( $client, $buffer, 4096, length($buffer) );
                                last if $buffer =~ /\r?\n\r?\n/;    # End of headers
                                if ( !defined $bytes ) {
                                    last if $! != POSIX::EAGAIN && $! != POSIX::EWOULDBLOCK;
                                    Acme::Parataxis->await_read( $client, 100 );
                                }
                                last if defined $bytes && $bytes == 0;    # EOF
                            }
                            #
                            my $response = "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nContent-Length: 2\r\nConnection: close\r\n\r\nHI";
                            my $offset   = 0;
                            my $len      = length($response);
                            while ( $offset < $len ) {
                                my $written = syswrite( $client, $response, $len - $offset, $offset );
                                if ( defined $written ) {
                                    $offset += $written;
                                }

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	}
	$s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map {
		$_ . '0' x (3 - length $_)
	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

    my $cwd = Cwd::cwd();

    $Config = [];

    my $maxlen = length(
        (
            sort   { length($b) <=> length($a) }
              grep { /^[^\-]/ }
              map  {
                ref($_)
                  ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
                  : ''

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	}
	$s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map {
		$_ . '0' x (3 - length $_)
	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

 view release on metacpan or  search on metacpan

inc/Module/Install/Makefile.pm  view on Meta::CPAN

sub clean_files {
    my $self  = shift;
    my $clean = $self->makemaker_args->{clean} ||= {};
    %$clean = (
        %$clean, 
        FILES => join(' ', grep length, $clean->{FILES}, @_),
    );
}

sub realclean_files {
    my $self  = shift;
    my $realclean = $self->makemaker_args->{realclean} ||= {};
    %$realclean = (
        %$realclean, 
        FILES => join(' ', grep length, $realclean->{FILES}, @_),
    );
}

sub libs {
    my $self = shift;

 view release on metacpan or  search on metacpan

inc/Module/Install/Makefile.pm  view on Meta::CPAN

sub clean_files {
    my $self = shift;
    my $clean = $self->makemaker_args->{clean} ||= {};
    %$clean = (
        %$clean, 
        FILES => join(" ", grep length, $clean->{FILES}, @_),
    );
}

sub libs {
    my $self = shift;

 view release on metacpan or  search on metacpan

lib/Acme/Phlegethoth.pm  view on Meta::CPAN

			((rand() < 0.25) ? $pre[rand @pre] : "") .
			$word[rand @word] .
			((rand() < 0.25) ? $suf[rand @suf] : "") .
			((rand() < 0.1) ? "! " : "") .
			" "
		) unless length $chant;
		$prayer .= $1, redo if $chant =~ s/([^a-z])$//;
		$prayer .= chop $chant;
		substr($prayer, -1, 1) =~ tr[a-z][A-Z] if $tentacle;
	}

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

    my $cwd = Cwd::cwd();

    $Config = [];

    my $maxlen = length(
        (
            sort   { length($b) <=> length($a) }
              grep { /^[^\-]/ }
              map  {
                ref($_)
                  ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
                  : ''

 view release on metacpan or  search on metacpan

inc/MyBumpVersionAfterRelease.pm  view on Meta::CPAN

use utf8;
use Path::Tiny 0.061;

# this is a smarter version of:
# [Run::AfterRelease]
# run = %x -p -i -e's/^version = 3\.(\d+)\s/sprintf(q(version = %0.( . (length($1)+1) . q(g), atan2(1,1)*4)/x'

sub after_release
{
    my $self = shift;

    # edits dist.ini to add one decimal point to the version

    my $Ï€ = atan2(1,1) * 4;
    my $original_version = $self->zilla->version;
    my $length = length($original_version);

    # add another digit if we added a 0, as it will be numerically identical
    do {} while substr($Ï€, $length++, 1) eq '0';

    my $new_version = substr($Ï€, 0, $length);

    # munge dist.ini to edit version line
    my $path = path('dist.ini');
    my $content = $path->slurp_utf8;

    my $delta_length = $length - length($original_version);

    if ($content =~ s/^(version = )$original_version\s{$delta_length}(\s+)/$1$new_version$2/m)
    {
        # append+truncate to preserve file mode
        $path->append_utf8({ truncate => 1 }, $content);
        return 1;
    }

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	}
	$s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map {
		$_ . '0' x (3 - length $_)
	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

 view release on metacpan or  search on metacpan

lib/Acme/Plack/Middleware/Acme/Werewolf.pm  view on Meta::CPAN

=head1 SYNOPSIS

  my $app = sub { ... };
  builder {
      enable "Acme::Werewolf", moonlength => 4;
      $app;
  };

=head1 DESCRIPTION

 view release on metacpan or  search on metacpan

lib/Tupelo/Munge.pm  view on Meta::CPAN

    $tuple = pure_tuple(\$s, \@a, \%h, \&c);
    $tuple = constant_tuple(\$s, \@a, \%h, \&c);
    $tuple = variable_tuple(\$s, \@a, \%h, \&c);

    use Tuple::Munge
	qw(tuple_mutable tuple_length tuple_slot tuple_slots);

    if(tuple_mutable($tuple)) { ...
    $len = tuple_length($tuple);
    $ref = tuple_slot($tuple, 3);
    @refs = tuple_slots($tuple);

    use Tuple::Munge qw(tuple_set_slot tuple_set_slots tuple_seal);

lib/Tupelo/Munge.pm  view on Meta::CPAN

our $VERSION = "0.000";

use parent "Exporter";
our @EXPORT_OK = qw(
	pure_tuple constant_tuple variable_tuple
	tuple_mutable tuple_length tuple_slot tuple_slots
	tuple_set_slot tuple_set_slots tuple_seal
);

XSLoader::load(__PACKAGE__, $VERSION);

lib/Tupelo/Munge.pm  view on Meta::CPAN

=item tuple_mutable(TUPLE)

I<TUPLE> must be a reference to a tuple.  Returns a truth value indicating
whether the tuple is mutable.

=item tuple_length(TUPLE)

I<TUPLE> must be a reference to a tuple.  Returns the number of slots
that the tuple currently has.

=item tuple_slot(TUPLE, INDEX)

 view release on metacpan or  search on metacpan

lib/Acme/ppport.h  view on Meta::CPAN

mg_findext|5.013008||pn
mg_find|||n
mg_free_type||5.013006|
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||n
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|n

lib/Acme/ppport.h  view on Meta::CPAN

reg_named_buff_nextkey||5.009005|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||n

lib/Acme/ppport.h  view on Meta::CPAN

utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|n
utf8_length||5.007001|
utf8_mg_len_cache_update|||
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr_buf||5.015009|
utf8_to_uvchr||5.007001|

lib/Acme/ppport.h  view on Meta::CPAN

if (exists $opt{'list-unsupported'}) {
  my $f;
  for $f (sort { lc $a cmp lc $b } keys %API) {
    next unless $API{$f}{todo};
    print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
  }
  exit 0;
}

# Scan for possible replacement candidates

lib/Acme/ppport.h  view on Meta::CPAN

#ifndef ERRSV
#  define ERRSV                          get_sv("@",FALSE)
#endif

/* Hint: gv_stashpvn
 * This function's backport doesn't support the length parameter, but
 * rather ignores it. Portability can only be ensured if the length
 * parameter is used for speed reasons, but the length can always be
 * correctly computed from the string argument.
 */
#ifndef gv_stashpvn
#  define gv_stashpvn(str,len,create)    gv_stashpv(str,create)
#endif

lib/Acme/ppport.h  view on Meta::CPAN

#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)

Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
    Size_t used, length, copy;

    used = strlen(dst);
    length = strlen(src);
    if (size > 0 && used < size - 1) {
        copy = (length >= size - used) ? size - used - 1 : length;
        memcpy(dst + used, src, copy);
        dst[used + copy] = '\0';
    }
    return used + length;
}
#endif
#endif

#if !defined(my_strlcpy)

lib/Acme/ppport.h  view on Meta::CPAN

#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)

Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
    Size_t length, copy;

    length = strlen(src);
    if (size > 0) {
        copy = (length >= size) ? size - 1 : length;
        memcpy(dst, src, copy);
        dst[copy] = '\0';
    }
    return length;
}

#endif
#endif
#ifndef PERL_PV_ESCAPE_QUOTE

 view release on metacpan or  search on metacpan

lib/Acme/Pony.pm  view on Meta::CPAN

}

sub scalepony {
	my @chars = @_;
	my $chars = join '', @chars;
  my $wantlength = length $chars;
  my $scale;

  # What scale do we want?
  if ($wantlength > 201242) {
    $scale = 1000 * sqrt($wantlength / 201242);
  } else {
    $scale = 1000 / sqrt(201242 / $wantlength);
  }
  $scale *= 0.95;

  # These were worked out by hand with very accurate graph paper
  my @xpoints = (0.26735840061026, 0.290728815714195, 0.297102536393109, 0.299227321848579, 0.322598690483758, 0.348092937511919, 0.36933761362914, 0.403331002479181, 0.430951624181552, 0.450073104062043, 0.471317780179264, 0.484066492912084, 0.49681...

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	}
	$s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map {
		$_ . '0' x (3 - length $_)
	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

 view release on metacpan or  search on metacpan

t/00-report-prereqs.t  view on Meta::CPAN

        }

        if ( @reports ) {
            push @full_reports, "=== $title ===\n\n";

            my $ml = _max( map { length $_->[0] } @reports );
            my $wl = _max( map { length $_->[1] } @reports );
            my $hl = _max( map { length $_->[2] } @reports );

            if ($type eq 'modules') {
                splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
                push @full_reports, map { sprintf("    %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
            }

 view release on metacpan or  search on metacpan

Python.pm  view on Meta::CPAN

my $signed = "Hisssssssssssssssss";

sub encode {
	local $_ = unpack "b*", pop;
	$_ = join ' ', map{ (/1/?'H':'h').'is'.('s' x length); } m/(0+|1+)/g;
	s/(.{40,}?\s)/$1\n/g;
	"$signed\n$_"
}
sub decode {
	local $_ = pop;
	s/(^$signed|\s)//g;
	s/([hH])is(s+)/ ($1 eq 'H'?'1':'0')x(length $2); /ge;
	pack "b*", $_
}
sub garbled {
	$_[0] =~ /\S/
}