view release on metacpan or  search on metacpan

devdata/http_advent.perldancer.org_2018_22  view on Meta::CPAN

        send_error 'Bad ID' => 400;
    }

    # optional
    my $action = query_parameters->{'action'};
    unless ( defined $action && length $action ) {
        send_error 'Bad Action' => 400;
    }

    # use $id and maybe $action
};</pre>

 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.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_diag.t  view on Meta::CPAN

}

pass 'okay';

my $max = 1;
$max = $_ > $max ? $_ : $max for map { length $_ } @modules;
our $format = "%-${max}s %s";

spacer;

my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV;

 view release on metacpan or  search on metacpan

lib/Acme/Colour/Fuzzy.pm  view on Meta::CPAN

    # remove duplicates, favour longer names
    tie my %name2rgb, 'Graphics::ColorNames', $scheme;
    my %rgb2name;
    while( my( $nname, $rgb ) = each %name2rgb ) {
        my $cname = $rgb2name{$rgb} || '';
        my( $lnname, $lcname ) = ( length( $nname ), length( $cname ) );
        if( $lnname > $lcname ) {
            $rgb2name{$rgb} = $nname;
        }
    }
    my %unique = reverse %rgb2name;

 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

lib/Acme/ConspiracyTheory/Random.pm  view on Meta::CPAN

sub numerology {
	my $redstring = shift // {};
	
	my @strings = List::Util::uniq(
		grep { length }
		map { my $letters = uc( $_ ); $letters =~ s/[^A-Z0-9]//g; $letters }
		map {
			/^(the )(.+)$/i ? $2 : $_
		}
		map {

lib/Acme/ConspiracyTheory/Random.pm  view on Meta::CPAN

		values( %$redstring )
	);
	
	my %calcs;
	foreach my $string ( @strings ) {
		next if length($string) >= 20;
		my @letters = split //, $string;
		my @numbers = map /[A-Z]/ ? ( ord($_) - 0x40 ) : $_, @letters;
		my $sum     = List::Util::sum( @numbers );
		
		push @{ $calcs{$sum} ||= [] }, sprintf(

 view release on metacpan or  search on metacpan

inc/IO/Scalar.pm  view on Meta::CPAN

    ### We do the fast fast thing (no regexps) if using the
    ### classic input record separator.

    ### Case 1: $/ is undef: slurp all...
    if    (!defined($/)) {
	*$self->{Pos} = length $$sr;
        return substr($$sr, $i);
    }

    ### Case 2: $/ is "\n": zoom zoom zoom...
    elsif ($/ eq "\012") {

        ### Seek ahead for "\n"... yes, this really is faster than regexps.
        my $len = length($$sr);
        for (; $i < $len; ++$i) {
           last if ord (substr ($$sr, $i, 1)) == 10;
        }

        ### Extract the line:

inc/IO/Scalar.pm  view on Meta::CPAN

    }

    ### Case 3: $/ is ref to int. Do fixed-size records.
    ###        (Thanks to Dominique Quatravaux.)
    elsif (ref($/)) {
        my $len = length($$sr);
		my $i = ${$/} + 0;
		my $line = substr ($$sr, *$self->{Pos}, $i);
		*$self->{Pos} += $i;
        *$self->{Pos} = $len if (*$self->{Pos} > $len);
		return $line;

inc/IO/Scalar.pm  view on Meta::CPAN

    ###         of the regexps.
    else {
        pos($$sr) = $i;

	### If in paragraph mode, skip leading lines (and update i!):
        length($/) or
	    (($$sr =~ m/\G\n*/g) and ($i = pos($$sr)));

        ### If we see the separator in the buffer ahead...
        if (length($/)
	    ?  $$sr =~ m,\Q$/\E,g          ###   (ordinary sep) TBD: precomp!
            :  $$sr =~ m,\n\n,g            ###   (a paragraph)
            ) {
            *$self->{Pos} = pos $$sr;
            return substr($$sr, $i, *$self->{Pos}-$i);
        }
        ### Else if no separator remains, just slurp the rest:
        else {
            *$self->{Pos} = length $$sr;
            return substr($$sr, $i);
        }
    }
}

inc/IO/Scalar.pm  view on Meta::CPAN

#line 417

sub print {
    my $self = shift;
    *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : ""));
    1;
}
sub _unsafe_print {
    my $self = shift;
    my $append = join('', @_) . $\;
    ${*$self->{SR}} .= $append;
    *$self->{Pos}   += length($append);
    1;
}
sub _old_print {
    my $self = shift;
    ${*$self->{SR}} .= join('', @_) . $\;
    *$self->{Pos} = length(${*$self->{SR}});
    1;
}


#------------------------------

inc/IO/Scalar.pm  view on Meta::CPAN

    my $self = $_[0];
    my $n    = $_[2];
    my $off  = $_[3] || 0;

    my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n);
    $n = length($read);
    *$self->{Pos} += $n;
    ($off ? substr($_[1], $off) : $_[1]) = $read;
    return $n;
}

inc/IO/Scalar.pm  view on Meta::CPAN

    my $self = $_[0];
    my $n    = $_[2];
    my $off  = $_[3] || 0;

    my $data = substr($_[1], $off, $n);
    $n = length($data);
    $self->print($data);
    return $n;
}

