view release on metacpan or search on metacpan
lib/Acme/Spork.pm view on Meta::CPAN
close $PARENT_WTR;
for my $stdfh (qw(STDIN STDOUT STDERR)) {
close $stdfh;
if(exists $reopen_stdfhs_to{ $stdfh } && ref $reopen_stdfhs_to{ $stdfh } eq 'ARRAY') {
eval "open( $stdfh, " . join(', ', map { qq{"$_"} } @{ $reopen_stdfhs_to{ $stdfh } }) . ' );';
carp "Could not reopen $stdfh : $@" if $@;
# no strict 'refs';
# open( $stdfh , @{ $reopen_stdfhs_to{ $stdfh } }) or carp "Could not reopen $stdfh : $!";
}
}
view release on metacpan or search on metacpan
lib/Acme/State.pm view on Meta::CPAN
What could possibily go wrong?
=head1 SEE ALSO
You *could* use an ORM, and wind up translating all of your data to a relational schema you
don't care about or else have it automatically mapped and completely miss the point of
using a relational database.
You *could* just store your data in the Ether with Memcached.
You could C<INSERT> and C<UPDATE> manually against a database to store every little tidbit and factoid
as they're computed.
You could use BerekelyDB, including the build-in legacy C<dbmopen> and mangle everything
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;
}
carp "Text is not enougth large to insert all chars" if @map_letters;
return ! @map_letters;
}
sub extract
{
my $self = shift;
view release on metacpan or search on metacpan
}
$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;
}
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
DateLocales.pm view on Meta::CPAN
@res;
}
sub weekday_and_month_names_dump {
my @res = weekday_and_month_names();
join "\n", map {
Data::Dumper->new([$_],['r'])->Useqq(1)->Indent(0)->Sortkeys(1)->Dump
} @res;
}
# REPO BEGIN
view release on metacpan or search on metacpan
examples/bench-parm-parsers-ci-novalid.pl view on Meta::CPAN
sub caseflat_standard_args {
my %args;
{
my %raw_args = @_;
%args = map { lc($_) => $raw_args{$_} } keys %raw_args;
}
my ($handle, $thing) = @args{'handle','thing'};
}
view release on metacpan or search on metacpan
lib/Acme/SuddenlyDeath.pm view on Meta::CPAN
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) . '^ï¿£';
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Normalise multipart versions
$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/TLDR.pm view on Meta::CPAN
my $modules;
if (
not defined $updated
or
grep { -e and -M _ < $updated }
map { catfile($_, q(perllocal.pod)) }
@INC
) {
## no critic (ProhibitPackageVars)
_debug(q(no cache found; generating));
$modules = [
lib/Acme/TLDR.pm view on Meta::CPAN
return $modules;
}
sub _shorten {
my ($modules) = @_;
my %collisions = map { $_ => 1 } @{$modules};
my %modules;
for my $long (sort @{$modules}) {
my @parts = split /\b|(?=[A-Z0-9])/x, $long;
next unless $#parts;
my $short = join q() => map { /^(\w)\w{3,}$/x ? $1 : $_ } @parts;
next if $short eq $long;
unless (exists $collisions{$short}) {
++$collisions{$short};
$modules{$long} = $short;
lib/Acme/TLDR.pm view on Meta::CPAN
=over 4
=item *
C<DEBUG> - when set, dump the internals status (most importantly, the long <=> short name mapping;
=item *
C<NOCACHE> - when set, no persistent cache is saved.
view release on metacpan or search on metacpan
lib/Acme/Takahashi/Method.pm view on Meta::CPAN
close $out;
}
sub show_slides{
my ($src, $nslides) = @_;
for my $slide ($src, map { "$src.$_" } (0 .. $nslides-1)){
system "clear";
open my $in, "<:raw", $slide or die "$slide : $!";
print <$in>;
close $in;
my $key = getc;
view release on metacpan or search on metacpan
eg/colour_swatches.pl view on Meta::CPAN
# @$s is now a list corresponding to the permutation, where each number is
# an index of the permutation set
# Now we build the permutation by substituting those for the set
return join '', map { $permutation_set->[$_] } @$s;
}
view release on metacpan or search on metacpan
lib/Acme/Tategaki.pm view on Meta::CPAN
return _convert_vertical(@text);
}
sub _convert_vertical {
my @text = @_;
@text = map { [ split //, $_ ] } @text;
@text = transpose_ragged( \@text );
@text = map { [ map {$_ || '　' } @$_ ] } @text;
@text = map { join '　', reverse @$_ } @text;
for (@text) {
$_ =~ tr/ï¼â€¥âˆ’ï¼â”€ãƒ¼ã€Œã€â†’↑â†â†“ï¼=,ã€ã€‚〖〗ã€ã€‘…/＼：｜｜｜｜¬∟↓→↑â†à¥¥à¥¥ï¸ï¸‘︒︗︘︗︘︙/;
$_ =~ s/〜/∫ /g;
$_ =~ s/『/ ┓/g;
view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
delete $args->{SIGN};
}
# merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_,
($self->build_requires, $self->requires) );
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
inc/Module/Install/Makefile.pm view on Meta::CPAN
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
if ($self->admin->preop) {
$args{dist} = $self->admin->preop;
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
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;
}
else {
splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
}
push @full_reports, "\n";
}
}
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
t/00-compile.t view on Meta::CPAN
close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-c', $file))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
t/00-compile.t view on Meta::CPAN
close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-c', $file))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
t/00-compile.t view on Meta::CPAN
close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-c', $file))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
view release on metacpan or search on metacpan
lib/Acme/Test/LogicalEquivalence.pm view on Meta::CPAN
(local $a, local $b) = @vars;
my $r2 = !!$sub2->(@vars);
my $test = !($r1 xor $r2);
my $args = join(', ', map { $_ ? 'T' : 'F' } @vars);
ok($test, "expr1($args) <=> expr2($args)");
$equivalence = '' if !$test;
}
view release on metacpan or search on metacpan
lib/Acme/Test.pm view on Meta::CPAN
no strict 'refs';
for my $mod ( @_ ) {
load $mod;
my $str = join '/', split '::', $mod;
my @pkgs = map { s|/|::|g; s/\.pm$//i; $_ } grep /^$str/, keys %INC;
for my $pkg (@pkgs) {
diag("Testing $pkg");
my $stash = $pkg . '::';
view release on metacpan or search on metacpan
}
else {
$opt{'compat-version'} = 5;
}
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
(index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
_aMY_CXT|5.007003||p
_add_range_to_invlist|||
_append_range_to_invlist|||
_core_swash_init|||
_get_encoding|||
_get_regclass_nonbitmap_data|||
_get_swash_invlist|||
_invlist_array_init|||n
_invlist_contains_cp|||n
_invlist_contents|||
_invlist_dump|||
ptr_table_free||5.009005|
ptr_table_new||5.009005|
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_charclass_bitmap_innards|||
put_code_point|||
put_range|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
$replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
$replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
$replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
my @deps = map { s/\s+//g; $_ } split /,/, $3;
my $d;
for $d (map { s/\s+//g; $_ } split /,/, $1) {
push @{$depends{$d}}, @deps;
}
}
$need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
exit 0;
}
my @files;
my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
my $srcext = join '|', map { quotemeta $_ } @srcext;
if (@ARGV) {
my %seen;
for (@ARGV) {
if (-e) {
$File::Find::name =~ /($srcext)$/i
and push @files, $File::Find::name;
}, '.');
};
if ($@) {
@files = map { glob "*$_" } @srcext;
}
}
if (!@ARGV || $opt{filter}) {
my(@in, @out);
my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
for (@files) {
my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
push @{ $out ? \@out : \@in }, $_;
}
if (@ARGV && @out) {
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
return () if $seen->{$func}++;
my %s;
grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
}
sub parse_version
{
my $ver = 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;
}
else {
splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
}
push @full_reports, "\n";
}
}
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.06';
}
# special map on pre-defined feature sets
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
inc/Module/AutoInstall.pm view on Meta::CPAN
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
}
map { +{@args}->{$_} }
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
)[0]
);
# We want to know if we're under CPAN early to avoid prompting, but
inc/Module/AutoInstall.pm view on Meta::CPAN
my $cur = _version_of($mod);
if (_version_cmp ($cur, $arg) >= 0)
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
if (not defined $cur) # indeed missing
{
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
inc/Module/AutoInstall.pm view on Meta::CPAN
) =~ /^[Yy]/
)
)
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
elsif ( !$SkipInstall
and $default
and $mandatory
and
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
=~ /^[Nn]/ )
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
$DisabledTests{$_} = 1 for map { glob($_) } @tests;
}
}
if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
require Config;
inc/Module/AutoInstall.pm view on Meta::CPAN
sub install {
my $class = shift;
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
my ( @modules, @installed );
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
inc/Module/AutoInstall.pm view on Meta::CPAN
}
$args{test}{TESTS} ||= 't/*.t';
$args{test}{TESTS} = join( ' ',
grep { !exists( $DisabledTests{$_} ) }
map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
my $missing = join( ',', @Missing );
my $config =
join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
inc/Module/AutoInstall.pm view on Meta::CPAN
$PostambleActionsUpgradeDepsNoTest =
"\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
$PostambleActionsListDeps =
'@$(PERL) -le "print for @ARGV" '
. join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
my @all = (@Missing, @Existing);
$PostambleActionsListAllDeps =
'@$(PERL) -le "print for @ARGV" '
. join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
return %args;
}
# a wrapper to ExtUtils::MakeMaker::WriteMakefile
view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
delete $args->{SIGN};
}
# merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_,
($self->build_requires, $self->requires) );
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
inc/Module/Install/Makefile.pm view on Meta::CPAN
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
if ($self->admin->preop) {
$args{dist} = $self->admin->preop;
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
view release on metacpan or search on metacpan
lib/Acme/Text/Rhombus.pm view on Meta::CPAN
lower => sub { lc $_[0] },
upper => sub { uc $_[0] },
);
$char = $alter{$case}->($char) if $is_letter;
my @chars = map chr, (48..57, 65..90, 97..122);
$char = $chars[int(rand(@chars))] unless defined $char;
$lines++ if $lines % 2 == 0;
my ($line, $repeat, $rhombus);
view release on metacpan or search on metacpan
lib/Acme/Text/Viceversa.pm view on Meta::CPAN
my $self = shift;
my $str = shift;
$str =~ s/\r\n/\n/g;
my @results = ();
foreach ( split "\n", $str ) {
my @result = reverse map{ $self->ÇʇÉʇoɹ($_) } split /\s/, $_;
unshift @results, join " ", @result;
}
return join "\n", @results;
}
view release on metacpan or search on metacpan
lib/Acme/TextLayout.pm view on Meta::CPAN
It's all relative. Although it might not look like it on
the screen in your editor of choice, all spacing is assummed to
be the same in X and Y. Thus, the aspect ratio of the above
pattern is 16/7 (width/height).
To be useful for a GUI, one must be able to map this goofy space
into screen coordinates. That's what the B<map_range> function is
for (see below).
Now, I know what you must be thinking: is this guy nuts? Why not
use brand-X fancy GUI layout tool? Well, the fact is that those
are nice and easy for the initial layout, but they generally generate
code with precise XY coordinates in them, which makes resizing almost
impossible.
The idea here is that we use the above textual layout to specify
all the relative positions of things, then map this to a real
coordinate system, preserving the spatial relativity and size
associations.
I wrote this for use in a GUI application, but figured it might have
use elsewhere. Hence, this class. If you find a novel use for it,
lib/Acme/TextLayout.pm view on Meta::CPAN
}
./_whats_in_there($text);
./_widest($text);
$.textRef = $text;
map {
return undef unless length($_) == $.widest;
} @{$.textRef};
my %Ranges;
my %chars = %.chars;
map {
my $C = $_;
my @d = ./range($C);
$Ranges{$C} = \@d;
} keys(%chars);
lib/Acme/TextLayout.pm view on Meta::CPAN
sub _disjoint {
my ($self) = @_;
my @text = @{$.textRef};
my @chars = ./characters();
my $ok = 1;
map {
my $line = $_;
map {
my $n = 0;
my $t = $line;
$n++ while $t =~ s/$_{1,}//;
$ok = 0 if $n > 1;
} @chars;
lib/Acme/TextLayout.pm view on Meta::CPAN
my $width = ./width();
for (my $i=0; $i < $width; $i++) {
my @new;
push(@new, substr($_, $i, 1)) foreach @text;
my $line = join('', @new);
map {
my $n = 0;
my $t = $line;
$n++ while $t =~ s/$_{1,}//;
$ok = 0 if $n > 1;
} @chars;
lib/Acme/TextLayout.pm view on Meta::CPAN
sub _widest {
my ($self, $textRef) = @_;
my @text = @$textRef;
my $widest = length($text[0]);
map {
my $len = length($_);
$widest = $len if $len > $widest;
} @text;
$.widest = $widest;
}
lib/Acme/TextLayout.pm view on Meta::CPAN
sub _whats_in_there {
my ($self, $aref) = @_;
my @text = @$aref;
#print "@text", "\n";
my %chars;
map {
my $c = $_;
my $C = chr($c);
map {
my $n;
$chars{$C} = 1 if $_ =~ /\Q$C\E/;
die "$.Class - space unacceptable in pattern\n"
if $C eq " " && defined $chars{$C} && $chars{$C} == 1;
} @text;
lib/Acme/TextLayout.pm view on Meta::CPAN
sub _vrange {
my ($self, $textRef, $char) = @_;
my $top;
my $bottom;
my $n = 0;
map {
$top = $n if $_ =~ /$char/ && !defined $top;
$bottom = $n if $_ =~ /$char/;
$n++;
} @$textRef;
return ($top, $bottom);
lib/Acme/TextLayout.pm view on Meta::CPAN
sub _first {
my ($self, $textRef, $char) = @_;
my @text = @$textRef;
my $first;
map {
my $n = index $_, $char;
unless (defined $first) {
$first = $n if $n >= 0;
}
if (defined $first && $n >= 0) {
lib/Acme/TextLayout.pm view on Meta::CPAN
sub _last {
my ($self, $textRef, $char) = @_;
my @text = @$textRef;
my $last;
map {
my $n = rindex $_, $char;
unless (defined $last) {
$last = $n if $n >= 0;
}
if (defined $last && $n >= 0) {
lib/Acme/TextLayout.pm view on Meta::CPAN
my $left = ./_first($textRef, $char);
my $right = ./_last($textRef, $char);
return ($top, $bottom, $left, $right);
}
# simple equation to map char ranges to something else
sub _stretch_offset {
my ($self, $i1, $i2, $o1, $o2) = @_;
# handle single characters
$i2 = $i1 + 1 if $i1 == $i2;
my $stretch = ($o2-$o1)/($i2-$i1);
lib/Acme/TextLayout.pm view on Meta::CPAN
my ($self) = @_;
my $h = ./_height($.textRef);
return $h;
}
=head2 B<map_range>
@bbox = $tl->map_range($width, $height, $char);
Map the relative position and size of the indicated character ($char)
region in our pattern to a real XY coordinate space.
@bbox is the bounding box, returned as ($x1, $y1, $x2, $y2), where
lib/Acme/TextLayout.pm view on Meta::CPAN
to be 0,0 in the upper left corner, with x bigger to the right, and
y bigger down. Adjust as necessary to fit your problem domain.
=cut
sub map_range {
my ($self, $width, $height, $char) = @_;
my @r = @{$.Ranges{$char}};
my $h = ./_height($.textRef);
my $w = ./_widest($.textRef);
my ($xs, $xo) = ./_stretch_offset(0, $w, 0, $width);
lib/Acme/TextLayout.pm view on Meta::CPAN
my @x0 = @$c0;
my @x1 = @$c1;
$x{$_} = 1 foreach $x0[0] .. $x0[1];
$x{$_} += 1 foreach $x1[0] .. $x1[1];
my $status;
map {
$status = 1 if $x{$_} > 1;
} keys(%x);
return defined $status ? 1 : 0;
}
lib/Acme/TextLayout.pm view on Meta::CPAN
my @r = @{$.Ranges{$char}};
return () if $r[0] == 0;
return @{$.Above{$char}} if defined $.Above{$char};
my @keys = keys(%.Ranges);
my @d;
map {
if ($_ ne $char) {
#print "Comparing $_ ";
my @other = @{$.Ranges{$_}};
push(@d, $_) if ./_in_x(\@r, \@other) &&
($other[0] == ($r[0]-1) || $other[1] == ($r[0]-1));
lib/Acme/TextLayout.pm view on Meta::CPAN
my @r = @{$.Ranges{$char}};
return () if $r[1] == ./width();
return @{$.Below{$char}} if defined $.Below{$char};
my @keys = keys(%.Ranges);
my @d;
map {
if ($_ ne $char) {
my @other = @{$.Ranges{$_}};
push(@d, $_) if ./_in_x(\@r, \@other) &&
($other[0] == ($r[0]+1) || $other[1] == ($r[0]+1));
}
lib/Acme/TextLayout.pm view on Meta::CPAN
my @r = @{$.Ranges{$char}};
return () if $r[2] == 0;
return @{$.Left{$char}} if defined $.Left{$char};
my @keys = keys(%.Ranges);
my @d;
map {
if ($_ ne $char) {
my @other = @{$.Ranges{$_}};
push(@d, $_) if ./_in_y(\@r, \@other) &&
($other[3] == ($r[2]-1));
}
lib/Acme/TextLayout.pm view on Meta::CPAN
my @r = @{$.Ranges{$char}};
return () if $r[2] == ./width();
return @{$.Right{$char}} if defined $.Right{$char};
my @keys = keys(%.Ranges);
my @d;
map {
if ($_ ne $char) {
my @other = @{$.Ranges{$_}};
push(@d, $_) if ./_in_y(\@r, \@other) &&
($other[2] == ($r[3]+1));
}
lib/Acme/TextLayout.pm view on Meta::CPAN
my $text = $.textRef[$line];
return unless defined $text;
my %Chars;
my @Chars;
my @chars = split('', $text);
map {
unless (defined $Chars{$_}) {
push(@Chars, $_);
$Chars{$_} = 1;
}
} @chars;
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
view release on metacpan or search on metacpan
t/lib/Capture/Tiny.pm view on Meta::CPAN
return *{$glob}{NAME};
}
sub _open {
open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
# _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
}
sub _close {
# _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . " on " . fileno( $_[0] ) . "\n" );
close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
t/lib/Capture/Tiny.pm view on Meta::CPAN
}
}
sub _slurp {
my ($name, $stash) = @_;
my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
# _debug( "# slurping captured $name from " . fileno($fh) . " at pos $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
my $text = do { local $/; scalar readline $fh };
return defined($text) ? $text : "";
}
view release on metacpan or search on metacpan
lib/Acme/Tie/Eleet.pm view on Meta::CPAN
# Transform o to 0, l to 1, etc. That's 31337!
sub _apply_letters {
my ($self, $target) = @_;
return join "", map { rand(100) < $self->{letters} && exists $letter{$_} ?
( ref($letter{$_}) eq ref([]) ) ?
$letter{$_}[rand( @{$letter{$_}} ) ] :
$letter{$_}
: $_ } split //, $target;
}