view release on metacpan or  search on metacpan

lib/Activiti/Rest/Client.pm  view on Meta::CPAN

  die("no parsed content") unless $res->has_parsed_content;

  my $pdefs = $res->parsed_content;

  my @ids = map { $_->{id} } @{ $pdefs->{data} };
  for my $id(@ids){
    print Dumper($client->process_definition(processDefinitionId => $id)->parsed_content);
  }

=head1 CONSTRUCTOR parameters

 view release on metacpan or  search on metacpan

ex/declare.pl  view on Meta::CPAN

        my ($nick) = split /!/, $nickstr;
          $self->privmsg( $channels => "$nick: ${ \$self->message }" );
    };
}

my @bots = map { MasterMold->new( nickname => "Sentinel_${_}" ) } ( 1 .. 2 );

POE::Kernel->run;

 view release on metacpan or  search on metacpan

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

			UnorderedMap => 'Adapter::Async::UnorderedMap::Hash',
			OrderedList  => 'Adapter::Async::OrderedList::Array',
		);
		if(defined(my $from = $details->{from})) {
			$log->tracef("Should apply field %s from %s for %s", $k, $from, $pkg);
			++$loader{$_} for grep /::/, map $type_expand->($_), @{$details}{qw(type)};
		} else {
			no strict 'refs';
			no warnings 'once';
			push @{$pkg . '::attrs'}, $k unless $details->{collection}
		}

		if(my $type = $details->{collection}) {
			my $collection_class = $collection_class_for{$type} // die "unknown collection $type";
			++$loader{$collection_class};
			$log->tracef("%s->%s collection: %s", $pkg, $k, $type);
			++$loader{$_} for grep /::/, map $type_expand->($_), @{$details}{qw(key item)};
			$code = sub {
				my $self = shift;
				die "no args expected" if @_;
				$self->{$k} //= $collection_class->new;
			}

 view release on metacpan or  search on metacpan

lib/AddressBook.pm  view on Meta::CPAN

sub get_cannonical_attribute_names {
  my $self=shift;
  my $class = ref $self || croak "Not a method call.";
  my @fields = $self->get_attribute_names;
  my @names = map {$self->{config}->{db2generic}->{$self->{db_name}}->{$_}} @fields;
  return @names;
}

1;
__END__

 view release on metacpan or  search on metacpan

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

  create_build_script process_etc_files do_create_readme
  process_public_files process_templates_files
  ACTION_perltidy ACTION_submit PERL_DIRS);

sub PERL_DIRS {
    state $dirs = [map { catdir($_[0]->base_dir, $_) } qw(bin lib etc t)];
    return @$dirs;
}

