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

pride.pm  view on Meta::CPAN

	  # caller-filter leaves some data in the buffer, and filter gets to see
	  # it in $_ for a second time.
	  if (@lines) {
	    push @lines, $_;
	    $_ = shift @lines;
	    return length $_;
	  }
	  return 0;
	});
      }
    }

 view release on metacpan or  search on metacpan

lib/Acrux/DBI.pm  view on Meta::CPAN

    my $dsn = '';
    my $db = $self->database;
    if ($dr eq 'sqlite' or $dr eq 'file') {
        $dsn = sprintf('DBI:SQLite:dbname=%s', $db);
    } elsif ($dr eq 'mysql') {
        push @params, sprintf("%s=%s", "database", $db) if length $db;
        push @params, sprintf("%s=%s", "host", $self->host);
        push @params, sprintf("%s=%s", "port", $self->port) if $self->port;
        $dsn = sprintf('DBI:mysql:%s', join(";", @params) || '');
    } elsif ($dr eq 'maria' or $dr eq 'mariadb') {
        push @params, sprintf("%s=%s", "database", $db) if length $db;
        push @params, sprintf("%s=%s", "host", $self->host);
        push @params, sprintf("%s=%s", "port", $self->port) if $self->port;
        $dsn = sprintf('DBI:MariaDB:%s', join(";", @params) || '');
    } elsif ($dr eq 'pg' or $dr eq 'pgsql' or $dr eq 'postgres' or $dr eq 'postgresql') {
        push @params, sprintf("%s=%s", "dbname", $db) if length $db;
        push @params, sprintf("%s=%s", "host", $self->host);
        push @params, sprintf("%s=%s", "port", $self->port) if $self->port;
        $dsn = sprintf('DBI:Pg:%s', join(";", @params) || '');
    } elsif ($dr eq 'oracle') {
        push @params, sprintf("%s=%s", "host", $self->host);
        push @params, sprintf("%s=%s", "sid", $db) if length $db;
        push @params, sprintf("%s=%s", "port", $self->port) if $self->port;
        $dsn = sprintf('DBI:Oracle:%s', join(";", @params) || '');
    } else {
        $dsn = DEFAULT_DBI_DSN;
    }

