view release on metacpan or  search on metacpan

Protocol.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] .= "  --  Larry Wall";
    } else {
        push @lines, "        --  Larry Wall";
    }

 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

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;
}

# Cloned from Params::Util::_CLASS

 view release on metacpan or  search on metacpan

lib/Acme/Resume/Output/ToPlain.pm  view on Meta::CPAN

                     $self->email, '',
                     $self->phone, '',
                     $self->formatted_address, '');

        if($self->has_education) {
            push @lines => 'Education', '-' x length 'education';

            foreach my $edu ($self->all_educations) {
                push @lines => 'School:   ' . $edu->school;
                push @lines => 'Url:      ' . $edu->url if $edu->has_url;
                push @lines => 'Location: ' . $edu->location;

lib/Acme/Resume/Output/ToPlain.pm  view on Meta::CPAN

                push @lines => "Description:\n" . nudge($edu->description), '', '';
            }
        }

        if($self->has_job_history) {
            push @lines => '', 'Work experience', '-' x length 'work experience';

            foreach my $job ($self->all_jobs) {

                push @lines => 'Company:  ' . $job->company;
                push @lines => 'Url:      ' . $job->url if $job->has_url;

 view release on metacpan or  search on metacpan

lib/Acme/ReturnValue/MakeSite.pm  view on Meta::CPAN

        foreach my $rreport (@$data) {
            my $report = { %$rreport };
            if (exists $report->{value}) {
                $report->{value}=~s/\</&lt;/g;
                $report->{value}=~s/\>/&gt;/g;
                if(length($report->{value})>255) {
                    $report->{value}=substr($report->{value},0,255).'...';
                }
            }
            if ($report->{bad}) {
                my $bad = $report->{bad};
                $bad=~s/\</&lt;/g;
                $bad=~s/\>/&gt;/g;
                if(length($bad)>255) {
                    $bad=substr($bad,0,255).'...';
                }
                $report->{bad}=$bad;
            }

            $report->{package_br} = $report->{package};
            if (length($report->{package_br})>40) {
                my @p=split(/::/,$report->{package_br});
                my @lines;
                my $line = shift(@p);
                foreach my $frag (@p) {
                    $line.='::'.$frag;
                    if (length($line)>40) {
                        push(@lines,$line);
                        $line='';
                    }
                }
                push (@lines,$line) if $line;

 view release on metacpan or  search on metacpan

foo.pl  view on Meta::CPAN

join eval tell rand reverse ord chr eval split xor
uc prototype eval lcfirst join chmod kill eval ref
split sprintf reverse times xor not eval and srand
tell sqrt formline eval ord lcfirst ucfirst length
 glob gmtime exp defined caller or binmode log ord
abs lc sqrt study alarm split time or formline cos
ne rewinddir kill chdir reset prototype split sqrt
ord int localtime abs oct pack pop eq scalar print
telldir open unpack return and unlink write chroot

foo.pl  view on Meta::CPAN

reverse getpwnam next lstat gethostent and getpgrp
 eq log ord time xor chr undef and eval caller and
printf srand lstat chown chdir syscall open select
eq -w closedir sleep chr split and quotemeta reset
require ne closedir sleep chr undef or pack unpack
length splice shift umask readpipe pos xor defined
 join system and die or do exit if defined require
hex defined undef or sprintf localtime cmp time or
abs time and undef and open exp getc fileno system
caller eof rewinddir readpipe splice shift defined
kill pop wantarray and readlink eof readpipe split
eval warn join study abs localtime oct log time or
reverse xor open 0; print chr ord while readline 0
,;print chr abs length time for cos length getppid

 view release on metacpan or  search on metacpan

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

sub generate {
    my $self = shift;

    my $max_string_width
        = max( map length, @{$self->people} ) * $self->font_size;

    my $cx = $self->radius + $max_string_width;
    my $cy = $self->radius + $max_string_width;
    my $width  = ( $self->radius + $max_string_width ) * 2;
    my $height = ( $self->radius + $max_string_width ) * 2;

 view release on metacpan or  search on metacpan

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

sub diff  { $diff  }

sub _set_current {
  print DIAG "A::SG::_set_current => \n\n\n==========\n$_\n==========\n\n\n\n";
  our $current;
  $current = $_ if length($_);
}



CHECK {

 view release on metacpan or  search on metacpan

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

    has username        => ( is => 'ro', isa => Str,  traits => ['ENV'], env_key => 'user' );
    has home_directory  => ( is => 'ro', isa => Dir,  traits => ['ENV'], env_key => 'home' );
    has term            => ( is => 'ro', isa => Str,  traits => ['ENV'] );

    has useraccounts    => ( is => 'ro', isa => Int,  lazy_build => 1, documentation => q{Check if system is like /home/b/bruder ... then you have to also supply the hidden "I'm the administrator switch"} );
    has username_length => ( is => 'ro', isa => Int,  lazy_build => 1, documentation => q{self explanatory} );
    has shell           => ( is => 'ro', isa => Str,  lazy_build => 1, documentation => q{self explanatory} );
    has harddrive_size  => ( is => 'ro', isa => Int,  lazy_build => 1, documentation => q{self explanatory} );
    has harddrive_used  => ( is => 'ro', isa => Int,  lazy_build => 1, documentation => q{self explanatory} );
    has uptime          => ( is => 'ro', isa => Any,  lazy_build => 1, documentation => q{self explanatory} );
    has users           => ( is => 'ro', isa => Any,  lazy_build => 1, documentation => q{The number of users logged in on the system} );

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

    has f => ( is => 'ro', isa => 'File::Util', default => sub { File::Util->new } );

    # has followers_on_github =>
    
    # has number_of_rc_files  =>  ~/.*rc
    # has length of .vimrc
    # has length of .emacs
    # has number of files in ~/.emacs.d
    # has using .ssh/config
    # has rvm/rbenv installed
    # 

    # has number_of_modules      => ( is => 'ro', isa => Int,  lazy_build => 1, documentation => q{} );

    method _build_useraccounts           { scalar grep { !/Shared/ } grep { -d $_ } glob ( dir( $self->home_directory => '..') . '/*'); } #TODO Make safer for WIN
    method _build_username_length        { length $self->username }
    method _build_shell                  { $_ = $ENV{SHELL}; s/.*\/(.*?)$/$1/; $_ } # /r
    method _build_harddrive_size         { $_=`df -l | grep '\\/\$' | awk '{print \$2}'`; chomp; $_ } # -E 'use IPC::Run qw<run timeout>; my $out; my @cmd = (q<du>, q<-s>, q</>); run \@cmd, "", \undef, \$out, timeout( 100 ) echo `uptime|grep days|sed...
    method _build_harddrive_used         { $_=`df -l | grep '\\/\$' | awk '{print \$3}'`; chomp; $_ } # -E 'use IPC::Run qw<run timeout>; my $out; my @cmd = (q<du>, q<-s>, q</>); run \@cmd, "", \undef, \$out, timeout( 100 ) echo `uptime|grep days|sed...
    method _build_uptime                 { 100 }
    method _build_users                  {  5  }

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

    method _build_size {

        $self->size(0);

        # useraccounts
        # username_length
        # shell
        # harddrive_size
        # uptime
        # users
        # cores

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

        $self->add_size(10)  if $self->using_zsh;
        $self->add_size(100) if $self->using_multiplex;

        $self->add_size( 100 * $self->cores );

        $self->sub_size( 10 * $self->username_length );

        $self->abs_size
    }

    method testdrive {

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

        say "Your home directory is: ", $self->home_directory;
        say "The number of useraccounts is ", $self->useraccounts;
        say "Your TERM is ", $self->term;
        say "Your shell is ", $self->shell;
        say "You are using byobu ", $self->using_byobu;
        say "Your username length is ", $self->username_length;
        say "You harddrive_size is ", $self->harddrive_size;
        say "The number of cores is ", $self->cores;
        say "Your perl version is  ", $self->perl_version;
        # say "Your perl version is a dev_release: ", $self->perl_version_is_dev;
        say "You have this many dirs in PATH: ", $self->directories_in_path;

 view release on metacpan or  search on metacpan

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

    } while (1)
}

sub _getline {
    my $s = "All work and no play makes Jack a dull boy\n";
    my $replace = int(rand(length("All work and no play makes Jack a dull boy\n")));
    (substr($s, $replace, 1, uc(substr($s, $replace, 1))), return $s);
}

=head1 AUTHOR

 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

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/Siteswap.pm  view on Meta::CPAN

        my $a_1 = ( ref $a eq 'ARRAY' ? max(@$a) : $a );
        my $b_1 = ( ref $b eq 'ARRAY' ? max(@$b) : $b );
        $a_1 >= $b_1 ? $a_1 : $b_1;
    } @$throws;

    # if our pattern is a 1-length multiplex pattern, 
    # reduce returns the first element, so correct for
    # that here
    $max_throw = max(@$max_throw) if ref $max_throw eq 'ARRAY';

    return $max_throw;

 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

local/lib/perl5/IO/Async/Channel.pm  view on Meta::CPAN

sub send_encoded
{
   my $self = shift;
   my ( $record ) = @_;

   my $bytes = pack( "I", length $record ) . $record;

   defined $self->{mode} or die "Cannot ->send without being set up";

   return $self->_send_sync( $bytes )  if $self->{mode} eq "sync";
   return $self->_send_async( $bytes ) if $self->{mode} eq "async";

local/lib/perl5/IO/Async/Channel.pm  view on Meta::CPAN

sub _read_exactly
{
   $_[1] = "";

   while( length $_[1] < $_[2] ) {
      my $n = read( $_[0], $_[1], $_[2]-length $_[1], length $_[1] );
      defined $n or return undef;
      $n or return "";
   }

   return $_[2];

local/lib/perl5/IO/Async/Channel.pm  view on Meta::CPAN

{
   my $self = shift;

   my $n = _read_exactly( $self->{fh}, my $lenbuffer, 4 );
   defined $n or die "Cannot read - $!";
   length $n or return undef;

   my $len = unpack( "I", $lenbuffer );

   $n = _read_exactly( $self->{fh}, my $record, $len );
   defined $n or die "Cannot read - $!";
   length $n or return undef;

   return $self->{decode}->( $record );
}

sub _send_sync

local/lib/perl5/IO/Async/Channel.pm  view on Meta::CPAN

      }
      $self->{on_eof}->( $self ) if $self->{on_eof};
      return;
   }

   return 0 unless length( $$buffref ) >= 4;
   my $len = unpack( "I", $$buffref );
   return 0 unless length( $$buffref ) >= 4 + $len;

   my $record = $self->{decode}->( substr( $$buffref, 4, $len ) );
   substr( $$buffref, 0, 4 + $len ) = "";

   if( my $on_result = shift @{ $self->{on_result_queue} } ) {

 view release on metacpan or  search on metacpan

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

=cut

sub next {
    my $self = shift;
    my $f = $self->{seq};
    my $t = substr( $f, $self->{count} % length($f), 1 );
    $self->{count}++;

    return ($t);
}

 view release on metacpan or  search on metacpan

Stegano/Stegano.pm  view on Meta::CPAN

sub insert
{
        my ($self,$text) = @_;
        my ($max_str,$max_cont,@map_letters) = (0,0);
        my $binstr = unpack "b*", " $text";             # It must begin with 0
        $_ > $max_str and $max_str = $_ for map { length } @$self;
        while ($binstr =~ /((.)\2*)/g)
        {
                my $len = length($1);
                $max_cont = $len if $len > $max_cont;
                push(@map_letters,$len);
        }

        my @map_file = map { $max_str - length($_) > $max_cont } @$self;

        for (my $i=0;$i<@$self;$i++)
        {
                $self->[$i] .= " " x shift(@map_letters)
                        if $map_file[$i] and @map_letters;

Stegano/Stegano.pm  view on Meta::CPAN

{
        my $self = shift;
        my ($binstr,$i);
        for my $line (@$self)
        {
                $binstr .= ++$i % 2 ? 0 x length($1) : 1 x length($1)
                        if $line =~ s/( +)$//
        }
        return substr(pack("b*", $binstr),1)    # Delete our mark
}

 view release on metacpan or  search on metacpan

Png.pm  view on Meta::CPAN

@ISA = qw(Class::Accessor);

$VERSION = '0.06';

my @keys = qw(offset data section x y datum_length done filename_generator
	      suffix);

# What arguments can we accept to the constructor.
# Am I reinventing the wheel here?
my %keys;

Png.pm  view on Meta::CPAN

    my ($self) = shift;
    my $section = $self->section;

    my $header = pack 'w', $section;
    if (!$section) {
	$header .= pack 'w', length ${$self->data};
    }
    $header;
}

sub default_filename_generator {

Png.pm  view on Meta::CPAN

  $img->read(data=>$_[0], type => 'raw', xsize => $self->x,
	     ysize => $self->y, datachannels=>1, storechannels=>1, bits=>8);
  $img;
}

sub calculate_datum_length {
  my $self = shift;
  $self->x * $self->y;
}

sub extract_payload {

Png.pm  view on Meta::CPAN

sub extract_payload {
  my ($class, $img) = @_;
  my ($raw, $data);
  $img->write(data=> \$raw, type => 'raw');
  my $end = length ($raw)/3;

  for (my $offset = 0; $offset < $end; ++$offset) {
    my ($red, $green, $blue) = unpack 'x' . ($offset * 3) . 'C3', $raw;
    my $datum = (($red & 0x1F) << 11) | (($green & 0x1F) << 6) | ($blue & 0x3F);
    $data .= pack 'n', $datum;

Png.pm  view on Meta::CPAN

sub make_image {
  my $self = shift;
  # We get a copy to play with
  my $raw = $self->raw;
  my $offset = length ($raw)/3;
  my $img = new Imager;

  while ($offset--) {
    my $datum = unpack 'x' . ($offset * 2) . 'n', $_[0];
    my $rgb = substr ($raw, $offset * 3, 3);

Png.pm  view on Meta::CPAN

  $img->read(data=>$raw, type => 'raw', xsize => $self->x,
	     ysize => $self->y, datachannels => 3,interleave => 0);
  $img;
}

sub calculate_datum_length {
  my $self = shift;
  $self->x * $self->y * 2;
}

package Acme::Steganography::Image::Png::RGB::556FS;

Png.pm  view on Meta::CPAN

sub extract_payload {
  my ($class, $img) = @_;
  my ($raw, $data);
  $img->write(data=> \$raw, type => 'raw');
  my $end = length ($raw)/3;

  for (my $offset = 0; $offset < $end; ++$offset) {
    my ($red, $green, $blue) = unpack 'x' . ($offset * 3) . 'C3', $raw;
    my $datum = (($red & 0x7) << 5) | (($green & 0x3) << 3) | ($blue & 0x7);
    $data .= chr $datum;

Png.pm  view on Meta::CPAN

sub make_image {
  my $self = shift;
  # We get a copy to play with
  my $raw = $self->raw;
  my $offset = length ($raw)/3;
  my $img = new Imager;

  while ($offset--) {
    my $datum = unpack "x$offset C", $_[0];
    my $rgb = substr ($raw, $offset * 3, 3);

Png.pm  view on Meta::CPAN

  $img->read(data=>$raw, type => 'raw', xsize => $self->x,
	     ysize => $self->y, datachannels => 3,interleave => 0);
  $img;
}

sub calculate_datum_length {
  my $self = shift;
  $self->x * $self->y;
}

package Acme::Steganography::Image::Png::RGB;

Png.pm  view on Meta::CPAN

sub generate_next_image {
    my ($self) = shift;
    my $datum = $self->generate_header;
    my $offset = $self->offset;
    my $datum_length = $self->datum_length;
    # Fill our blob of data to the correct length
    my $grab = $datum_length - length $datum;
    $datum .= substr ${$self->data()}, $offset, $grab;
    $self->offset($offset + $grab);

    if (length $datum < $datum_length) {
      # Need to pad it. NUL is so uninspiring.
      $datum .= "N" x ($datum_length - length $datum);
      $self->done(1);
    } elsif (length ${$self->data()} == $self->offset) {
      warn length $datum;
    }
    $self->section($self->section + 1);

    $self->make_image($datum);
}

Png.pm  view on Meta::CPAN

sub write_images {
  my $self = shift;
  $self->section(0);
  $self->offset(0);
  $self->datum_length($self->calculate_datum_length());
  my $type = $self->type;
  my $filename_generator
    = $self->filename_generator || \&default_filename_generator;

  my @filenames;

Png.pm  view on Meta::CPAN

# package method
sub read_files {
  my $class = shift;
  # This is intentionally a "sparse" array to avoid some "interesting" DOS
  # possibilities.
  my $length;
  my %got;
  foreach my $file (@_) {
    my $img = new Imager;
    $img->open(file => $file) or carp "Can't read '$file': " . $img->errstr;
    my $payload = $class->extract_payload($img);
    my $datum;
    my $section;
    ($section, $datum) = unpack "wa*", $payload;
    if ($section == 0) {
      # Oops. Strip off the length.
      ($length, $datum) = unpack "wa*", $datum;
    }
    $got{$section} = $datum;
  }
  carp "Did not find first section in files @_" unless defined $length;

  my $data = join '', map {$got{$_}} sort {$a <=> $b} keys %got;
  substr ($data, $length) = '';

  $data;
}

1;

 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;
}

# Cloned from Params::Util::_CLASS

 view release on metacpan or  search on metacpan

lib/Acme/Sub/Parms.pm  view on Meta::CPAN

                unless ($no_validation) {
                    $unknown_parms_check = 'delete @Acme::Sub::Parms::args{' . join(',',@fields_list) . '}; if (0 <  @Acme::Sub::Parms::args) { require Carp; Carp::croak(\'Unexpected parameters passed: \' . join(\', \',@Acme::Sub::Parms::args)); } ';

                }
                $self->{'bind_block'} = 0;
                my $original_block_length = $Acme::Sub::Parms::line_counter - $self->{'line_block_start'};
                my $new_block = $args . join(' ',$arg_line, $hard_args, $unknown_parms_check) . "$block_trailing_comment\n";
                $new_block =~ s/\n+/\n/gs;
                my $new_block_lines = $new_block =~ m/\n/gs;
                
                my $additional_lines = $original_block_length - $new_block_lines;
                #warn("Need $additional_lines extra lines\n---\n$new_block---\n");
                if ($additional_lines > 0) {
                    $_ = $new_block . ("\n" x $additional_lines);	
                } else {
                    $_ = $new_block;	

 view release on metacpan or  search on metacpan

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

sub _generator {
    my $decoded_str = shift;
    my @decoded_lines = split /\n/, $decoded_str;

    my $max_length = 0;
    $max_length = $_ > $max_length ? $_ : $max_length
        for map {Text::VisualWidth::UTF8::width($_)} @decoded_lines;

    my $ascii = [];
    my $frame_length = ($max_length + 2) / 2;
    push @{$ascii}, '＿' . '人' x $frame_length . '＿';
    for my $line (@decoded_lines) {
        my $str_length = $max_length - Text::VisualWidth::UTF8::width($line);
        my ($left, $right) = map{' ' x $_} ($str_length / 2, $str_length / 2);

        $left = $str_length % 2 != 0 ? $left . ' ' : $left;
        push @{$ascii}, '＞ ' . $left . $line . $right . ' ＜';
    }
    push @{$ascii}, 'ï¿£' . '^Y' x ($frame_length - 1) . '^ï¿£';

    return $ascii;
}

sub sudden_death {

 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/SvGROW.pm  view on Meta::CPAN

__END__

=head1 NAME

Acme::SvGROW - syntax for pre-extending a string's storage,
like the proposed use of C<length> as an L-value

=head1 SYNOPSIS

  use Acme::SvGROW;
  SvGrow($BigString, 100000);

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

techniques shared on perl5-porters mailing list November 4 and 5, 2009

=head1 EXPORT

the C<SvGROW> subroutine is exported. It takes two arguments,
the first the string to extend and the second the length.

=head1 SEE ALSO

L<perlguts>

L<Data::Peek> for a benchmarking of the alternatives

The author of this module is in favor of allowing C<length> to
be used as an lvalue to thinly invoke the SvGROW internals macro

=head1 CHANGES

=head2 0.03

 view release on metacpan or  search on metacpan

lib/Acme/Syntax/Python.pm  view on Meta::CPAN

}

sub _handle_block {
        my ($self) = @_;
        /^(\s*)/;
        my $depth = length ( $1 );
        if($depth < (4 * $self->{_block_depth})) {
            my $spaces = _handle_spacing($self->{_block_depth});
            if($self->{_lambda_block}->{$self->{_block_depth}}) {
                $self->{_lambda_block}->{$self->{_block_depth}} = 0;
                s/^/$spaces\};\n/;

 view release on metacpan or  search on metacpan

lib/Acme/Takahashi/Method.pm  view on Meta::CPAN

	$line =~ q/^use Acme::Takahashi::Method/ and next;
	$line =~ s/#.*//;
	$line =~ /^$/ and next;
	my $slide = "$src." . $counter++;
	$DEBUG and warn $slide;
	my $hspace = " " x (($columns - length($line))/2);
	my $next   =  sprintf(qq(do "$src.%d";), $counter);
	my $page      = "# $counter";
	my $pagespace = " " x ($columns - length($next) - length($page));
	open my $out, ">:raw", $slide or die "$slide : $!";
	print $out 
	    $vspace, $hspace, $line, $vspace, $next, $pagespace, $page, "\n";
	close $out;
    }

lib/Acme/Takahashi/Method.pm  view on Meta::CPAN

sub clobber{
   my ($src, $columns, $rows) = @_;
   use Config;
   my $vspace = "\n" x ($rows/2 - 1);
   my $line = "# $src";
   my $hspace = " " x (($columns - length($line))/2);
   my $next   =  qq(do "$src.0";);
   my $thisperl = $Config{perlpath};
   open my $out, ">:raw", $src or die "$src : $!";
   print $out "#!", $thisperl,
       $vspace, $hspace, $line, $vspace, $next, "\n";

 view release on metacpan or  search on metacpan

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

	my $pos  = 0;
	my $step = '';

	while(1)
	{
		return $string if $pos >= length($string);

		my $count = $replace_range[rand(@replace_range)];

		for(1..$count)
		{
			$step .= "\x{2235}";
		}
			
		substr($string,	$pos, length($step), $step);

		$pos += length($step) + $replace_range[rand(@replace_range)];

	}

}

 view release on metacpan or  search on metacpan

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

	# Sanity-check the incoming colour
	my $prefix = $hex =~ s/^#// ? '#' : '';
	croak "Please provide a valid hex colour"
		unless $hex =~ m/^([0-9a-f]{3}|[0-9a-f]{6})$/i;
	$hex =~ s/(.)/$1$1/g if length($hex) == 3;

	# Convert to HSV
	my ( $old_hue, $s, $v ) = Convert::Color::RGB8->new( $hex )->as_hsv->hsv;

	# Back to RGB

 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

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;
            }