sub create_build_script {
    my $self = shift;

 view release on metacpan or  search on metacpan

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

# Updated by:  init_special_date_arrays() ...
# May be for a different language than the above hashes ...
my $prev_array_lang = "English";
my @gMoY = qw ( January February March April May June
                July August September October November December );
my @gMoYs =  map { uc (substr($_,0,3)) } @gMoY;
my @gDsuf = sort { my ($x,$y) = ($a,$b); $x=~s/\D+$//; $y=~s/\D+$//; $x<=>$y } grep (/^\d+\D+$/, keys %Days, "0th");
my @gDoW  = qw( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
my @gDoWs = map { uc (substr($_,0,3)) } @gDoW;


# ==============================================================
# Not in pod on purpose.  Only added to simplify test cases.
sub _date_language_installed

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

   $last_language_edit_flags{language} = $lang;

   # ---------------------------------------------------------
   # Bug Alert:  For some languges the following isn't true!
   #     lc(MoY) != lc(uc(lc(MoY)))
   # So we have multiple lower case letters mapping to the
   # same upper case letters#.
   # ---------------------------------------------------------
   # This happens for 3 languages for Date::Language.
   #     Chinese_GB, Greek & Russian_cp1251
   # And one language for Date::Manip

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

   # If the new language was valid, update the global variables ...
   if ( $MoY_ref ) {
      $prev_array_lang = $lang;
      @gMoY  = @{$MoY_ref};
      @gMoYs = map { uc($_) } @{$MoYs_ref};
      @gDoW  = @{$DoW_ref};
      @gDoWs = map { uc($_) } @{$DoWs_ref};
      @gDsuf = @{$Dsuf_ref};

      DBUG_PRINT ( "LANGUAGE", "%s\n%s\n%s\n%s\n%s",
                   join (", ", @gMoY), join (", ", @gMoYs),
                   join (", ", @gDoW), join (", ", @gDoWs),

 view release on metacpan or  search on metacpan

lib/Bundle/Advent/Year2006.pm  view on Meta::CPAN

Devel::SmallProf - L<pod|Devel::SmallProf>, L<http://www.perladvent.org/2006/01/>

File::Find::Object - L<pod|File::Find::Object>, L<http://www.perladvent.org/2006/02/>

Treemap - L<pod|Treemap>, L<http://www.perladvent.org/2006/03/>

CGI::Minimal - L<pod|CGI::Minimal>, L<http://www.perladvent.org/2006/04/>

ack - L<pod|ack>, L<http://www.perladvent.org/2006/05/>

 view release on metacpan or  search on metacpan

Infix2Postfix.pm  view on Meta::CPAN

      if (!exists( $op->{'type'} )) { $op->{'type'}='binary'; }
      if (!exists( $op->{'assoc'} )) { $op->{'assoc'}='left'; }
      if (!exists( $op->{'trans'} )) { $op->{'trans'}=$op->{'op'}; }
    }

    @{$self->{'opr'}}=map { $_->{'op'} } @{$self->{'ops'}};

    @{$self->{'tokens'}}=(@{$self->{'opr'}},@{$self->{'func'}},@{$self->{'vars'}},@{$self->{'grouping'}});

    $self->{'varre'}=join('|',map { quotemeta($_) } @{$self->{'vars'}});
    $self->{'funcre'}=join('|',map { quotemeta($_) } @{$self->{'func'}});

    $self->{'numre'}='[+-]?(?:\d+\.?\d*|\.\d+)(?:[eE][+-]?\d+)?';

    $self->{'re'}=join('|',(map { quotemeta($_).'(?!'.quotemeta($_).')' } @{$self->{'tokens'}}),$self->{'numre'});
    $self->{'ree'}=$self->{'re'}.'|.+?';
    $self->{ERRSTR}='';
    bless $self,$class;
    return $self;
}

Infix2Postfix.pm  view on Meta::CPAN

  @func=@{$self->{'func'}};
  @func{@func}=1..@func;
  @ops=@{$self->{'ops'}};

#    print Dumper(\%func);
#    print "elist: ",join(" ",map { "$_" } @_ ),"\n";

#    the only single elements should be numbers or vars 

  if ($#_ == 0) {
    if ( $_[0] =~ m/^($numre|$varre)$/ ) {

 view release on metacpan or  search on metacpan

builder/Affix.pm  view on Meta::CPAN

        # https://dyncall.org/r1.2/dyncall-1.2-windows-10-arm64-r.zip
        if ( $opt{config}->get('osname') eq 'MSWin32' ) {    # Use prebuilt libs on Windows
            my $x64  = $opt{config}->get('ptrsize') == 8;
            my $plat = $x64 ? '64' : '86';
            my %versions;
            for my $url ( map { 'https://dyncall.org/' . $_ }
                $response->{content}
                =~ m[href="(.+/dyncall-\d\.\d+\-windows-xp-x${plat}(?:-r)?\.zip)"]g ) {
                my ($version) = $url =~ m[-(\d+\.\d+)-windows];
                $versions{$version} = $url;
            }

builder/Affix.pm  view on Meta::CPAN

                    unless $response->{success};
            }
        }
        else {    # Build from source on all other platforms
            my %versions;
            for my $url ( map { 'https://dyncall.org/' . $_ }
                $response->{content} =~ m[href="(.+/dyncall-\d\.\d+\.tar\.gz)"]g ) {
                my ($version) = $url =~ m[/r(\d\.\d+)/];
                $versions{$version} = $url;
            }
            for my $version ( reverse sort keys %versions ) {

builder/Affix.pm  view on Meta::CPAN

        my %opt = @_;
        for my $pl_file ( find( qr/\.PL$/, 'lib' ) ) {
            ( my $pm = $pl_file ) =~ s/\.PL$//;
            system $^X, $pl_file, $pm and die "$pl_file returned $?\n";
        }
        my %modules = map { $_ => catfile( 'blib', $_ ) } find( qr/\.p(?:m|od)$/, 'lib' );
        my %scripts = map { $_ => catfile( 'blib', $_ ) } find( qr//,             'script' );
        my %shared  = map {
            $_ => catfile( qw/blib lib auto share dist/, $opt{meta}->name, abs2rel( $_, 'share' ) )
        } find( qr//, 'share' );
        pm_to_blib( { %modules, %scripts, %shared }, catdir(qw/blib lib auto/) );
        make_executable($_) for values %scripts;
        mkpath( catdir(qw/blib arch/), $opt{verbose} );

builder/Affix.pm  view on Meta::CPAN

        require TAP::Harness::Env;
        my %test_args = (
            ( verbosity => $opt{verbose} ) x !!exists $opt{verbose},
            ( jobs  => $opt{jobs} ) x !!exists $opt{jobs},
            ( color => 1 ) x !!-t STDOUT,
            lib => [ map { rel2abs( catdir( qw/blib/, $_ ) ) } qw/arch lib/ ],
        );
        my $tester = TAP::Harness::Env->create( \%test_args );
        return $tester->runtests( sort +find( qr/\.t$/, 't' ) )->has_errors;
    },
    install => sub {
        my %opt = @_;
        die "Must run `./Build build` first\n" if not -d 'blib';
        install( $opt{install_paths}->install_map, @opt{qw/verbose dry_run uninst/} );
        return 0;
    },
    clean => sub {
        my %opt = @_;
        rmtree( $_, $opt{verbose} ) for qw/blib temp/;

 view release on metacpan or  search on metacpan

lib/Agent/TCLI/Command.pm  view on Meta::CPAN

	my @aliases;
	if ( ref( $context_hash_key ) =~ /ARRAY/ )
	{
		# There is a list of aliases to add.
		push( @aliases ,  @{$context_hash_key} );
#		%aliases = map { $_ => $self }  @{$context_hash_key} };
	}
	elsif ( ref( $context_hash_key ) =~ /HASH/ )
	{
		# There are context shifts to add.
		foreach my $key (keys %{$context_hash_key} )
		{
			push( @aliases , $key  ) unless ( $key =~ qr(\*U) );
		}
#		%aliases = map { $_ => $self }  keys %{$context_hash_key};
	}
	else
	{
		# There is a single alias to add.
		push( @aliases , $context_hash_key );

 view release on metacpan or  search on metacpan

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

# matches "...", qr/.../ => sub {...}, ...
#
sub matches($@) {
	my $s = shift;
	my $i = 0;
	my $re = join "\n| ", map { $i++ % 2 == 0? "(?<I$i> $_ )": () } @_;
	my $arg = \@_;
	my $fn = sub {
		for my $k (keys %+) {
			return $arg->[$k]->() if do { $k =~ /^I(\d+)\z/ and $k = $1 }
		}

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

}

# Упрощённый язык регулярок
sub nous($) {
	my ($templates) = @_;
	my $x = join "|", map {
		matches $_,
		# Срезаем все пробелы с конца:
		qr!\s*$! => sub {},
		# Срезаем все начальные строки:
		qr!^([ \t]*\n)*! => sub {},

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

	$s
}

# Использованы символы из кодировки cp1251, что нужно для корректной записи в таблицы
our $CIF = join "", "0".."9", "A".."Z", "a".."z", "_-", # 64 символа для 64-ричной системы счисления
	(map chr, ord "А" .. ord "Я"), "ЁЂЃЉЊЌЋЏЎЈҐЄЇІЅ",
	(map chr, ord "а" .. ord "я"), "ёђѓљњќћџўјґєїіѕ",
	"‚„…†‡€‰‹‘’“”•–—™›¤¦§©«¬­®°±µ¶·№»",	do { no utf8; chr 0xa0 }, # небуквенные символы из cp1251
	"!\"#\$%&'()*+,./:;<=>?\@[\\]^`{|}~", # символы пунктуации ASCII
	" ", # пробел
	(map chr, 0 .. 0x1F, 0x7F), # управляющие символы ASCII
	# символ 152 (0x98) в cp1251 отсутствует.
;
# Переводит натуральное число в заданную систему счисления
sub to_radix($;$) {
	use bigint;

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

=head2 to_str (;$scalar)

Converts to string perl without interpolation.

	to_str "a'\n" # => 'a\\'\n'
	[map to_str, "a'\n"] # --> ["'a\\'\n'"]

=head2 from_str (;$one_quote_str)

Converts from string perl without interpolation.

	from_str "'a\\'\n'"  # => a'\n
	[map from_str, "'a\\'\n'"]  # --> ["a'\n"]

=head1 SUBROUTINES/METHODS

=head1 AUTHOR

 view release on metacpan or  search on metacpan

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

sub _join(@) {
	my ($match, @format) = @_;
	my $fs = _fs;
	my $trans = $fs->{before_split} // sub {$_[0]};
	my %f = _match $match, $fs;
	join "", List::Util::pairmap {
		my @keys = ref $a? @$a: $a;
		my $is = List::Util::first {defined $f{$_}} @keys;
		defined $is? do {
			my ($if, $format) = ref $b? @$b: (undef, $b);
			
			my @val = map $trans->($f{$_}), @keys;
			defined $if && $val[0] eq $if? $if:
				$format !~ /%s/? $format:
					sprintf($format, @val)
		}: () 
	} @format

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

	},
	
);

# Инициализация по имени
%FS = map {
	$_->{symdirquote} = quotemeta $_->{symdir};
	$_->{symextquote} = quotemeta $_->{symext};
	
	my @S;
	while($_->{regexp} =~ m{

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

			} if defined $group;
		}
	}
	
	my $x = $_;
	ref $_->{name}? (map { ($_ => $x) } @{$_->{name}}): ($_->{name} => $_)
} @FS;

sub _fs() { $FS{lc $^O} // $FS{unix} }

# Мы находимся в ОС семейства UNIX

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

	($path) = @$path if ref $path;
	
	$path = $fs->{before_split}->($path) if exists $fs->{before_split};
	
	+{
		$path =~ $fs->{regexp}? (map { $_ ne "ext" && $+{$_} eq ""? (): ($_ => $+{$_}) } keys %+): (error => 1),
		path => $path,
	}
}

# Переводит путь из формата одной ОС в другую

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

	\%sta
}

# Файловые фильтры
sub _filters(@) {
	map {
		if(ref $_ eq "CODE") {$_}
		elsif(ref $_ eq "Regexp") { my $re = $_; sub { $_ =~ $re } }
		elsif(/^-([a-z]+)$/) {
			eval join "", "sub { ", (join " && ", map "-$_()", split //, $1), " }"
		}
		else { my $re = wildcard(); sub { $_ =~ $re } }
	} @_
}

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

	lay mkpath "hello/big/world.txt", "hellow!";
	lay mkpath "hello/small/world.txt", "noenter";
	
	mtime "hello"  # ~> ^\d+(\.\d+)?$
	
	[map cat, grep -f, find ["hello/big", "hello/small"]]  # --> [qw/ hellow! noenter /]
	
	my @noreplaced = replace { s/h/$a $b H/ }
	    find "hello", "-f", "*.txt", qr/\.txt$/, sub { /\.txt$/ },
	        noenter "*small*",
	            errorenter { warn "find $_: $!" };

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

=item * L<AudioFile::Find> — ищет аудиофайлы в указанной директории. Позволяет фильтровать их по атрибутам: названию, артисту, жанру, альбому и трэкÑ...

=item * L<Directory::Iterator> — C<< $it = Directory::Iterator-E<gt>new($dir, %opts); push @paths, $_ while E<lt>$itE<gt> >>.

=item * L<IO::All> — C<< @paths = map { "$_" } grep { -f $_ && $_-E<gt>size E<gt> 10*1024 } io(".")-E<gt>all(0) >>.

=item * L<IO::All::Rule> — C<< $next = IO::All::Rule-E<gt>new-E<gt>file-E<gt>size("E<gt>10k")-E<gt>iter($dir1, $dir2); push @paths, "$f" while $f = $next-E<gt>() >>.

=item * L<File::Find> — C<find( sub { push @paths, $File::Find::name if /\.png/ }, $dir )>.

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

=item * L<File::Find::Age> — сортирует файлы по времени модификации (наследует L<File::Find::Rule>): C<< File::Find::Age-E<gt>in($dir1, $dir2) >>.

=item * L<File::Find::Declare> — C<< @paths = File::Find::Declare-E<gt>new({ size =E<gt> 'E<gt>10K', perms =E<gt> 'wr-wr-wr-', modified =E<gt> 'E<lt>2010-01-30', recurse =E<gt> 1, dirs =E<gt> [$dir1] })-E<gt>find >>.

=item * L<File::Find::Iterator> — имеет ООП интерфейс с итератором и функции C<imap> и C<igrep>.

=item * L<File::Find::Match> — вызывает обработчик на каждый подошедший фильтр. Похож на C<switch>.

=item * L<File::Find::Node> — обходит иерархию файлов параллельно несколькими процессами: C<< tie @paths, IPC::Shareable, { key =E<gt> "GLUE STRING", create =E<gt> 1 }; File::Find::Node-E<gt>new(...

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

=item * L<File::Hotfolder> — C<< watch( $dir, callback =E<gt> sub { push @paths, shift } )-E<gt>loop >>. Работает на C<AnyEvent>. Настраиваемый. Есть распараллеливание на несколько процес...

=item * L<File::Mirror> — формирует так же параллельный путь для копирования файлов: C<recursive { my ($src, $dst) = @_; push @paths, $src } '/path/A', '/path/B'>.

=item * L<File::Set> — C<< $fs = File::Set-E<gt>new; $fs-E<gt>add($dir); @paths = map { $_-E<gt>[0] } $fs-E<gt>get_path_list >>.

=item * L<File::Wildcard> — C<< $fw = File::Wildcard-E<gt>new(exclude =E<gt> qr/.svn/, case_insensitive =E<gt> 1, sort =E<gt> 1, path =E<gt> "src///*.cpp", match =E<gt> qr(^src/(.*?)\.cpp$), derive =E<gt> ['src/$1.o','src/$1.hpp']); push @paths, $f...

=item * L<File::Wildcard::Find> — C<findbegin($dir); push @paths, $f while $f = findnext()> или  C<findbegin($dir); @paths = findall()>.

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

	use lib "lib";
	include("A")->new               # ~> A=HASH\(0x\w+\)
	[map include, qw/A N/]          # --> [qw/A N/]
	{ local $_="N"; include->ex }   # -> 123

=head2 catonce (;$file)

Считывает файл в первый раз. Любая последующая попытка считать этот файл возвращает C<undef>. Используется для вставки модулей js и css в резул...

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

=head2 from_pkg (;$pkg)

Переводит пакет в путь ФС. Без параметра использует C<$_>.

	from_pkg "Aion::Fs"  # => Aion/Fs.pm
	[map from_pkg, "Aion::Fs", "A::B::C"]  # --> ["Aion/Fs.pm", "A/B/C.pm"]

=head2 to_pkg (;$path)

Переводит путь из ФС в пакет. Без параметра использует C<$_>.

	to_pkg "Aion/Fs.pm"  # => Aion::Fs
	[map to_pkg, "Aion/Fs.md", "A/B/C.md"]  # --> ["Aion::Fs", "A::B::C"]

=head1 AUTHOR

Yaroslav O. Kosmina L<mailto:dart@cpan.org>

 view release on metacpan or  search on metacpan

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

	push @DEBUG, $msg;
	print STDERR $msg, "\n" if DEBUG;
}

# sub debug_html {
# 	join "", map { ("<p class='debug'>", to_html($_), "</p>\n") } @DEBUG;
# }

# sub debug_text {
# 	return "" if !@DEBUG;
# 	join "", map { "$_\n\n" } @DEBUG, "";
# }

# sub debug_array {
# 	return if !@DEBUG;
# 	$_[0]->{SQL_DEBUG} = \@DEBUG;

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

	my $k = @_ == 0? $_: $_[0];
	my $ref;

	!defined($k)? "NULL":
	ref $k eq "ARRAY" && ref $k->[0] eq "ARRAY"?
		join(", ", map { join "", "(", join(", ", map quote, @$_), ")" } @$k):
	ref $k eq "ARRAY"? join("", join(", ", map quote, @$k)):
	ref $k eq "HASH"?
		join(", ", map { join "", $_, " = ", quote $k->{$_} } sort keys %$k):
	ref $k eq "REF" && ref $$k eq "ARRAY"?
		join(" ", List::Util::pairmap { join " ", "WHEN", quote $a, "THEN", quote $b } @$$k):
	ref $k eq "SCALAR"? $$k:
	Scalar::Util::blessed $k ? $k:
	ref $k ne ""? die "Something strange: `$k`":
	$k =~ /^-?(?:0|[1-9]\d*)(\.\d+)?\z/a
		&& ($ref = ref B::svref_2object(@_ == 0? \$_: \$_[0])

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

}

sub _set_type {
	my ($type, $x) = @_;
	if(ref $x eq "ARRAY") {
		[map _set_type($type, $_), @$x]
	}
	elsif(ref $x eq "HASH") {
		+{ map ($_ => _set_type($type, $type->{$_})), keys %$x }
	}
	elsif(ref $type eq "SCALAR") {
		\_set_type($type, $$x);
	}
	elsif($type eq "^") {

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

		| (?<param> : [~\.^]? [a-z_]\w*)
	!
		exists $+{if}? ($param{$+{if}}? $+{sep} . _set_params($+{code}, \%param): ""):
		exists $+{for}? do {
			my ($sep, $param, $code) = @+{qw/sep for code/};
			join "\n", map { local $param{'_'} = $_; _set_params("$sep$code", \%param) } @{$param{$param}}
		}:
		_set_params($+{param}, \%param)
	!imgex;
	$query
}

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

	$res
}

sub query_ref(@) {
	my ($query, %kw) = @_;
	my $map = delete $kw{MAP};
	$query = query_prepare($query, %kw) if @_>1;
	my $res = query_do($query);
	if($map && ref $res eq "ARRAY") {
		eval "require $map" or die unless UNIVERSAL::can($map, "new");
		[map { $map->new(%$_) } @$res]
	} else {
		$res
	}
}

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

			push @{$x{$k}}, $_;
		}
		@x
	}
	elsif(ref $val eq "HASH") {
		map { $_->{$key} => $_ } @$rows
	}
	elsif(ref $val eq "ARRAY") {
		if(@$val) {
			my $col = $val->[0];
			my %x;

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

			push @{$x{$_->{$key}}}, $_ for @$rows;
			%x
		}
	}
	else {
		map { $_->{$key} => $_->{$val} } @$rows
	}
}

# Подсоединить в результат запроса результат другого запроса
# 

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

sub query_attach {
	my ($rows, $attach, $query, %kw) = @_;
	
	($attach, my $key1, my $key2) = split /:/, $attach;

	my %row1 = map { $_->{$attach} = []; ($_->{$key1} => $_) } @$rows;

	my $rows2 = query $query, %kw;

	for my $row2 (@$rows2) {
		my $id = $row2->{$key2} // die "Not $key2 in query!";

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

	return [query_col @_] if !wantarray;

	my $rows = query_ref(@_);
	die "Only one column is acceptable!" if @$rows and 1 != keys %{$rows->[0]};

	map { my ($k, $v) = %$_; $v } @$rows
}

# Выбрать строку
#
#   query_row_ref "SELECT id, word FROM word WHERE word = 1" 	-> 	{id=>1, word=>"серебро"}

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

	return query_row_ref(@_) unless wantarray;
	my $sql = query_prepare(@_);
	my $rows  = query_do($sql, my $columns);
	die "A few lines!" if @$rows > 1;
	my $row = $rows->[0];
	map $row->{$_}, @$columns
}

# Выбрать значение
#
#   query_scalar "SELECT word FROM word WHERE id = 1" 	-> 	"золото"

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

sub make_query_for_order(@) {
	my ($order, $next) = @_;

	my @orders = split /\s*,\s*/, $order;
	my @order_direct;
	my @order_sel = map { my $x=$_; push @order_direct, $x=~s/\s+(asc|desc)\s*$//ie ? lc $1: "asc"; $x } @orders;

	my $select = @order_sel==1? $order_sel[0]: 
		_check_drv($base, "mysql|mariadb")? 
			join("", "concat(", join(",',',", @order_sel), ")"):
			join " || ',' || ", @order_sel

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

	return $select, 1 if $next eq "";

	my @next = split /,/, $next;
	$next[$#orders] //= "";
	@next = map quote($_), @next;
	my @op = map { /^a/ ? ">": "<" } @order_direct;

	# id -> id >= next[0]
	# id, update -> id > next[0] OR id = next[0] and
	my @whr;
	for(my $i=0; $i<@orders; $i++) {

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

				push @opr, "$order_sel[$j] $op[$j]= $next[$j]";
			}
		}
		push @whr, join " AND ", @opr;
	}
	my $where = join "\nOR ", map "$_", @whr;

	return $select, "($where)", \@order_sel;
}

# Устанавливает или возвращает ключ из таблицы settings

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

	my $tab = shift; my %row = @_;

	my $pk = delete($row{'-pk'}) // "id";
	my $fields = ref $pk? join(", ", @$pk): $pk;

	my $where = join " AND ", map { my $v = $row{$_}; defined($v)? "$_ = ${\ quote($v) }": "$_ is NULL" } sort keys %row;
	my $query = "SELECT $fields FROM $tab WHERE $where LIMIT 2";

	my $v = query_row($query);

	ref $pk? $v: $v->{$pk}

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

	my ($ignore, $insert) = delete @opt{qw/ignore insert/};
	die "Keys ${\ join('', )}" if keys %opt;



	my @keys = sort keys %{+{map %$_, @$rows}};
	die "No fields in bean $tab!" if !@keys;

	my $fields = join ", ", @keys;

	my $values = join ",\n", map { my $row = $_; join "", "(", quote([map $row->{$_}, @keys]), ")" } @$rows;

	if($insert) {
		my $query = "INSERT INTO $tab ($fields) VALUES $values";
		query_do($query);
	}

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

		if($ignore) {
			my $query = "INSERT IGNORE INTO $tab ($fields) VALUES $values";
			query_do($query);
		}
		else {
			my $fupdate = join ", ", map "$_ = values($_)", @keys;
			my $query = "INSERT INTO $tab ($fields) VALUES $values ON DUPLICATE KEY UPDATE $fupdate";
			query_do($query);
		}
	}
	elsif(_check_drv($base, 'Pg|sqlite')) {
		if($ignore) {
			my $query = "INSERT INTO $tab ($fields) VALUES $values ON CONFLICT DO NOTHING";
			query_do($query);
		} else {
			my $fupdate = join ", ", map "$_ = excluded.$_", @keys;
			my $query = "INSERT INTO $tab ($fields) VALUES $values ON CONFLICT DO UPDATE SET $fupdate";
			query_do($query);
		}
	}
	else {

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

	quote \[2=>'Pushkin A.', 1=>'Pushkin A.S.']  # => WHEN 2 THEN 'Pushkin A.' WHEN 1 THEN 'Pushkin A.S.'
	
	# use for UPDATE SET :x or INSERT SET :x
	quote {name => 'A.S.', id => 12}   # => id = 12, name = 'A.S.'
	
	[map quote, -6, "-6", 1.5, "1.5"] # --> [-6, "'-6'", 1.5, "'1.5'"]
	

=head2 query_prepare ($query, %param)

Replaces the parameters (C<%param>) in a query (C<$query>) and returns it. Parameters are enclosed in quotes via the C<quote> routine.

 view release on metacpan or  search on metacpan

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

no strict; no warnings; no diagnostics;
use common::sense;

our $VERSION = "0.0.3";

use List::Util qw/pairmap/;
use LWP::UserAgent qw//;
use HTTP::Cookies qw//;
use Aion::Format::Json qw//;
use Aion::Format::Url qw//;

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

		die $ok->{description} if !$ok->{ok};

		my $result = $ok->{result};
		return \@updates if !@$result;

		push @updates, map $_->{message}, grep $_->{message}, @$result;

		$offset = $result->[$#$result]{update_id} + 1;
	}
}

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

	head "http://example/not-found"     # -> ""
	
	surf HEAD => "http://example/ex"    # -> 1
	surf HEAD => "http://example/not-found"  # -> ""
	
	[map { surf $_ => "http://example/ex" } qw/GET HEAD POST PUT PATCH DELETE/] # --> [qw/get 1 post put patch delete/]
	
	patch "http://example/json" # --> {a => 10}
	
	[map patch, qw! http://example/ex http://example/json !]  # --> ["patch", {a => 10}]
	
	get ["http://example/ex", headers => {Accept => "*/*"}]  # => get
	surf "http://example/ex", headers => [Accept => "*/*"]   # => get

=head1 DESCRIPTION

 view release on metacpan or  search on metacpan

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

	my ($clean) = @_;
	my @v = values %REFMARK;

	%REFMARK = (), undef $REFMARK_LAST_TIME if $clean;

	my $total = sum map $_->{interval}, @v;
	$_->{percent} = ($_->{interval} / $total) * 100 for @v;
	@v = sort {$b->{percent} <=> $a->{percent}} @v;

	return \@v, $total if wantarray;

	join "",
	"Ref Report -- Total time: ${\ sinterval $total }\n",
	sprintf("%8s  %12s  %6s  %s\n", "Count", "Time", "Percent", "Interval"),
	"----------------------------------------------\n",
	map sprintf("%8s  %12s  %6.2f%%  %s\n",
		$_->{count},
		sinterval $_->{interval},
		$_->{percent},
		$_->{mark},
	), @v;

 view release on metacpan or  search on metacpan

lib/Aion.pm  view on Meta::CPAN

# конструктор
sub new {
	my ($self, @errors) = create_from_params(@_);

	die join "", "has:\n\n", map "* $_\n", @errors if @errors;

	$self
}

# Устанавливает свойства и выдаёт объект и ошибки

lib/Aion.pm  view on Meta::CPAN

	
	use Aion -role;
	
	sub valsify {
	    my ($self) = @_;
	    join ", ", map $self->{$_}, sort keys %$self;
	}
	
	1;

File lib/Class/All/Stringify.pm:

lib/Aion.pm  view on Meta::CPAN

=over

=item * Set C<%param> to features.

=item * Check if param not mapped to feature.

=item * Set default values.

=back

 view release on metacpan or  search on metacpan

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

}

sub _canonicalize_headers {
    my ($self, $r) = @_;
    return join("\t", 
        map {
            my $header_name = lc($_);
            my $header_val = $r->header($_);
            $header_val =~ s/^\s+//g;
            $header_val =~ s/\s+$//g;
            $header_val =~ s/\s+/ /g;

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

        ['client_token' => $self->{client_token}],
        ['access_token' => $self->{access_token}],
        ['timestamp' => $timestamp],
        ['nonce' => $nonce]
    );
    my $auth_header = "EG1-HMAC-SHA256 " . join(';', map {
            my ($k,$v) = @$_;
            "$k=$v";
        } @kvps) . ';';

    $self->_debug("unsigned authorization header: $auth_header");

 view release on metacpan or  search on metacpan

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

}

sub canonicalize_headers {
    my $self = shift;
    my $sign_headers = $self->signed_headers || {};
    return(join("\t", map {
        my $header = lc($_);
        my $value  = $sign_headers->{$_};

        # trim leading and trailing whitespaces
        $value =~ s{^\s+}{};

 view release on metacpan or  search on metacpan

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

# Endpoint to retrieve contract IDs
my $contracts_endpoint = "$baseurl/papi/v1/contracts";
my $contracts_resp = $agent->get($contracts_endpoint);
die "Error retrieving contract ID: " . $contracts_resp->status_line unless $contracts_resp->is_success;
my $contracts_data = decode_json($contracts_resp->decoded_content);
my @contract_ids = map { $_->{contractId} } @{ $contracts_data->{contracts}->{items} };

# Endpoint to retrieve group IDs
my $groups_endpoint = "$baseurl/papi/v1/groups";
my $groups_resp = $agent->get($groups_endpoint);
die "Error retrieving group ID: " . $groups_resp->status_line unless $groups_resp->is_success;
my $groups_data = decode_json($groups_resp->decoded_content);
my @group_ids = map { $_->{groupId} } @{ $groups_data->{groups}->{items} };

# Process all combinations of contract IDs and group IDs
foreach my $contract_id (@contract_ids) {
    foreach my $group_id (@group_ids) {
        my $properties_endpoint = "$baseurl/papi/v1/properties?contractId=$contract_id&groupId=$group_id";

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

   PREREQ_PM	=> { 'Getopt::Long' => 2.1,
		     'Image::Info' => 1.16,
		     'Image::Magick' => 6,
		     'File::Spec' => 0,
		   },
   EXE_FILES    => [ map { "script/$_" } @scripts ],
 );

sub checkexec {
    my ($exec) = @_;
    my $path = findbin($exec);