#------------------------------

inc/IO/Scalar.pm  view on Meta::CPAN

#line 562

sub eof {
    my $self = shift;
    (*$self->{Pos} >= length(${*$self->{SR}}));
}

#------------------------------

#line 575

sub seek {
    my ($self, $pos, $whence) = @_;
    my $eofpos = length(${*$self->{SR}});

    ### Seek:
    if    ($whence == 0) { *$self->{Pos} = $pos }             ### SEEK_SET
    elsif ($whence == 1) { *$self->{Pos} += $pos }            ### SEEK_CUR
    elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos}    ### SEEK_END

 view release on metacpan or  search on metacpan

t/01-simple.t  view on Meta::CPAN

my $sc = Acme::CorpusScrambler->new;


# Scramble everything
my $text1 = $sc->scramble;
ok( length($text1) > 0 );

$sc->feed( "Java" => io("t/text/java.txt")->utf8->all );
$sc->feed( "Perl" => io("t/text/perl.txt")->utf8->all );
$sc->feed( "XML"  => io("t/text/xml.txt")->utf8->all );
$sc->feed( "Dream"  => io("t/text/dream.txt")->utf8->all );

# Scramble only XML with Perl
my $text2 = $sc->scramble(qw( XML Perl) );
ok( length($text2) > 0 );

my $text3 = $sc->scramble(qw( Opcafe ) );
ok( length($text3) == 0 );

 view release on metacpan or  search on metacpan

bin/text2cow.pl  view on Meta::CPAN

local $/ = undef;       # file slurp mode
my $text = <>;          # get input text string

die "$PROGNAME: No input" unless defined $text;

my $n = length $text;   # get the number of characters in the string
my $prev_ord;           # this variable holds the previous ordinal value

for (my $i = 0 ; $i < $n ; ++ $i) {

    my $chr = substr($text, $i, 1);     # get this character ...

 view release on metacpan or  search on metacpan

Cow/TextBalloon.pm  view on Meta::CPAN

	$self->{'text'} = \@l;
    }
    return $self->{'text'};
}

sub _maxlength 
{
    my ($len, $max);
    $max = -1;
    for my $i (@_) {
        $len = length $i;
        $max = $len if ($len > $max);
    }
    return $max;
}

Cow/TextBalloon.pm  view on Meta::CPAN

sub _construct
{
    my $self = shift;
    my $mode = $self->{'mode'};
    my @message = $self->_fill_text();
    my $max = _maxlength(@message);
    my $max2 = $max + 2;        ## border space fudge.
    my @border; ## up-left, up-right, down-left, down-right, left, right
    my @balloon_lines = ();
    my $shove = " " x $self->{'over'};
    my $format = "$shove%s %-${max}s %s\n";

 view release on metacpan or  search on metacpan

lib/Acme/Curses/Marquee.pm  view on Meta::CPAN

Take a new line of text for the marquee...

   $m->text("New line of text");

...render it via figlet, split it into an array, and perform width
adjustments as neccessary. Store the new text, figleted text, length
of figleted text lines, and set marquee state to active.

=cut

sub text {
    my ($self,$text) = @_;
    my $font  = $self->{font};
    my $width = length($text) * 12;
    my $line  = 0;

    # render text via figlet
    my @fig = split(/\n/,`figlet -f $font -w $width '$text'`);

    # find longest line length
    foreach my $i (0..(@fig - 1)) {
        $line = length($fig[$i]) if (length($fig[$i]) > $line);
    }

    # set line length to window width if shorter than that
    $line = $self->{width} if ($line < $self->{width});

    # pad all lines window width or longest length + 5
    foreach my $i (0..(@fig - 1)) {
        my $len = length($fig[$i]);
        my $pad = $line - $len;
        $pad += 25 if ($len > ($self->{width} - 6));
        $fig[$i] = join('',$fig[$i],(' 'x $pad));
    }
    
    $self->{active} = 1;
    $self->{offset} = 0;
    $self->{srctxt} = $text;
    $self->{txtlen} = length($fig[0]);
    $self->{figtxt} = \@fig;
}

=head2 font

 view release on metacpan or  search on metacpan

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

=head1 FUNCTIONS

=head2 secureXOR

XOR is an extremely convenient method for encrypting a digital media stream.  Given any two of the a) original data, b) encryption key, and c) encrypted data, you get the third item.  Unfortunately, hackers have compromised the effectiveness of this ...
The answer is to use a variable key, however, key distribution becomes a difficult proposition.  If the key is distributed in the clear, pirates can simply decrypt the digital media stream, and steal your B<Intellectual Property>.  Our solution is to...