lib/Acrux/DBI.pm  view on Meta::CPAN

          ? {%{$_[0]}}
          : {bind_values => [@_]}
      : {};
    $self->{error} = '';
    return unless my $dbh = $self->dbh;
    unless (length($sql)) {
        $self->error("No statement specified");
        return;
    }

    # Prepare

 view release on metacpan or  search on metacpan

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

    }

    # Root dir
    my $root = $self->{root};
    $root = $self->{root} = $pwd if defined($root) && $root eq '.'; # Set root to cwd if specified as '.'
    unless (defined($root) && length($root)) {
        $root = $self->{root} = File::Spec->catdir(SYSCONFDIR, $moniker);
    }

    # Temp dir
    my $temp = $self->{tempdir};
    unless (defined($temp) && length($temp)) {
        $temp = $self->{tempdir} = File::Spec->catdir(File::Spec->tmpdir(), $moniker);
    }

    # Data dir
    my $datadir = $self->{datadir};
    unless (defined($datadir) && length($datadir)) {
        $datadir = $self->{datadir} = File::Spec->catdir(SHAREDSTATEDIR, $moniker);
    }

    # Log dir
    my $logdir = $self->{logdir};
    unless (defined($logdir) && length($logdir)) {
        $logdir = $self->{logdir} = File::Spec->catdir(LOGDIR, $moniker);
    }

    # Share dir
    my $sharedir = $self->{sharedir};
    unless (defined($sharedir) && length($sharedir)) {
        $self->{sharedir} = File::Spec->catdir(DATADIR, $moniker);
    }

    # Doc dir
    my $docdir = $self->{docdir};
    unless (defined($docdir) && length($docdir)) {
        $self->{docdir} = File::Spec->catdir(DOCDIR, $moniker);
    }

    # Cache dir
    my $cachedir = $self->{cachedir};
    unless (defined($cachedir) && length($cachedir)) {
        $self->{cachedir} = File::Spec->catdir(CACHEDIR, $moniker);
    }

    # Spool dir
    my $spooldir = $self->{spooldir};
    unless (defined($spooldir) && length($spooldir)) {
        $self->{spooldir} = File::Spec->catdir(SPOOLDIR, $moniker);
    }

    # Run dir
    my $rundir = $self->{rundir};
    unless (defined($rundir) && length($rundir)) {
        $rundir = $self->{rundir} = File::Spec->catdir(RUNDIR, $moniker);
    }

    # Lock dir
    my $lockdir = $self->{lockdir};
    unless (defined($lockdir) && length($lockdir)) {
        $self->{lockdir} = File::Spec->catdir(LOCKDIR, $moniker);
    }

    # Web dir
    my $webdir = $self->{webdir};
    unless (defined($webdir) && length($webdir)) {
        $self->{webdir} = File::Spec->catdir(WEBDIR, $moniker);
    }

    # Config file
    my $configfile = $self->{configfile};
    unless (defined($configfile) && length($configfile)) {
        $self->{configfile} = $configfile = File::Spec->catfile($root, sprintf("%s.conf", $moniker));
    }
    unless (File::Spec->file_name_is_absolute($configfile)) {
        $self->{configfile} = $configfile = File::Spec->rel2abs($configfile);
    }

    # Log file
    my $logfile = $self->{logfile};
    unless (defined($logfile) && length($logfile)) {
        $self->{logfile} = $logfile = File::Spec->catfile($logdir, sprintf("%s.log", $moniker));
    }
    unless (File::Spec->file_name_is_absolute($logfile)) {
        $self->{logfile} = $logfile = File::Spec->rel2abs($logfile);
    }

    # PID file
    my $pidfile = $self->{pidfile};
    unless (defined($pidfile) && length($pidfile)) {
        $self->{pidfile} = $pidfile = File::Spec->catfile($rundir, sprintf("%s.pid", $moniker));
    }
    unless (File::Spec->file_name_is_absolute($pidfile)) {
        $self->{pidfile} = $pidfile = File::Spec->rel2abs($pidfile);
    }

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

    return $self->{plugins} if scalar(@_) < 1;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    my $plugins = $self->{plugins};
    foreach my $k (keys %$args) {
        next if exists($plugins->{$k}) && $plugins->{$k}->{loaded}; # Skip loaded plugins
        $plugins->{$k} = { class => $args->{$k}, loaded => 0 } if length($args->{$k} // '');
    }
    return $self;
}
sub plugin {
    my $self = shift;
    my $name = shift // ''; # Plugin name
    my $class = shift // ''; # Plugin class
    my @args = @_;
    my $plugins = $self->{plugins}; # Get list of plugins
    return unless length $name;

    # Lookup class by name
    unless (length($class)) {
        # Lookup in existing plugins
        $class = $plugins->{$name}->{class} // '' if exists $plugins->{$name};

        # Lookup in defaults
        $class = DEFAULT_PLUGINS()->{$name} // '' unless length $class;
    }
    return unless length $class;

    # Register found plugin
    $self->register_plugin($name, $class, @args); # name, class, args
}
sub register_plugin {
    my $self = shift;
    my $name = shift // ''; # Plugin name
    my $class = shift // ''; # Plugin class
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}; # Plugin arguments
    my $plugins = $self->{plugins};
    croak "No plugin name specified!" unless length $name;
    croak "No plugin class specified!" unless length $class;

    # Load plugin if not exists in already loaded plugins list
    return 1 if exists($plugins->{$name}) && $plugins->{$name}->{loaded};
    if (my $error = load_class($class)) {
        $self->verbosemode

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

    $Acme::Crux::Sandbox::HANDLERS{$k} = {} unless exists($Acme::Crux::Sandbox::HANDLERS{$k});
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{$k};

    # Handler name
    my $name = trim($info{handler} // $info{name} // 'default');
    croak("The handler name missing") unless length($name);
    delete $info{handler};
    $info{name} = $name;
    croak("The $name duplicate handler definition") if defined($handlers->{$name});

    # Handler aliases

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

       $_aliases = [ trim($_aliases) ] unless is_array_ref($_aliases);
    my $aliases = words(@$_aliases);
    #foreach my $al (@$_aliases) {
    #    next unless defined($al) && is_value($al);
    #    foreach my $p (split(/[\s;,]+/, $al)) {
    #        next unless defined($p) && length($p);
    #        $aliases{$p} = 1;
    #    }
    #}
    delete $info{alias};
    $info{aliases} = [grep {$_ ne $name} @$aliases];

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

    return 1;
}
sub lookup_handler {
    my $self = shift;
    my $name = trim(shift // '');
    return undef unless length $name;
    my $invocant = ref($self) || scalar(caller(0));
    my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
    return undef unless defined($handlers) && is_hash_ref($handlers);
    foreach my $n (keys %$handlers) {
        my $aliases = as_array_ref($handlers->{$n}->{aliases});

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

    # All: names and aliases
    my %seen = ();
    foreach my $n (keys %$handlers) {
        my $aliases = as_array_ref($handlers->{$n}->{aliases});
        foreach my $_a ($n, @$aliases) {
            $seen{$_a} = 1 if defined($_a) and length($_a);
        }
    }
    return [(sort {$a cmp $b} keys %seen)];
}
sub run_handler {

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

    my @args = @_;
    if ($self->{running}) {
        $self->error(sprintf(qq{The application "%s" is already runned}, $self->project));
        return 0;
    }
    unless(length($name)) {
        $self->error("Invalid handler name");
        return 0;
    }
    my $meta = $self->lookup_handler($name);
    unless ($meta) {

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

    my $prj = shift;
    return unless defined($prj);
    $prj =~ s/::/-/g;
    $prj =~ s/[^A-Za-z0-9_\-.]/_/g; # Remove incorrect chars
    $prj =~ s/([_\-.]){2,}/$1/g; # Remove dubles
    return unless length($prj);
    return lc($prj);
}

1;

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

=head2 Dictionary File Format

To create a dictionary file, create a file named C<E<lt>realmE<gt>.dict>
containing key/value pairs separated by whitespace. Keys can have any
non-whitespace character in them. The amount of whitespace between key
and value can be any length and can be tab or space characters (more
specifically, any character that matches C</\s/>). Keys and values must
be on the same line.

For example:

 view release on metacpan or  search on metacpan

lib/ActiveRecord/Simple/Utils.pm  view on Meta::CPAN

    return $class->_get_table_name if $class->can('_get_table_name');

    $class =~ s/.*:://;
    #$class_name = lc $class_name;
    my $table_name = join('_', map {lc} grep {length} split /([A-Z]{1}[^A-Z]*)/, $class);

    return $table_name;
}

sub is_integer {

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

    }

  }

  my $content_type = $res->header('Content-Type');
  my $content_length = $res->header('Content-Length');

  my(%new_args) = (
    code => $res->code,
    content_type => $content_type
  );

 view release on metacpan or  search on metacpan

ex/ai-bot.pl  view on Meta::CPAN

#   IRC_SERVER=irc.perl.org     IRC server (default: irc.perl.org)
#   IRC_NICKNAME=Bert           Bot nickname (default: random from a fun list)
#   OWNER=Getty                 Bot owner name for personality (default: $USER)
#   IRC_CHANNELS=#ai            Channels to join
#   DB_FILE=ai-bot.db           SQLite database path
#   MAX_LINE_LENGTH=400         Max IRC line length (default: 400)
#   BUFFER_DELAY=1.5            Seconds to buffer messages before processing (default: 1.5)
#   LINE_DELAY=1.5              Delay between outgoing IRC lines (default: 1.5)
#   IDLE_PING=1800              Seconds of silence before idle ping (default: 1800)
#   SYSTEM_PROMPT=...           Additional text appended to the system prompt

ex/ai-bot.pl  view on Meta::CPAN

  my ($self, $channel, $text) = @_;
  my @chunks;
  for my $line (split(/\n/, $text)) {
    $line =~ s/^\s+//;
    $line =~ s/\s+$//;
    next unless length $line;
    while (length($line) > $MAX_LINE) {
      my $chunk = substr($line, 0, $MAX_LINE);
      if ($chunk =~ /^(.{1,$MAX_LINE})\s/) {
        $chunk = $1;
      }
      push @chunks, $chunk;
      $line = substr($line, length($chunk));
      $line =~ s/^\s+//;
    }
    push @chunks, $line if length $line;
  }
  # Send each line with a delay BEFORE it, simulating typing time
  # ~30 chars/sec typing speed, minimum 1.5s delay
  my $cumulative = 0;
  for my $i (0 .. $#chunks) {
    my $delay = length($chunks[$i]) / 30;
    $delay = 1.5 if $delay < 1.5;
    $delay += 5 if $i > 0 && $chunks[$i - 1] =~ /\.{3}\s*\*?\s*$/;
    $cumulative += $delay;
    POE::Kernel->delay_add( _send_line => $cumulative, $channel, $chunks[$i] );
  }

ex/ai-bot.pl  view on Meta::CPAN

  $answer =~ s/<\/?\w+>//g;                            # strip remaining XML tags
  # Strip lines where the AI narrates its tool usage
  $answer =~ s/^\*?\s*(save_note|recall_notes|update_note|delete_note|recall_history|stay_silent|set_alarm|whois|send_private_message)\b[^\n]*\n?//mg;

  # Check for lines too long
  my @lines = grep { length } map { s/^\s+//r =~ s/\s+$//r } split(/\n/, $answer);
  my $too_long = grep { length($_) > $MAX_LINE } @lines;
  if ($too_long) {
    $self->info("Response too long, asking to shorten");
    $answer = eval {
      my $retry = $self->_raider->raid(
        "Your last response had lines over $MAX_LINE characters. "

 view release on metacpan or  search on metacpan

lib/Adapter/Async/OrderedList.pm  view on Meta::CPAN

=item * splice - changes to the array which remove or add elements

=item * move - an existing element moves to a new position (some adapters may not be able to differentiate between this and splice: if in doubt, use splice instead, don't report as a move unless it's guaranteed to be existing items)

 index, length, offset (+/-)

=back

The view raises these:

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

  The object code form of an Application may incorporate material from
a header file that is part of the Library.  You may convey such object
code under terms of your choice, provided that, if the incorporated
material is not limited to numerical parameters, data structure
layouts and accessors, or small macros, inline functions and templates
(ten or fewer lines in length), you do both of the following:

   a) Give prominent notice with each copy of the object code that the
   Library is used in it and that the Library and its use are
   covered by this License.

 view release on metacpan or  search on metacpan

lib/Advanced/Config/Date.pm  view on Meta::CPAN

   my $date_str = shift;

   my $month;
   my $digits = 0;

   my @lst = sort { length($b) <=> length($a) || $a cmp $b } keys %Months;

   foreach my $m ( @lst ) {
      # Ignore numeric keys, can't get the correct one from string ...
      next  if ( $m =~ m/^\d+$/ );

lib/Advanced/Config/Date.pm  view on Meta::CPAN

   my $month_str   = shift;        # Will be undef if skip_period is true!

   my $day;
   my $digits = 0;

   my @lst = sort { length($b) <=> length($a) || $a cmp $b } keys %Days;

   my $all_digits = $skip_period ? "^\\d+[.]?\$" : "^\\d+\$";

   foreach my $dom ( @lst ) {
      # Ignore numeric keys, can't get the correct one from string ...

 view release on metacpan or  search on metacpan

lib/Affix/Build.pm  view on Meta::CPAN

            # We prefer C++ drivers (g++, clang++) to handle standard libraries for mixed code (C+Rust, C+C++)
            $linker = $self->_can_run(qw[g++ clang++ c++ icpx]) || $self->_can_run(qw[cc gcc clang icx cl]) || 'c++';

            # Parse global flags...
            @cflags   = map { chomp; $_ } grep { defined && length } Text::ParseWords::parse_line( q/ /, 1, $flags->{cflags}   // '' );
            @cxxflags = map { chomp; $_ } grep { defined && length } Text::ParseWords::parse_line( q/ /, 1, $flags->{cxxflags} // '' );
            @ldflags  = map { chomp; $_ } grep { defined && length } Text::ParseWords::parse_line( q/ /, 1, $flags->{ldflags}  // '' );
        }

        method add ( $input, %args ) {
            $_lib = ();                        # Reset cached library handle
            my ( $path, $lang );

 view release on metacpan or  search on metacpan

lib/Aion/Annotation.pm  view on Meta::CPAN

	my %exists;

	for my $lib (@libs) {
		my $iter = find $lib, "*.pm", "-f";
		while(<$iter>) {
			my $pkg = to_pkg(substr $_, 1 + length $lib);
			$exists{$pkg} = 1;
			my $mtime = int mtime;
			next if !$self->force && exists $modules_mtime->{$pkg} && $modules_mtime->{$pkg} == $mtime;
			$modules_mtime->{$pkg} = $mtime;

 view release on metacpan or  search on metacpan

lib/Aion/Carp.pm  view on Meta::CPAN

	    main::D() called at t/aion/carp.t line 20
	    eval {...} called at t/aion/carp.t line 20
	";
	$expected =~ s/^ {4}/\t/gm;
	
	substr($@, 0, length $expected) # => $expected
	
	
	my $exception = {message => "hi!"};
	eval { die $exception };
	$@  # -> $exception

 view release on metacpan or  search on metacpan

lib/Aion/Emitter/ListenersRun.pm  view on Meta::CPAN

	my @listeners = sort { $a->{evt} eq $b->{evt}? $a->{nice} <=> $b->{nice}: $a->{evt} cmp $b->{evt} }
		pairmap { my $evt = $a; map { +{ %$_, evt => $evt, act => "$_->{pkg}#$_->{sub}", nice => 0+$_->{nice} } } @$b }
		%{$self->emitter->event};
	
	@listeners = grep { /$self->{mask}/ } @listeners if $self->mask ne "";
	my $evtlen = max map length $_->{evt}, @listeners;
	my $actlen = max map length $_->{act}, @listeners;
	my $nicelen = max map length $_->{nice}, @listeners;
	for my $listener_bag (@listeners) {
		printcolor "#{blue}%+${nicelen}s#r #green%-${evtlen}s #{red}%-${actlen}s #{bold black}%s#r\n", @$listener_bag{qw/nice evt act remark/};
	}
}

 view release on metacpan or  search on metacpan

lib/Aion/Enum.pm  view on Meta::CPAN

# Создать перечисление
sub case(@) {
	my ($name, $value, $stash) = @_;
	
	die "The case name must by 1+ simbol!" unless length $name;
	
	my $pkg = caller;
	my $meta = $Aion::META{$pkg};
	my $issa = $meta->{issa};
	my $enum = $meta->{enum} //= [];

 view release on metacpan or  search on metacpan

t/aion/env.t  view on Meta::CPAN

use common::sense; use open qw/:std :utf8/;  use Carp qw//; use Cwd qw//; use File::Basename qw//; use File::Find qw//; use File::Slurper qw//; use File::Spec qw//; use File::Path qw//; use Scalar::Util qw//;  use Test::More 0.98;  use String::Diff q...
# # NAME
# 
# Aion::Env - создаёт константу связанную со значением из .env
# 
# # VERSION

 view release on metacpan or  search on metacpan

lib/Aion/Format.pm  view on Meta::CPAN

# Переводит натуральное число в заданную систему счисления
sub to_radix($;$) {
	use bigint;
	my ($n, $radix) = @_;
	$radix //= 64;
	die "to_radix: The number system $radix is too large. Use NS before " . (1 + length $CIF) if $radix > length $CIF;
	$n+=0; $radix+=0;
	my $x = "";
	for(;;) {
		my $cif_idx = $n % $radix;
		my $cif = substr $CIF, $cif_idx, 1;

lib/Aion/Format.pm  view on Meta::CPAN

sub from_radix(@) {
	use bigint;
	my ($s, $radix) = @_;
	$radix //= 64;
	$radix+=0;
	die "from_radix: The number system $radix is too large. Use NS before " . (1 + length $CIF) if $radix > length $CIF;
	my $x = 0;
	for my $ch (split "", $s) {
		$x = $x*$radix + index $CIF, $ch;
	}
	return $x;

lib/Aion/Format.pm  view on Meta::CPAN

sub sround($;$) {
	my ($number, $digits) = @_;
	$digits //= 2;
	my $num = sprintf("%.100f", $number);
	$num =~ /^-?0?(\d*)\.(0*)[1-9]/;
	return "" . round($num, $digits + length $2) if length($1) == 0;
	my $k = $digits - length $1;
	return "" . round($num, $k < 0? 0: $k);
}

# Кибибайт
sub KiB() { 2**10 }

lib/Aion/Format.pm  view on Meta::CPAN

	KiB  # -> 2**10

=head2 xxL ()

Maximum length of LongText mysql and mariadb data.
L - large.

	xxL  # -> 4*GiB-1

=head2 xxM ()

Maximum length of MediumText mysql and mariadb data.
M - medium.

	xxM  # -> 16*MiB-1

=head2 xxR ()

Maximum text length of mysql and mariadb data.
R - regularity.

	xxR  # -> 64*KiB-1

=head2 xxS ()

Maximum length of TinyText mysql and mariadb data.
S - small.

	xxS  # -> 255

=head2 to_str (;$scalar)

 view release on metacpan or  search on metacpan

lib/Aion/Fs.pm  view on Meta::CPAN

				for(my $i = $#S; $i>=0; --$i) { $curgroup = $S[$i][1], last if defined $S[$i][1] }
				
				$_->{remove}{$curgroup}{$group}++ if defined $curgroup;
			}
		
			push @S, [length($`) + length $&, $group];
		}
		elsif($+{close}) {
			my ($pos, $group, $g2) = @{pop @S};
			
			$S[$#S][2] //= $group if $_->{group}{$group} && @S;
			
			$group //= $g2;
			$_->{group}{$group} = do {
				my $x = substr $_->{regexp}, $pos, length($`) - $pos;
				qr/()^$x\z/xsn
			} if defined $group;
		}
	}
	

lib/Aion/Fs.pm  view on Meta::CPAN

	cat "/etc/passwd"  # ~> root

C<cat> reads with layer C<:utf8>. But you can specify another layer like this:

	lay "unicode.txt", "↯";
	length cat "unicode.txt"            # -> 1
	length cat["unicode.txt", ":raw"]   # -> 3

C<cat> throws an exception if the I/O operation fails:

	eval { cat "A" }; $@  # ~> cat A: No such file or directory

 view release on metacpan or  search on metacpan

lib/Aion/Query.pm  view on Meta::CPAN

			$r
		} else {
			0 + $base->do($query)
		}
	};
	die +(length($query)>MAX_QUERY_ERROR? substr($query, 0, MAX_QUERY_ERROR) . " ...": $query) . "\n\n$@" if $@;

	$res
}

sub query_ref(@) {

 view release on metacpan or  search on metacpan

lib/Aion/Run/RunsRun.pm  view on Meta::CPAN

	my @runs = sort {
		$a->{rubric} eq $b->{rubric}? ($a->{name} cmp $b->{name}): $a->{rubric} cmp $b->{rubric}
	} grep { $_->{name} =~ $self->mask } values %{ Aion::Run::Runner->new->runs };
	
	my $len = max map length $_->{name}, @runs;

	for my $run (@runs) {
		eval "require $run->{pkg}";
		my $FEATURE = $Aion::META{$run->{pkg}}{feature};
		my $ARG = {};

lib/Aion/Run/RunsRun.pm  view on Meta::CPAN

			$_->{required} ? ($_->{isa}{name} eq "ArrayRef" ? "$x..." : $x) :
			    ($_->{isa}{name} eq "ArrayRef" ? "[$x...]" : "[$x]")
	    } @features;
	}
	
	my $len2 = max map length $_->{args}, @runs;
	
	my $rubric;
	for(@runs) {
		printcolor "#yellow%s#r\n", $rubric = $_->{rubric} if $rubric ne $_->{rubric};

 view release on metacpan or  search on metacpan

t/aion/spirit.t  view on Meta::CPAN

use common::sense; use open qw/:std :utf8/; use Test::More 0.98; sub _mkpath_ { my ($p) = @_; length($`) && !-e $`? mkdir($`, 0755) || die "mkdir $`: $!": () while $p =~ m!/!g; $p } BEGIN { use Scalar::Util qw//; use Carp qw//; $SIG{__DIE__} = sub { ...
# 
# Aion::Spirit - functions for controlling the program execution process
# 
# # VERSION
# 

 view release on metacpan or  search on metacpan

t/aion/surf.t  view on Meta::CPAN

use common::sense; use open qw/:std :utf8/; use Test::More 0.98; sub _mkpath_ { my ($p) = @_; length($`) && !-e $`? mkdir($`, 0755) || die "mkdir $`: $!": () while $p =~ m!/!g; $p } BEGIN { use Scalar::Util qw//; use Carp qw//; $SIG{__DIE__} = sub { ...
# 
# Aion::Surf - surfing by internet
# 
# # VERSION
# 

 view release on metacpan or  search on metacpan

t/aion/telemetry.t  view on Meta::CPAN

use common::sense; use open qw/:std :utf8/; use Test::More 0.98; sub _mkpath_ { my ($p) = @_; length($`) && !-e $`? mkdir($`, 0755) || die "mkdir $`: $!": () while $p =~ m!/!g; $p } BEGIN { use Scalar::Util qw//; use Carp qw//; $SIG{__DIE__} = sub { ...
# 
# Aion::Telemetry - measures the time the program runs between specified points
# 
# # VERSION
# 

 view release on metacpan or  search on metacpan

lib/Aion/Meta/Util.pm  view on Meta::CPAN

			$v = overload::Overloaded($v) && !overload::Method($v, '""')
				? join("#", Scalar::Util::reftype($v), Scalar::Util::refaddr($v))
				: "$v";
		}
		$v = substr($v, 0, MAX_SCALAR_LENGTH) . '...'
			if length($v) > MAX_SCALAR_LENGTH;
		$no_str ? $v : "'${\ $v =~ s/['\\]/\\$&/gr }'"
	}
}

1;

 view release on metacpan or  search on metacpan

lib/Akamai/Edgegrid.pm  view on Meta::CPAN

}

# see http://search.cpan.org/~mshelor/Digest-SHA-5.88/lib/Digest/SHA.pm#PADDING_OF_BASE64_DIGESTS
sub _pad_digest {
    my $digest = shift;
    while (length($digest) % 4) {
        $digest .= '=';
    }
    return $digest;
}

lib/Akamai/Edgegrid.pm  view on Meta::CPAN

    );
}

sub _make_content_hash {
    my ($self, $r) = @_;
    if ($r->method eq 'POST' and length($r->content) > 0) {
        my $body = $r->content;
        if (length($body) > $self->{max_body}) {
            $self->_debug(
                "data length " . length($body) . " is larger than maximum " . $self->{max_body}
            );

            $body = substr($body, 0, $self->{max_body});

            $self->_debug(
                "data truncated to " . length($body) . " for computing the hash"
            );
        }
        return _padded_sha256_base64($body);
    }
    return "";

 view release on metacpan or  search on metacpan

lib/Akamai/Open/Request/EdgeGridV1.pm  view on Meta::CPAN

sub content_hash {
    my $self = shift;
    my $content_hash = '';

    if($self->request->method eq 'POST' && length($self->request->content) > 0) {
        $content_hash = encode_base64(sha256($self->request->content));
        chomp($content_hash);
    }

    return($content_hash);