=cut

sub secureXOR {

 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

maint/mkmanifest  view on Meta::CPAN

rename $MANIFEST, "$MANIFEST.bak" if -f $MANIFEST;
open my $manifh, '>', $MANIFEST or die "Can't open $MANIFEST: $!";
binmode $manifh, ':raw';

for my $file ( sort keys %manifest ) {
    my $tabs = ( 5 - ( length($file) + 1 ) / 8 );
    $tabs = 1 if $tabs < 1;
    my $text = $manifest{$file};
    $tabs = 0  unless $text;
    $text = "" unless defined $text;
    if ( $file =~ /\s/ ) {

 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

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

    require Text::Wrap;
    local $Text::Wrap::columns = 72;

    my @lines = Text::Wrap::wrap('', '', $DeepThought);

    if(length $lines[-1] < 63 ){
        $lines[-1] .= "  --  Jack Handey";
    } else {
        push @lines, "        --  Jack Handey";
    }

 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

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

DonMartin.pm  view on Meta::CPAN

use vars qw/ $VERSION /;

$VERSION = 0.09;

use vars qw/ $thud $thuk $thump $thwa $thwak $thwat $thwip %thwip $thwit $thwock
$thwop %thwop @thwop/; $thwit=length$thwop[length($thwop[$thwat=$thwa=0])-length
($thwop[1])];$thwop=map{$thwat+=length}@thwop[do{$thwop+=length for@thwop[$thwit
..$thwit+length($thwop[6])];$thwop}..do{$thwop&=$thwa;$thwop+=length$_ for@thwop
[3..14.1592645];$thwop}];$thwa=($thwop>>length$thwop[5])<<($thwip=1<<1+1)+1;open
$thwit=undef,"+<$0" or die q=zownt thlip spoosh\n=;$thwa=chr$thwa;while(<$thwit>
){$thump.=$_;last if/^\s*use +@{[__PACKAGE__]}/}$thwak=$thump;$thud=<$thwit>;use
Compress::Zlib;$thud=~s/\s+$//;push @{$thwop{$thwip{$_}=$thwop++%$thwat}},qq{$_}
while $_=shift @thwop;$thuk=do{$thwat=$thwip^4; @thwop=split / /, $thud;!@thwop?
length($thwak):do{exists$thwip{$_}&&++$thwat for@thwop;$thwat!=@thwop}};$thwop=!
$thuk;if($thuk){for(split//,compress($thud.do{@thwop=();local$/=undef,<$thwit>})
){$thwock=$thwop{ord$_}[rand$thwip];if(length join($thwa,@thwop,$thwock)>$thwip{
q{thwak}}-$thwip{thwit}){$thwak.=join($thwa,@thwop).$/;@thwop=( );$thump=''}push
@thwop, $thwock} @thwop and do{seek $thwit, $thwop=$thwip-$thwip, $thwip=$thwop-
$thwop;print$thwit($thwak,$thump,join($thwa,@thwop),$/);seek$thwit,$thwip,$thwop
;}} else {$thwop=$thwip{qq{shpork}}-$thwip{q{shklink}};eval uncompress do{while(
<$thwit>){$thwock.=chr for map{$thwip{$_}}(/(s(?:h(?:k(?:l(?:i(?:z(?:z(?:ortch|i

 view release on metacpan or  search on metacpan

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

    $upper_bound ||= 1;

    $self->{pos} = 0 unless defined($self->{pos});
    my $value = substr($self->{seed}, $self->{pos}, 1);
    $self->{pos} += 1;
    $self->{pos} = 0 if $self->{pos} >= length($self->{seed});
    return int(hex($value) / 15 * $upper_bound);
}

sub random_color {
    return [map { $self->random(255) } 1..4]

 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

ESP.pm  view on Meta::CPAN

sub oO
{
    @_= map {
        my $i;
        eval{%$_||1}?(!%$_?():( $i= $_, join ".  ", map
            "$_: $$i{$_}", map substr("m;V",0,length) ^ $_, sort map
            $_ ^ substr("m;V",0,length), keys %$i ) . "." ) :
        eval{1+@$_}?(!@$_?(): join( "; ", @$_ ) ) : $_
    } @_;
    my( $thought )= !@_ ? undef : join " ... ", @_;
    return bless \$thought, 'Acme::ESP::Scanner';
}

ESP.pm  view on Meta::CPAN

        my $think= "thoughts";
        my $mind= \$think;
        my( $p2, $rc, $f )=
            unpack "LLL", unpack "P12", pack "L", $mind;
        my $state= unpack "C", pack "V", $f;
        my $nv= eval { length pack "F", 1.0 } || 8;
        my $pad= $nv - 4;
        if(  $state == 4  ) {
            $openMind >>= 4;
            $pad= 0;
        }

ESP.pm  view on Meta::CPAN

            unpack "LLL", unpack "P12", pack "L", $mind;
        if(  ! $openMind & $f  ) {
            warn "Warning: Open minds appear closed.\n"
                if  $^W;
        }
        my $size= eval { length( pack "J", 1 ) };
        my $last= "J";
        if(  ! defined $size  ) {
            $last= "L";
        } elsif(  4 < $size  ) {
            $last= "x4J"

ESP.pm  view on Meta::CPAN

        # It is surprising how hard it can be to clear your mind.
        # It'd be nice to do this less destructively.
        my $surface= "$$mind";
        $$mind= undef;
        $$mind= $thought . $surface;
        substr( $$mind, 0, length($thought), "" );
    }
    return $secret;
}

sub explode

 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

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

      if ($l =~ s/\\$//) {
         my $n = <$fh>; $n =~ s/^\s+//; $l .= $n;
         redo unless eof($fh);
      }
      $l =~ s/^\s+//; $l =~ s/\s+$//;
      next unless length($l);
      next if $l =~ /^#/;
      my ($k, $v) = split(/\s*:\s*/, $l, 2);
      $h{$k} = $v;
   }
   close($fh);
   return \%h;
}

sub _def_ihandler { print STDERR $_[0] }

# Return largest no. of tokens with total length less than $slen ($slen > 0).
sub _guess_ntok {
   my ($rtok, $sidx, $slen, $rexact) = @_; my $tlen = 0;
   for my $i ($sidx .. $sidx + $slen) {
      ($tlen += length($rtok->[$i])) < $slen or
         return $i - $sidx + (${$rexact} = $tlen == $slen);
   }
   # should never get here
}

sub _guess_compact_ntok {
   my ($rtok, $sidx, $slen, $rexact, $fcompact) = @_; my $tlen = 0;
   for my $i ($sidx .. $sidx + $slen + $slen) {
      ($tlen += length($rtok->[$i]) - ($i > $sidx+1 && $rtok->[$i-1] eq '.'
      && substr($rtok->[$i], 0, 1) eq "'" && substr($rtok->[$i-2], 0, 1)
      eq "'" ? (${$fcompact} = 3) : 0)) < $slen or
         return $i - $sidx + ($tlen > $slen ? 0 : (${$rexact} = 1) +
         ($i > $sidx && $rtok->[$i] eq '.' && substr($rtok->[$i-1], 0, 1)
         eq "'" && $rtok->[$i+1] =~ /^'..$/ ? (${$fcompact} = 1) : 0));

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

   }
   $s;
}

# Pour $n tokens from @{$rtok} (starting at index $sidx) into string
# of length $slen. Return string or undef if unsuccessful.
sub _pour_chunk {
   my ($rtok, $sidx, $n, $slen) = @_;
   my $eidx = $sidx + $n - 1; my $tlen = 0;
   my $idot = my $iquote = my $i3quote = my $iparen = my $idollar = -1;
   for my $i ($sidx .. $eidx) {
      $tlen += length($rtok->[$i]);
      if    ($rtok->[$i] eq '.') { $idot = $i }
      elsif ($rtok->[$i] eq '(') { $iparen = $i }
      elsif (substr($rtok->[$i], 0, 1) eq '$') { $idollar = $i }
      elsif ($rtok->[$i] =~ /^['"]/) {
         $iquote = $i; $i3quote = $i if length($rtok->[$i]) == 3;
      }
   }
   die "oops" if $tlen >= $slen;
   my $i2 = (my $d = $slen - $tlen) >> 1;
   $idot >= 0 && !($d%3) and return join("", @{$rtok}[$sidx .. $idot-1],

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

# Pour unsightly text $txt into shape defined by string $tlines.
sub pour_text {
   my ($tlines, $txt, $gap, $tfill) = @_;
   $txt =~ s/\s+//g;
   my $ttlen = 0; my $txtend = length($txt);
   my @tnlines = map(length() ? [map length, split/([^ ]+)/] : undef,
      split(/\n/, $tlines));
   for my $r (grep($_, @tnlines)) {
      for my $i (0 .. $#{$r}) { $i & 1 and $ttlen += $r->[$i] }
   }
   my $nshape = int($txtend/$ttlen); my $rem = $txtend % $ttlen;
   if ($rem || !$nshape) {
      ++$nshape;
      $txt .= $tfill x (int(($ttlen-$rem)/length($tfill))+1)
         if length($tfill);
   }
   my $s = ""; my $p = 0;
   for (my $n = 1; 1; ++$n, $s .= "\n" x $gap) {
      for my $r (@tnlines) {
         if ($r) {
            for my $i (0 .. $#{$r}) {
               if ($i & 1) {
                  $s .= substr($txt, $p, $r->[$i]); $p += $r->[$i];
                  return "$s\n" if !length($tfill) && $p >= $txtend;
               } else {
                  $s .= ' ' x $r->[$i];
               }
            }
         }

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

# Pour sightly program $prog into shape defined by string $tlines.
sub pour_sightly {
   my ($tlines, $prog, $gap, $fillv, $compact, $ihandler) = @_;
   $ihandler ||= \&_def_ihandler;
   my $ttlen = 0;
   my @tnlines = map(length() ? [map length, split/([^ ]+)/] : undef,
      split(/\n/, $tlines));
   for my $r (grep($_, @tnlines)) {
      for my $i (0 .. $#{$r}) { $i & 1 and $ttlen += $r->[$i] }
   }
   my $outstr = ""; my @ptok;
   if ($prog) {
      if ($prog =~ /^''=~/g) {
         push(@ptok, ($tlines =~ /(\S+)/ ? length($1) : 0) == 3 ?
            "'?'" : "''", '=~');
      } elsif ($prog =~ /(.*eval.*\n\n\n)/g) {
         $outstr .= $1;
      }
      push(@ptok, $prog =~ /[().&|^]|'\\\\'|.../g);  # ... is "'"|'.'
   }
   my $iendprog = @ptok;
   my @filler = _make_filler(ref($fillv) ? $fillv : [ '$:', '$~', '$^' ]);
   # Note: 11 is the length of a filler item, for example, $:='.'^'~';
   # And there are 6 tokens in each filler item: $: = '.' ^ '~' ;
   push(@ptok, 'Z', (@filler) x (int($ttlen/(11 * int(@filler / 6))) + 1));
   my $sidx = 0;
   for (my $nshape = 1; 1; ++$nshape, $outstr .= "\n" x $gap) {
      for my $rline (@tnlines) {
         unless ($rline) { $outstr .= "\n"; next }
         for my $it (0 .. $#{$rline}) {
            unless ($it & 1) {$outstr .= ' ' x $rline->[$it]; next }
            (my $tlen = $rline->[$it]) == (my $plen = length($ptok[$sidx]))
               and $outstr .= $ptok[$sidx++], next;
            if ($plen > $tlen) {
               $outstr .= '(' x $tlen;
               splice(@ptok, $sidx+1, 0, (')') x $tlen);
               $iendprog += $tlen if $sidx < $iendprog;

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

            my $str;
            --$n while $n > 0 && !defined($str = $fcompact ?
                    _pour_compact_chunk(\@ptok, $sidx, $n, $tlen) :
                    _pour_chunk(\@ptok, $sidx, $n, $tlen));
            if ($n) { $outstr .= $str; $sidx += $n; next }
            ++$n while $n < $tlen && length($ptok[$sidx+$n]) < 2;
            die "oops ($n >= $tlen)" if $n >= $tlen;
            $outstr .= join("", @ptok[$sidx .. $sidx+$n-1]);
            $sidx += $n;
            $outstr .= '(' x (my $nleft = $tlen - $n);
            splice(@ptok, $sidx+1, 0, (')') x $nleft);

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

   }
   my $eidx = rindex($outstr, 'Z');
   substr($outstr, $eidx, 1) = ';' if $eidx >= 0;
   return $outstr if $sidx == $iendprog || $sidx == $iendprog+1;
   die "oops" if $eidx < 0;
   ref($fillv) or return substr($outstr, 0, $eidx) . (length($fillv) ?
      pour_text(substr($outstr, $eidx), "", 0, $fillv) : "\n");
   (my $idx = rindex($outstr, ';')) >= 0 or return $outstr;
   my @t = substr($outstr, $idx+1) =~
   /[()&|^=;]|\$.|'[^'\\]*(?:\\.[^'\\]*)*'|"[^"\\]*(?:\\.[^"\\]*)*"/g
      or return $outstr;

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

      if ($c eq '(') {++$nl} elsif ($c eq ')') {++$nr}
      elsif ($c eq '=') {++$ne}
   }
   if ($ne == 0 || $nl != $nr || $t[-1] eq '=') {
      my $f = ';';  # Trouble: wipe out last bit with filler
      for my $i ($idx+1 .. length($outstr)-2) {
         substr($outstr, $i, 1) =~ tr/ \n// or
            substr($outstr, $i, 1) = $f = $f eq '#' ? ';' : '#';
      }
   } elsif ($t[-1] eq '|' or $t[-1] eq '^' or $t[-1] eq '&') {
      $outstr =~ s/\S(\s*)$/;$1/;

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

}

sub border_shape {
   my ($tlines, $gl, $gr, $gt, $gb, $wl, $wr, $wt, $wb) = @_;
   my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
   for my $l (@a) { $m = length($l) if length($l) > $m }
   for my $l (@a) { $l .= ' ' x ($m - length($l)) }
   $gl || $gr || $gt || $gb and _border(\@a, $m, ' ', $gl, $gr, $gt, $gb);
   $wl || $wr || $wt || $wb and _border(\@a, $m+$gl+$gr,'#',$wl,$wr,$wt,$wb);
   join("\n", @a, "");
}

sub invert_shape {
   my $tlines = shift;
   my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
   for my $l (@a) { $m = length($l) if length($l) > $m }
   for my $l (@a) { $l .= ' ' x ($m - length($l)) }
   my $s = join("\n", @a, ""); $s =~ tr/ #/# /;
   $s =~ s/ +$//mg; $s;
}

sub reflect_shape {
   my $tlines = shift;
   my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
   for my $l (@a) { $m = length($l) if length($l) > $m }
   my $s = join("\n", map(scalar reverse($_ . ' ' x ($m - length)), @a), "");
   $s =~ s/ +$//mg; $s;
}

sub hjoin_shapes {
   my ($g, @shapes) = @_;
   my $ml = 0; my @lines;
   for my $s (@shapes) { my $n = $s =~ tr/\n//; $ml = $n if $n > $ml }
   for my $tlines (@shapes) {
      my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0;
      for my $l (@a) { $m = length($l) if length($l) > $m }
      for my $l (@a) { $l .= ' ' x ($m - length($l) + $g) }
      push(@a, (' ' x ($m + $g)) x ($ml - @a));
      for my $i (0..$#a) { $lines[$i] .= $a[$i] }
   }
   my $s = join("\n", @lines, "");
   $s =~ s/ +$//mg; $s;
}

sub reduce_shape {
   my ($tlines, $f) = @_; my $i = $f++; my $s = "";
   for my $l (grep(!(++$i%$f), split(/\n/, $tlines))) {
      for ($i = 0; $i < length($l); $i += $f) { $s .= substr($l, $i, 1) }
      $s .= "\n";
   }
   $s =~ s/ +$//mg; $s;
}

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

   my ($tlines, $degrees, $rtype, $flip) = @_;
   $degrees == 180 and
      return join("\n", reverse(split(/\n/, $tlines)), "");
   my $t = $rtype==0 ? 2 : 1; my $inc = $rtype==1 ? 2 : 1;
   my @a = split(/^/, $tlines, -1); chop(@a); my $m = 0; my $s = "";
   for my $l (@a) { $m = length($l) if length($l) > $m }
   for my $l (@a) { $l .= ' ' x ($m - length($l)) }
   if ($degrees == 90) {
      @a = reverse(@a) unless $flip;
      for (my $i = 0; $i < $m; $i += $inc) {
         for (@a) {$s .= substr($_, $i, 1) x $t} $s .= "\n"
      }

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

   my $f = $w ? "-w $w" : ""; $src =~ s/\s+/ /g; $src =~ s/ $//;
   # Following characters not in /usr/games/banner character set:
   #    \ [ ] { } < > ^ _ | ~
   # Also must escape ' from the shell.
   $src =~ tr#_\\[]{}<>^|~'`#-/()()()H!T""#;
   my $s = ""; my $len = length($src);
   for (my $i = 0; $i < $len; $i += 512) {
      my $cmd = "$b_exe $f '" . substr($src, $i, 512) . "'";
      $s .= `$cmd`; my $rc = $? >> 8; $rc and die "<$cmd>: rc=$rc";
   }
   $s =~ s/\s+$/\n/; $s =~ s/ +$//mg;
   # Remove as many leading spaces as possible.
   my $m = 32000;   # regex /^ {$m}/ blows up if $m > 32766
   while ($s =~ /^( *)\S/mg) { $m = length($1) if length($1) < $m }
   $s =~ s/^ {$m}//mg if $m; $s;
}

# -------------------------------------------------------------------------

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

   );
   for my $k (keys %{$ruarg}) {
      exists($arg{$k}) or die "invalid parameter '$k'";
      $arg{$k} = $ruarg->{$k};
   }
   length($arg{SourceFile}) && $arg{SourceHandle} and
      die "cannot specify both SourceFile and SourceHandle";
   length($arg{SourceFile}) && length($arg{SourceString}) and
      die "cannot specify both SourceFile and SourceString";
   length($arg{SourceString}) && $arg{SourceHandle} and
      die "cannot specify both SourceString and SourceHandle";
   $arg{Shape} && $arg{ShapeString} and
      die "cannot specify both Shape and ShapeString";
   if (length($arg{SourceFile})) {
      $arg{SourceString} = _slurp_tfile($arg{SourceFile}, $arg{Binary});
   } elsif ($arg{SourceHandle}) {
      local $/; $arg{SourceString} = readline($arg{SourceHandle});
   }
   my $fill = $arg{FillerVar};

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

         [ '$:', '$~', '$^' ] :
         [ '$:', '$~', '$^', '$/', '$,', '$\\' ];
   }
   $arg{RemoveNewlines} and $arg{SourceString} =~ tr/\n//d;
   my $shape = my $sightly = "";
   length($arg{SourceString}) && !$arg{Text} and $sightly = $arg{Print} ?
      ( $arg{Regex} ? ( $arg{Binary} ?
                        regex_binmode_print_sightly($arg{SourceString}) :
                        regex_print_sightly($arg{SourceString})  ) :
                      ( $arg{Binary} ?
                        clean_binmode_print_sightly($arg{SourceString}) :

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

    Invert         Boolean. Invert the shape.

    Indent         Indent the shape. The number of spaces to indent.

    TrailingSpaces Boolean. Ensure all lines of the shape are of equal
                   length, adding trailing spaces if required.

    RemoveNewlines Boolean. Remove all newlines from the source before
                   conversion.

    BorderGap      Put a border around the shape. Gap between border

 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

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

sub flip
{
	$_ = shift;
	my $width = (shift or 80);
	while (s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {};
	join ("\n", map {
		sprintf "%${width}s", join '', map {
			$_ = lc $_; exists $table{$_} ? $table{$_} : $_
		} reverse split (/\B|\b/, $_)
	} reverse split (/\n/, $_))."\n";

 view release on metacpan or  search on metacpan

t/00_diag.t  view on Meta::CPAN

}

pass 'okay';

my $max = 1;
$max = $_ > $max ? $_ : $max for map { length $_ } @modules;
our $format = "%-${max}s %s";

spacer;

my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV;

 view release on metacpan or  search on metacpan

t/00_diag.t  view on Meta::CPAN

}

pass 'okay';

my $max = 1;
$max = $_ > $max ? $_ : $max for map { length $_ } @modules;
our $format = "%-${max}s %s";

spacer;

my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV;