Result:
found more than 432 distributions - search limited to the first 2001 files matching your query
( run in 1.120 )
ARGV-Struct
view release on metacpan or search on metacpan
lib/ARGV/Struct.pm view on Meta::CPAN
1;
#################### main pod documentation begin ###################
=head1 NAME
ARGV::Struct - Parse complex data structures passed in ARGV
=head1 SYNOPSIS
use ARGV::Struct;
my $struct = ARGV::Struct->new->parse;
lib/ARGV/Struct.pm view on Meta::CPAN
Have you ever felt that you need something different than Getopt?
Are you tired of shoehorning Getopt style arguments into your commandline scripts?
Are you trying to express complex datastructures via command line?
then ARGV::Struct is for you!
It's designed so the users of your command line utilities won't hate you when things
get complex.
=head1 THE PAIN
I've had to use some command-line utilities that had to do creative stuff to transmit
deeply nested arguments, or datastructure-like information. Here are some strategies that
I've found over time:
=head2 Complex arguments codified as JSON
JSON is horrible for the command line because you have to escape the quotes. It's a nightmare.
lib/ARGV/Struct.pm view on Meta::CPAN
command --key key1 --value value1 --key key1 --value value 2
=head1 THE DESIGN
The design of this module is aimed at "playing well with the shell". The main purpose is
to let the user transmit complex data structures, while staying compact enough for command line
use.
=head2 Key/Value sets (objects)
On the command line, the user can transmit sets of key/value pairs within curly brackets
lib/ARGV/Struct.pm view on Meta::CPAN
Return an instance of the parser. If argv is not specified, @ARGV will be
used.
=head2 parse
return the parsed data structure
=head1 STATUS
This module is quite experimental. I developed it while developing Paws (a
Perl AWS SDK). It has a commandline utility that needs to recollect all the
ARGV-readonly
view release on metacpan or search on metacpan
Makefile.PL
MANIFEST
README
t/ARGV-readonly.t
lib/ARGV/readonly.pm
META.yml Module meta-data (added by MakeMaker)
ARS-Simple
view release on metacpan or search on metacpan
examples/generate_fid_hash.pl view on Meta::CPAN
#----------
my $sql = qq{select
f.fieldName,
f.fieldID,
decode(FOption, 1, 'Required ', 2, 'Optional ', 3, 'System RO', '*Unknown*'),
decode(datatype, 0, 'AR_DATA_TYPE_NULL', 1, 'AR_DATA_TYPE_KEYWORD', 2, 'AR_DATA_TYPE_INTEGER', 3, 'AR_DATA_TYPE_REAL', 4, 'AR_DATA_TYPE_CHAR', 5, 'AR_DATA_TYPE_DIARY', 6, 'AR_DATA_TYPE_ENUM', 7, 'AR_DATA_TYPE_TIME', 8, 'AR_DATA_TYPE_BITMASK', 9, 'AR_...
c.maxlength
from arschema a
join field f
on f.schemaid = a.schemaid and datatype < 30 and f.fieldID != 15
left outer join field_char c
on c.schemaid = f.schemaid and c.fieldid = f.fieldID
where a.name = '$form'
order by 1};
my $m = $ars->get_SQL({ sql => $sql });
### Sample data for 'User' form
# my $m = {
# numMatches => 30,
# rows => [
# [ 'CreateDate' , 3, 'System RO', 'AR_DATA_TYPE_TIME', undef ],
# [ 'LastModifiedBy' , 5, 'System RO', 'AR_DATA_TYPE_CHAR', 254 ],
examples/generate_fid_hash.pl view on Meta::CPAN
# };
unless ($m && $m->{numMatches})
{
print "No data returned, quitting\n";
exit;
}
# Check size and replace spaces with '_', you could also remove them!
my $max_len = 0;
examples/generate_fid_hash.pl view on Meta::CPAN
$fid_hash .= sprintf(" '%s'%s=> %10d,\t\t# %s type=%s %d\n", $row->[0], ' ' x ($max_len + 1 - length($row->[0])), $row->[1], $row->[2], $row->[3], $row->[4]);
}
$fid_hash .= " );\n";
$CLIP->Set($fid_hash);
print "$fid_hash\nFormatted data copied to clipboard\n";
ARSObject
view release on metacpan or search on metacpan
lib/ARSObject.pm view on Meta::CPAN
,-schgen => 1 # 1 - use vfname('meta') for '-meta', generate it from ARS if not exists.
# 2 - renewable 'meta' smartly
# 3 - renew meta always
# [schema,...] - list to renew
,-schfdo => 0 # Include display only fields into schema (AR_FIELD_OPTION_DISPLAY)
,-meta => {} # Forms metadata from ARS:
# {formName}->{-fields}->{fieldName}=>{}
# {formName}->{-fldids}->{fieldId}=>{}
# Additional parameters may be:
# ,'fieldLbl' =>label
# ,'fieldLbll'=>label localised
lib/ARSObject.pm view on Meta::CPAN
# ,strIn=>sub(self,form,{field},$_=val){}
# ,strOut=>sub(self,form,{field},$_=val){}
# },...}
,-maxRetrieve => 0 # ARS::ars_GetListEntry(maxRetrieve)
,-entryNo => undef # Logical number of entry inserted
,-strFields => 1 # Translate fields data using 'strIn'/'strOut'/'-meta'?
# 1 - 'enumLimits', 2 - 'fieldLbvl' before 'enumLimits'
,-cmd =>'' # Command running, for err messages, script local $s->{-cmd}
,-die =>undef # Error die/warn, 'Carp' or 'CGI::Carp...'
# ,-diemsg => undef #
,-warn=>undef # , see set() and connect() below
lib/ARSObject.pm view on Meta::CPAN
$v =~s/"/""/g;
$v =~/^\d+$/ ? $v : ('"' .$v .'"');
}
sub dsquot { # Quote data structure
$#_ <2 # (self, ?'=>', data struct)
? dsquot($_[0],'=> ',$_[1])
: !ref($_[2]) # (, hash delim, value) -> stringified
? strquot($_[0],$_[2])
: ref($_[2]) eq 'ARRAY'
? '[' .join(', ', map {dsquot(@_[0..1],$_)
lib/ARSObject.pm view on Meta::CPAN
} sort keys %{$_[2]}) .'}'
: strquot($_[0],$_[2])
}
sub dsquot1 { # Quote data structure, defined elements only
$#_ <2 # (self, ?'=>', data struct)
? dsquot1($_[0],'=> ',$_[1])
: !ref($_[2]) # (, hash delim, value) -> stringified
? strquot($_[0],$_[2])
: ref($_[2]) eq 'ARRAY'
? '[' .join(', ', map {defined($_) ? dsquot1(@_[0..1],$_) : ()
lib/ARSObject.pm view on Meta::CPAN
: strquot($_[0],$_[2])
}
sub dsdump { # Data structure dump to string
my ($s, $d) =@_; # (data structure) -> dump string
eval('use Data::Dumper');
my $o =Data::Dumper->new([$d]);
$o->Indent(1);
$o->Deepcopy(1);
$o->Dump();
}
sub dsparse { # Data structure dump string to perl structure
my ($s, $d) =@_; # (string) -> data structure
eval('use Safe; 1')
&& Safe->new()->reval($d)
}
sub dscmp { # Compare data structures
my($s, $ds1, $ds2) =@_;
return(1) if (defined($ds1) && !defined($ds2)) ||(defined($ds2) && !defined($ds1));
return(0) if !defined($ds1) && !defined($ds2);
return(1) if (ref($ds1) ||'') ne (ref($ds2) ||'');
return($ds1 cmp $ds2) if !ref($ds1);
lib/ARSObject.pm view on Meta::CPAN
$_[0]->{-vfbase} .($v =~/^-(.+)/ ? ($1 .($_[2] ||'.var')) : ($v .($_[2] ||'.var')))
}
sub vfstore { # Store variables file
# (varname, {data}) -> success
# (-slot) -> success
my($s,$n,$d)=@_;
$d =$s->{$n} if !$d && ($n =~/^-/);
my $f =$s->vfname($n, '.new');
my $r;
lib/ARSObject.pm view on Meta::CPAN
$r
}
sub vfload { # Load variables file
# (varname|-slot, ?{use default} | load default, ?renew | renew seconds) -> {data}
my($s,$f,$d,$nn) =@_; # -slot-calc, -slot-store
my $k =($f =~/^-/ ? $f : undef);
$f =$s->vfname($f);
if ($nn && $nn >1) {
my @st =stat($f);
lib/ARSObject.pm view on Meta::CPAN
vfload($s,$f,1,$nn ||1);
}
sub vfclear { # Clear vfdata() and vfhash()
my($s,$f) =@_; # (-slot, ?period seconds) -> vfload
return(1) if $f !~/^-/;
delete($s->{$f});
foreach my $k (keys %$s) {
next if $k !~/^\Q$f\E[\/].+/;
lib/ARSObject.pm view on Meta::CPAN
}
1;
}
sub vfdata { # Access to array data from variables file
# automatically load using vfload().
# (-slot) -> [array]
# (-slot, filter sub{}(self, -slot, index, $_=value)) -> [array]
vfload($_[0], $_[1], 1) if !$_[0]->{$_[1]} || (ref($_[0]->{$_[1]}) eq 'CODE');
if ($_[2]) {
if (ref($_[2]) eq 'CODE') {
local $_;
local $_[0]->{-cmd} =($_[0]->{-cmd} ? $_[0]->{-cmd} .': ' : '')
."vfdata('$_[1]', sub{})";
my ($rr, $v);
if (ref($_[0]->{$_[1]}) eq 'ARRAY') {
$rr =[];
for(my $i=0; $i<=$#{$_[0]->{$_[1]}}; $i++) {
if (!defined(eval{$v =&{$_[2]}($_[0], $_[1], $i, $_ =$_[0]->{$_[1]}->[$i])}) && $@) {
lib/ARSObject.pm view on Meta::CPAN
}
$_[0]->{$_[1]}
}
sub vfhash { # Access to hash of array data from variables file
# automatically formed in memory using vfdata().
# (-slot, key name) -> {hash from vfdata()}
# (-slot, key name => key value) -> {key=>value,...}
# (-slot, key name => key value => elem name ) -> elem value
# (-slot, key name => filter sub{}(self, -slot, key, $_ = value)) -> {key=>value,...}
my($s, $f, $k, $v, $e) =@_;
return(&{$s->{-die}}($s->efmt('Key name needed',undef,undef,'vfhash',$f))) if !$k;
lib/ARSObject.pm view on Meta::CPAN
: $s->{$kk}->{$v}
}
sub vfdistinct {# Distinct values from vfdata() field.
# (-slot, key name) -> [keys %{vfhash(...)}]
# (-slot, key name => filter sub{}(self, -slot, key, $_ = value)) -> [keys %{vfhash(...)}]
my($s, $f, $k, $v) =@_;
my(%rh, $t);
local $_;
lib/ARSObject.pm view on Meta::CPAN
$s->arsmeta();
$s
}
sub disconnect { # Disconnect data servers
my $s =shift;
$s->{-ctrl} && eval{ars_Logoff($s->{-ctrl})};
$s->{-ctrl}=undef;
$s->{-dbi} && eval{$s->{-dbi}->disconnect()};
$s->{-dbi} =undef;
}
sub arsmeta { # Load/refresh ARS metadata
my $s =shift; # -srv, -usr, -pswd, -lang
$s->set(@_);
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
.($s->{-schgen} ? "dumper('" .$s->vfname('meta') ."')" : 'arsmeta()');
if (ref($s->{-schgen})
lib/ARSObject.pm view on Meta::CPAN
my %ff =ARS::ars_GetFieldTable($s->{-ctrl}, $f);
!%ff && return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetFieldTable',$f)));
foreach my $ff (sort keys %ff) {
my $fm =ARS::ars_GetField($s->{-ctrl},$f,$ff{$ff})
|| return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetField',$f,$ff)));
# 'fieldId', 'fieldName', 'dataType'
next if !$fm->{dataType}
|| ($fm->{dataType} =~/^(trim|control|table|column|page)/);
next if !$s->{-schfdo} && $fm->{option} && ($fm->{option} == 4); # AR_FIELD_OPTION_DISPLAY
$s->{-meta}->{$f}->{-fields}->{$ff} =$fm;
$s->{-meta}->{$f}->{-fields}->{$ff}->{indexUnique} =$fm->{fieldId}
if $ix->{$fm->{fieldId}}
|| ($fm->{fieldId} eq '1'); # || '179'?
lib/ARSObject.pm view on Meta::CPAN
$s->vfload('-meta');
# print $s->cpcon($s->dsdump($s->{-meta})), "\n"; exit(0);
}
else {
$s->{-meta} ={};
return(&{$s->{-die}}($s->efmt('No metadata',$s->{-cmd})))
}
$s->arsmetaix() if $s->{-meta};
}
sub arsmetaix { # Index ARS metadata
my $s =shift;
if ($s->{-meta}) {
foreach my $f (keys %{$s->{-meta}}){
next if $f =~/^-/;
$s->{-meta}->{$f}->{-fldids} ={}
lib/ARSObject.pm view on Meta::CPAN
# print $s->cpcon($s->dsdump($s->{-metaid})), "\n"; exit(0);
}
}
sub arsmetamin { # Minimal ARS metadata ('-meta-min' varfile)
my $s =shift; # refresh after 'arsmeta'/'connect'
$s->set(@_); # load instead of 'arsmeta'/'connect'
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
.($s->{-schgen} ? "dumper('" .$s->vfname('meta-min') ."')" : 'arsmetamin()');
if (ref($s->{-schgen})
lib/ARSObject.pm view on Meta::CPAN
if (!$fvs) {
$s->{'-meta-min'} ={};
foreach my $f (keys %{$s->{-meta}}) {
foreach my $ff (keys %{$s->{-meta}->{$f}->{-fields}}) {
my $e =$s->{-meta}->{$f}->{-fields}->{$ff};
next if (!$e->{dataType}
|| ($e->{dataType} ne 'time'))
&& (!$e->{'limit'}
|| !$e->{'limit'}->{'enumLimits'}
|| !($e->{'limit'}->{'enumLimits'}->{'regularList'} ||$e->{'limit'}->{'enumLimits'}->{'customList'}));
$s->{'-meta-min'}->{$f} ={} if !$s->{'-meta-min'}->{$f};
$s->{'-meta-min'}->{$f}->{-fields} ={} if !$s->{'-meta-min'}->{$f}->{-fields};
lib/ARSObject.pm view on Meta::CPAN
delete $s->{'-meta-min'};
$s;
}
sub arsmetasql { # SQL ARS metadata ('-meta-sql' varfile)
my $s =shift; # refresh after 'arsmeta'/'connect'
$s->set(@_); # !!! 'enum' texts
local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
.($s->{-schgen} ? "dumper('" .$s->vfname('meta-sql') ."')" : 'arsmetasql()');
if (ref($s->{-schgen})
lib/ARSObject.pm view on Meta::CPAN
$s->{'-meta-sql'} ={} if !$s->{'-meta-sql'};
foreach my $f ($s->{-schema} ? @{$s->{-schema}} : sort keys %{$s->{-meta}}) {
$s->sqlname($f);
foreach my $ff (sort keys %{$s->{-meta}->{$f}->{-fields}}) {
$s->sqlname($f,$ff,1);
if ($s->{-meta}->{$f}->{-fields}->{$ff}->{dataType} eq 'enum') {
# $s->sqlname($f,'_str_' .$ff,1);
# $s->{'-meta-sql'}->{$s->sqlname($f)}->{-cols}->{$s->sqlname($f,'_str_' .$ff)}->{TYPE_NAME} ='varchar';
}
}
foreach my $ff ('_arsobject_insert', '_arsobject_update', '_arsobject_delete') {
lib/ARSObject.pm view on Meta::CPAN
}
if ($fu ||!$s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}) {
my $flh =$s->{-meta}->{$f}->{-fields}->{$ff}->{limit};
my $tch ={COLUMN_NAME => $tc
, 'fieldName'=>$ff
, 'dataType' => $ffh->{dataType}
, 'timestamp'=>$s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}
&& $s->{'-meta-sql'}->{$tn}->{-cols}->{$tc}->{'timestamp'}
|| time()
, $ffh && $ffh->{fieldId}
? ('fieldId' => $ffh->{fieldId})
: ()
, !$ffh ||!$ffh->{dataType}
? ()
: $ffh->{dataType} eq 'integer'
? (TYPE_NAME => 'int')
: $ffh->{dataType} eq 'real'
? (TYPE_NAME => 'float')
: $ffh->{dataType} eq 'decimal'
? (TYPE_NAME => $ffh->{dataType}
, $flh
? ($flh->{precision} ? (DECIMAL_DIGITS => $flh->{precision}) : ()
,$flh->{rangeHigh} ? (COLUMN_SIZE => length($flh->{rangeHigh})) : ()
)
: ()
)
: $ffh->{dataType} eq 'char'
&& (!$flh || !$flh->{maxLength} || ($flh->{maxLength} >255))
? (TYPE_NAME => 'text')
: 0 && ($ffh->{dataType} eq 'char') && $ffh->{indexUnique}
? (TYPE_NAME => 'char'
, $flh && $flh->{maxLength}
? (COLUMN_SIZE => $flh->{maxLength})
: ()
)
: $ffh->{dataType} eq 'char'
? (TYPE_NAME=>'varchar' # $ffh->{dataType}
, $flh && $flh->{maxLength}
? (COLUMN_SIZE => $flh->{maxLength})
: ()
)
: $ffh->{dataType} eq 'diary'
? (TYPE_NAME => 'text')
: $ffh->{dataType} eq 'time'
? (TYPE_NAME => 'datetime' # !'int'
#,COLUMN_SIZE=>19,DECIMAL_DIGITS=>0
)
: $ffh->{dataType} eq 'enum'
? (TYPE_NAME => 'int')
: ()
, $ffh && $ffh->{fieldId}
&& (($ffh->{fieldId} =~/^(?:1)$/) || $ffh->{indexUnique})
? (IS_PK => $ffh->{fieldId})
lib/ARSObject.pm view on Meta::CPAN
my($s,$f,$ff) =@_;
$ff =ref($ff) ? $ff
: !$s->{-meta} || !$s->{-meta}->{$f} ? return(undef)
: $ff =~/^\d+$/ ? $s->{-meta}->{$f}->{-fldids}->{$ff}
: $s->{-meta}->{$f}->{-fields}->{$ff};
if ($ff && !$ff->{-hashOut} && ($ff->{dataType} eq 'enum')) {
my $et =ref($ff->{'limit'}->{'enumLimits'}) eq 'ARRAY'
? $ff->{'limit'}->{'enumLimits'}
: exists $ff->{'limit'}->{'enumLimits'}->{'regularList'}
? $ff->{'limit'}->{'enumLimits'}->{'regularList'}
: exists $ff->{'limit'}->{'enumLimits'}->{'customList'}
lib/ARSObject.pm view on Meta::CPAN
my($s,$f,$ff) =@_;
$ff =ref($ff) ? $ff
: !$s->{-meta} || !$s->{-meta}->{$f} ? return(undef)
: $ff =~/^\d+$/ ? $s->{-meta}->{$f}->{-fldids}->{$ff}
: $s->{-meta}->{$f}->{-fields}->{$ff};
if ($ff && !$ff->{-listVals} && ($ff->{dataType} eq 'enum')) {
my $et =ref($ff->{'limit'}->{'enumLimits'}) eq 'ARRAY'
? $ff->{'limit'}->{'enumLimits'}
: exists $ff->{'limit'}->{'enumLimits'}->{'regularList'}
? $ff->{'limit'}->{'enumLimits'}->{'regularList'}
: exists $ff->{'limit'}->{'enumLimits'}->{'customList'}
lib/ARSObject.pm view on Meta::CPAN
}
else {
# return(&{$s->{-die}}($s->efmt('Could not transate value',$s->{-cmd},undef,'strOut',$f,$ff->{fieldName},$v)))
}
}
elsif ($ff->{dataType} eq 'enum') {
schlbls(@_);
$v =strOut(@_) if $ff->{-hashOut};
}
elsif ($ff->{dataType} eq 'time') {
$v =strtime($s,$v)
}
$v
}
lib/ARSObject.pm view on Meta::CPAN
}
else {
return(&{$s->{-die}}($s->efmt('Could not transate value',$s->{-cmd},undef,'strIn',$f,$ff->{fieldName},$v)))
}
}
elsif ($ff->{dataType} eq 'enum') {
my $et = ref($ff->{'limit'}->{'enumLimits'}) eq 'ARRAY'
? $ff->{'limit'}->{'enumLimits'}
: exists $ff->{'limit'}->{'enumLimits'}->{'regularList'}
? $ff->{'limit'}->{'enumLimits'}->{'regularList'}
: exists $ff->{'limit'}->{'enumLimits'}->{'customList'}
lib/ARSObject.pm view on Meta::CPAN
$et =undef
}
return(&{$s->{-die}}($s->efmt('Could not transate value',$s->{-cmd},undef,'strIn',$f,$ff->{fieldName},$v)))
if $et && ($v !~/^\d+$/);
}
elsif ($ff->{dataType} eq 'time') {
$v =timestr($s,$v);
}
$v
}
sub lsflds { # List fields from '-meta'
# (additional field options)
my ($s, @a) =@_;
@a =('fieldLblc') if !@a;
unshift @a, 'fieldName', 'fieldId', 'dataType', 'option', 'createMode';
map { my $f =$_;
$f =~/^-/
? ()
: map { my $ff =$s->{-meta}->{$f}->{-fields}->{$_};
join("\t", $f
lib/ARSObject.pm view on Meta::CPAN
my $q ='trim|control|table|column|page';
$q .= '|currency|attach' if $a{-fields} =~/^-\$/;
$q .= '|attach' if $a{-fields} =~/^-f/;
$a{-fields} =
[map { my $ff =$s->{-meta}->{$f}->{-fields}->{$_};
!$ff->{dataType} || !$ff->{fieldId}
|| ($ff->{dataType} =~/^($q)/)
|| ($ff->{fieldId} eq '15') # 'Status-History'
# ars_GetListEntryWithFields() -> [ERROR] (ORA-00904: "C15": invalid identifier) (ARERR #552)
|| (!$a{-xfields} ? 0 : ref($a{-xfields}) eq 'CODE' ? &{$a{-xfields}}($s, $ff) : grep {($_ eq $ff->{fieldId}) || ($_ eq $ff->{fieldName})} @{$a{-xfields}})
? ()
: ($ff->{fieldId})
lib/ARSObject.pm view on Meta::CPAN
}
sub entryBLOB { # BLOB field retrieve/update
# (-form=>form, -id=>entryId, -field=>fieldId|fieldName
# ,?-set=>data
# ,?-file=>filePath, ?-set=>boolean
my ($s, %a) =@_;
my $f =$a{-schema} ||$a{-form} ||$a{-from} ||$a{-into};
my $eu =!$a{-file} ? exists($a{-set}) : exists($a{-set}) ? $a{-set} : $a{-into};
if ($eu) {
lib/ARSObject.pm view on Meta::CPAN
return($_[0]->{-dbi}) if $_[0]->{-dbi};
dbiconnect(@_)
}
sub dbiconnect {# DBI connect to any database
# (-dbiconnect=>[]) -> dbi object
set(@_);
set($_[0],-die=>'Carp') if !$_[0]->{-die};
print $_[0]->cpcon("dbiconnect()\n")
if $_[0]->{-echo};
lib/ARSObject.pm view on Meta::CPAN
} 'COLUMN_SIZE', 'DECIMAL_DIGITS') .')'
: '')
}
sub dbidsmetasync { # DBI datastore - sync meta with 'arsmetasql'
my ($s, %arg) =@_; # (-echo)
return(undef) if !$s->{'-meta-sql'};
my $dbt ={map {!$_
? ()
: $_ =~/\."*([^."]+)"*$/
lib/ARSObject.pm view on Meta::CPAN
}
$s;
}
sub dbidsrpl { # DBI datastore - load data from ARS
my ($s, %arg) =@_;
$arg{-form} =$arg{-from} ||$arg{-schema} if !$arg{-form};
$arg{-query} =$arg{-where} ||$arg{-qual} if !$arg{-query};
$arg{-filter}=undef if !$arg{-filter};
$arg{-lim_rf}=300 if !$arg{-lim_rf};
lib/ARSObject.pm view on Meta::CPAN
|| !exists($r->{$f->{fieldName}});
$rw->{$f->{fieldName}} =!defined($r->{$f->{fieldName}})
? $r->{$f->{fieldName}}
: $f->{TYPE_NAME} eq 'datetime'
? strtime($s, $r->{$f->{fieldName}})
: ($f->{dataType} =~/^(?:char)$/) && $f->{COLUMN_SIZE}
? substr($r->{$f->{fieldName}}, 0, $f->{COLUMN_SIZE_DB} ||$f->{COLUMN_SIZE})
: $r->{$f->{fieldName}};
$rd->{$f->{COLUMN_NAME}} =$1
if $rd
&& defined($rd->{$f->{COLUMN_NAME}})
lib/ARSObject.pm view on Meta::CPAN
&& defined($rd->{$f->{COLUMN_NAME}})
&& ($f->{TYPE_NAME} eq 'float');
$rd->{$f->{COLUMN_NAME}} =substr($rd->{$f->{COLUMN_NAME}}, 0, $f->{COLUMN_SIZE_DB} ||$f->{COLUMN_SIZE})
if $rd
&& defined($rd->{$f->{COLUMN_NAME}})
&& ($f->{dataType} =~/^(?:char)$/) && $f->{COLUMN_SIZE};
$ru =1 if $rd
&& (defined($rd->{$f->{COLUMN_NAME}})
? !defined($rw->{$f->{fieldName}})
|| ($rd->{$f->{COLUMN_NAME}} ne $rw->{$f->{fieldName}})
: defined($rw->{$f->{fieldName}}));
lib/ARSObject.pm view on Meta::CPAN
join(', ', map {$_ ? $_ : ()} $ci && "new $ci", $cu && "upd $cu", $cd && "del $cd")
||'up-to-date'
}
sub dbidsquery { # DBI datastore - query data alike ARS
my ($s, %arg) =@_;
# -form => ARS form || -from => sql table name
# -fields=> ARS fields || -select=>sql select list
# -query=> ARS query || -where => sql where
# -order =>
lib/ARSObject.pm view on Meta::CPAN
: $m->{-cols}->{$_} && $m->{-cols}->{$_}->{fieldName} && $m->{-cols}->{$_}->{fieldId}
? ($m->{-cols}->{$_}->{fieldName}
=>
(!defined($r->{$_})
? $r->{$_}
: $ys && ($m->{-cols}->{$_}->{dataType} eq 'enum')
? $s->strOut($arg{-form}, $m->{-cols}->{$_}->{fieldId}, $r->{$_})
: ($m->{-cols}->{$_}->{TYPE_NAME} =~/^(?:datetime|float)$/) && ($r->{$_} =~/^(.+)\.0+$/)
? $1
: $r->{$_}))
: $yc
lib/ARSObject.pm view on Meta::CPAN
}
@r
}
sub dbidsqq { # DBI datastore - quote/parse condition to SQL names
my ($s,$sf,$mh) =@_; # (self, query string, default sql metadata)
if (0) {
my $q =substr($s->{-dbi}->quote_identifier(' '),0,1);
$sf =~s/$q([^$q]+)$q\.$q([^$q]+)$q/!$s->{'-meta-sql'}->{-forms}->{$1} ? "?1$q$1${q}.$q$2$q" : $s->{'-meta-sql'}->{$s->{'-meta-sql'}->{-forms}->{$1}}->{-fields}->{$2} ? $s->{-dbi}->quote_identifier($s->{'-meta-sql'}->{-forms}->{$1}) .'.' .$s->{-dbi}-...
$sf =~s/$q([^$q]+)$q/$s->{'-meta-sql'}->{-forms}->{$1} ? ($s->{-sqlschema} ? $s->{-dbi}->quote_identifier($s->{-sqlschema}) .'.' : '') .$s->{-dbi}->quote_identifier($s->{'-meta-sql'}->{-forms}->{$1}) : $mh->{-fields}->{$1} ? $s->{-dbi}->quote_identi...
return($sf);
lib/ARSObject.pm view on Meta::CPAN
}
sub smtpsend { # SMTP mail msg send
# -from||-sender, -to||-recipient,
# -data|| -subject + (-text || -html)
my ($s, %a) =@_;
return(&{$s->{-die}}("SMTP host not defined"))
if !$s->{-smtphost};
local $s->{-smtpdomain} =$s->{-smtpdomain}
|| ($s->{-smtphost} && $s->smtp(sub{$_[1]->domain()}))
lib/ARSObject.pm view on Meta::CPAN
$a{-recipient} =&{$a{-recipient}}($s,\%a) if ref($a{-recipient}) eq 'CODE';
$a{-recipient} =[grep {$_} split /\s*[,;]\s*/, ($a{-recipient} =~/^\s*(.*)\s*$/ ? $1 : $a{-recipient})]
if $a{-recipient} && ref($a{-recipient}) && ($a{-recipient} =~/[,;]/);
return(&{$s->{-die}}("SMTP e-mail recipients not defined"))
if !$a{-recipient};
if (!defined($a{-data})) {
my $koi =(($a{-charset}||$s->charset()||'') =~/1251/);
$a{-subject} = ref($a{-subject}) eq 'CODE'
? &{$a{-subject}}($s,\%a)
: 'ARSObject'
if ref($a{-subject}) ||!defined($a{-subject});
$a{-data} ='';
$a{-data} .='From: ' .($koi ? $s->cptran('ansi','koi',$a{-from})
: $a{-from})
."\cM\cJ";
$a{-data} .='Subject: '
.($koi
? $s->cptran('ansi','koi',$a{-subject})
: $a{-subject}) ."\cM\cJ";
$a{-data} .='To: '
.($koi
? $s->cptran('ansi','koi', ref($a{-to}) ? join(', ',@{$a{-to}}) : $a{-to})
: (ref($a{-to}) ? join(', ',@{$a{-to}}) : $a{-to}))
."\cM\cJ"
if $a{-to};
foreach my $k (keys %a) {
next if $k =~/^-(data|subject|html|text|from|to|sender|recipient)$/;
next if !defined($a{$k});
my $n =$k =~/^-(.+)/ ? ucfirst($1) .':' : $k;
$a{-data} .=$n .' ' .$a{$k} ."\cM\cJ";
}
$a{-data} .="MIME-Version: 1.0\cM\cJ";
$a{-data} .='Content-type: ' .($a{-html} ? 'text/html' : 'text/plain')
.'; charset=' .($a{-charset}||$s->charset())
."\cM\cJ";
$a{-data} .='Content-Transfer-Encoding: ' .($a{-encoding} ||'8bit') ."\cM\cJ";
$a{-data} .="\cM\cJ";
$a{-data} .=$a{-html} ||$a{-text} ||'';
}
local $^W=undef;
$s->smtp->mail($a{-sender} =~/<\s*([^<>]+)\s*>/ ? $1 : $a{-sender})
||return(&{$s->{-die}}("SMTP sender \'" .$a{-sender} ."' -> " .($s->smtp->message()||'?')));
$s->smtp->to(ref($a{-recipient})
? (map { !$_ ? () : /<\s*([^<>]+)\s*>/ ? $1 : $_ } @{$a{-recipient}})
: $a{-recipient}, {'SkipBad'=>1}) # , {'SkipBad'=>1}
|| return(&{$s->{-die}}("SMTP recipient \'"
.(ref($a{-recipient}) ? join(', ', (map { !$_ ? () : /<\s*([^<>]+)\s*>/ ? $1 : $_ } @{$a{-recipient}})) : $a{-recipient}) ."' -> " .($s->smtp->message()||'?')));
$s->smtp->data($a{-data})
||return(&{$s->{-die}}("SMTP data '" .$a{-data} ."' -> " .($s->smtp->message()||'?')));
my $r =$s->smtp->dataend()
||return(&{$s->{-die}}("SMTP dataend -> " .($s->smtp->message()||'?')));
$r ||1;
}
sub soon { # Periodical execution of this script
lib/ARSObject.pm view on Meta::CPAN
}
1
}
sub cfpinit { # Field Player: init data structures
my ($s) =@_; # (self) -> self
$s->{-fphc} ={};
$s->{-fphd} ={};
my $dh ={};
my $dp =undef;
lib/ARSObject.pm view on Meta::CPAN
my $fs =$f->{-vfname} ||$af->{-vfname};
my $fn =undef;
my $fv =undef;
if ($frk && $fs && ($fn =$frk->{-namedb}) && defined($fv=cfpv($s, $frk->{-master}))) {
$s->{-fpbv} =$f->{-namedb}
? $s->vfdata($fs, sub{defined($_->{$fn}) && ($_->{$fn} eq $fv)})
: [];
$r =shift @{$s->{-fpbv}} if $s->{-fpbv} && scalar(@{$s->{-fpbv}});
$r ={} if !$r;
}
elsif ($fs) {
lib/ARSObject.pm view on Meta::CPAN
elsif ($fn =cfpnd($s, cfpv($s, $af))) {
$fv =cfpv($s, $fn)
}
if ($fn && defined($fv)) {
$r =undef;
my $fa =$s->vfdata($fs);
foreach my $e (@$fa) {
next if !defined($e->{$fn}) || ($e->{$fn} ne $fv);
$r =$e;
last
}
lib/ARSObject.pm view on Meta::CPAN
}
elsif ($af->{-vfedit} || $f->{-vfedit}) {
my $fn =$f->{-namedb} ||$af->{-namedb};
my $ft =defined($f->{-vftran}) ? $f->{-vftran} : $af->{-vftran};
my $fv =cfpv($s, $f);
my $fa =$s->vfdata($fs);
push @$fa, {$f->{-namedb} ? ($f->{-namedb}=>$r) : ()
,map { &$ffc($s, $_) ||(exists($_->{-vfstore}) && !$_->{-vfstore})
? ()
: ($_->{-namedb} => &$fvu($s, $_, $ft))
} cfpused($s)};
lib/ARSObject.pm view on Meta::CPAN
}
elsif ($af->{-vfedit} || $f->{-vfedit}) {
my $fn =$f->{-namedb} ||$af->{-namedb};
my $ft =defined($f->{-vftran}) ? $f->{-vftran} : $af->{-vftran};
my $fv =cfpv($s, $f);
my $fa =$s->vfdata($fs);
foreach my $e (@$fa) {
next if !defined($e->{$fn}) || ($e->{$fn} ne $fv);
foreach my $f1 (cfpused($s)) {
next if &$ffc($s, $f1) ||(exists($f1->{-vfstore}) && !$f1->{-vfstore});
$e->{$f1->{-namedb}} =&$fvu($s, $f1, $ft);
lib/ARSObject.pm view on Meta::CPAN
eval{$s->vfclear($fs); $s->vfrenew($fs)}
}
elsif ($af->{-vfedit} || $f->{-vfedit}) {
my $fn =$f->{-namedb} ||$af->{-namedb};
my $fv =cfpv($s, $f);
my $fa =$s->vfdata($fs);
my ($i,$j) =(0, undef);
foreach my $e (@$fa) {
if (defined($e->{$fn}) && ($e->{$fn} eq $fv)) {
$j =$i;
last;
ARSperl
view release on metacpan or search on metacpan
}
if(0) {
while($#_) {
my ($f, $v) = (shift @_, shift @_);
my $fh = ars_GetField($c, $s, $f);
if(($fh->{'dataType'} eq "char") ||
($fh->{'dataType'} eq "diary")) {
$v = "\"$v\"";
}
}
}
print "walktree..\n";
ASNMTAP
view release on metacpan or search on metacpan
applications/archive.pl view on Meta::CPAN
GetOptions (
"A:s" => \$opt_A, "archivelist:s" => \$opt_A,
"c:s" => \$opt_c, "cgisess:s" => \$opt_c,
"r:s" => \$opt_r, "reports:s" => \$opt_r,
"d:s" => \$opt_d, "database:s" => \$opt_d,
"y:s" => \$opt_y, "yearsago:s" => \$opt_y,
"f:s" => \$opt_f, "force:s" => \$opt_f,
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
"D:s" => \$opt_D, "debug:s" => \$opt_D,
"V" => \$opt_V, "version" => \$opt_V,
applications/archive.pl view on Meta::CPAN
if ($opt_d) {
if ($opt_d eq 'F' || $opt_d eq 'T') {
$doDatabase = ($opt_d eq 'F') ? 0 : 1;
} else {
usage("Invalid database: $opt_d\n");
}
}
if ($opt_y) {
if ($opt_y eq 'c') {
applications/archive.pl view on Meta::CPAN
# Init parameters
my ($rv, $dbh, $sth, $sql, $year, $month, $day, $timeslot, $yearMOVE, $monthMOVE, $sqlMOVE, $sqlUPDATE);
$rv = 1;
$dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = errorTrapDBI("Cannot connect to the database", $debug);
if ($dbh and $rv) {
$year = get_year ($eventsAgo);
$month = get_month ($eventsAgo);
$day = get_day ($eventsAgo);
applications/archive.pl view on Meta::CPAN
my $sqlUPDATE = 'UPDATE ' .$SERVERTABLCOMMENTS. ' SET replicationStatus="U", problemSolved="1", solvedDate="' .$solvedDate. '", solvedTime="' .$solvedTime. '", solvedTimeslot="' .$solvedTimeslot. '" where catalogID="'. $CATALOGID. '" and problemS...
print "$sqlUPDATE\n" if ($debug);
$dbh->do ( $sqlUPDATE ) or $rv = errorTrapDBI("Cannot dbh->do: $sqlUPDATE", $debug) unless ( $debug );
$dbh->disconnect or $rv = errorTrapDBI("Sorry, the database was unable to add your entry.", $debug);
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub checkTableDBI {
my ($dbh, $database, $table, $op, $msg_type, $msg_text) = @_;
print "-> <$database.$table>, <$op>, <$msg_type>, <$msg_text>\n" if ($debug);
my ($Table, $Op, $Msg_type, $Msg_text) = '';
my $rv = 1;
my $sql = "check table $table";
applications/archive.pl view on Meta::CPAN
$Msg_text = $ref->{Msg_text};
print "<- <$Table>, <$Op>, <$Msg_type>, <$Msg_text>\n" if ($debug);
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
$rv = ($rv and "$database.$table" eq $Table and $op eq $Op and $msg_type eq $Msg_type and $msg_text eq $Msg_text) ? 1 : 0;
}
return ($rv);
}
applications/archive.pl view on Meta::CPAN
# Init parameters
my ($rv, $dbh, $sql, $year, $month);
$year = get_year ($daysBefore);
$rv = 1;
$dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = errorTrapDBI("Cannot connect to the database", $debug);
if ($dbh and $rv) {
foreach $month ('01'..'12') {
$sql = 'CREATE TABLE IF NOT EXISTS `'. $SERVERTABLEVENTS .'_'. $year .'_'. $month .'` LIKE `'. $SERVERTABLEVENTS .'`';
$rv = ! checkTableDBI ($dbh, $DATABASE, $SERVERTABLEVENTS .'_'. $year .'_'. $month, 'check', 'status', 'OK');
applications/archive.pl view on Meta::CPAN
}
} else {
print "Table: '$SERVERTABLCOMMENTS', Year: '$year', Status: ALREADY CREATED\n\n" if ($debug);
}
$dbh->disconnect or $rv = errorTrapDBI("Sorry, the database was unable to add your entry.", $debug);
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
applications/archive.pl view on Meta::CPAN
} elsif (! $doDatabase) {
# APE # TODO - REMOVE
# Init parameters
# my ($rv, $dbh, $sql);
# open connection to database and query data
# $rv = 1;
# $dbh = DBI->connect("dbi:mysql:$DATABASE:$SERVERNAMEREADWRITE:$SERVERPORTREADWRITE", "$SERVERUSERREADWRITE", "$SERVERPASSREADWRITE" ) or $rv = errorTrapDBI("Cannot connect to the database", $debug);
# if ($dbh and $rv) {
# $sql = "LOAD DATA LOW_PRIORITY LOCAL INFILE '$path/$filename' INTO TABLE $SERVERTABLEVENTS FIELDS TERMINATED BY ',' ENCLOSED BY '\"' LINES TERMINATED BY '\\n'";
# $dbh->do( $sql ) or $rv = errorTrapDBI("Cannot dbh->do: $sql", $debug);
applications/archive.pl view on Meta::CPAN
# print EMAILREPORT "S+ LOAD DATA ... WARNING for $filename: $mysqlInfo, <$records> <$deleted> <$skipped> <$warnings>\n";
# rename("$path/$filename", "$path/$filename-LOAD-DATA-FAILED");
# }
# }
# $dbh->disconnect or $rv = errorTrapDBI("Sorry, the database was unable to add your entry.", $debug);
# }
my $_debug = ( ( $debug eq 'T' ) ? 1 : 0);
my $dbh = CSV_prepare_table ("$path/", $filename, '', $SERVERTABLEVENTS, \@EVENTS, \%EVENTS, \$logger, $_debug);
my $rv = CSV_import_from_table (1, $dbh, $SERVERTABLEVENTS, \@EVENTS, 'id', $doForce, \$logger, $_debug);
applications/archive.pl view on Meta::CPAN
F(alse) : don't remove the cgisess files
T(true) : remove the cgisess files (default)
-r, --reports=F|T
F(alse) : don't backup Csv, Sql, Error, Week, Debug reports
T(true) : remove backup Csv, Sql, Error, Week, Debug reports (default)
-d, --database=F|T
F(alse) : don't archive the '$SERVERTABLEVENTS' and '$SERVERTABLCOMMENTS' tables (default)
T(true) : archive the '$SERVERTABLEVENTS' and '$SERVERTABLCOMMENTS' tables
-y, --yearsago=<years ago>
YEARS AGO: c => current year or 1..9 => the number of years ago that the '$SERVERTABLEVENTS'
and '$SERVERTABLCOMMENTS' tables need to be created
ASP
view release on metacpan or search on metacpan
}
=head2 AddDeathHook LIST
Allows cleanup code to be executed when you C<die> or C<exit>.
Useful for closing database connections in the event of a
fatal error.
<%
my $conn = Win32::OLE-new('ADODB.Connection');
$conn->Open("MyDSN");
ASP4-PSGI
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
ASP4
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
ASP4x-Captcha-Imager
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
ASP4x-Linker
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
ASP4x-Router
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
AUBBC
view release on metacpan or search on metacpan
The [c] or code tags can highlight Perl code, highlighting the Perl code with CSS in HTML/XHTML,
and in the examples folder the tag_list.cgi file has a CSS code you could work from and now a setting to change to a costume highlighter function.
This module addresses many security issues the BBcode tags may have mainly cross site script also known as XSS.
Each message is escaped before it gets returned if script_escape is Enabled and checked for many types of security problems before that tag converts to HTML/XHTML.
The script_escape setting and method also converts the ' sign so the text can be stored in a SQL back-end.
Most of the free web portals use the | sign as the delimiter for the flat file database, the script_escape setting and method also converts that sign so the structure of the database is retained.
Allows easy conversion to HTML and XHTML, existing tags will convert to the HTML type set.
If there isn't a popular tag available this module provides a method to "Build your own tags" custom tags can help link to parts of the current web page, other web pages and add other HTML elements.
AVLTree
view release on metacpan or search on metacpan
lib/AVLTree.pm view on Meta::CPAN
printf "Size of tree is now: %d\n", $tree->size();
...
# Suppose you want the tree to hold generic data items, e.g. hashrefs
# which hold some data. We can deal with these by definying a custom
# comparison function based on one of the attributes of these data items,
# e.g. 'id':
sub compare {
my ($i1, $i2) = @_;
my ($id1, $id2) = ($i1->{id}, $i2->{id});
lib/AVLTree.pm view on Meta::CPAN
}
# Now can do the same as with numbers
my $tree = AVLTree->new(\&compare);
my $insert_ok = $tree->insert({ id => 10, data => 'ten' });
croak "Could not insert item" unless $insert_ok;
$insert_ok = $tree->insert({ id => 20, data => 'twenty' });
...
my $id = 10;
my $result = $tree->find({ id => $id });
if($result) {
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else {
print "Item with id $id not found\n";
}
# forward tree traversal
lib/AVLTree.pm view on Meta::CPAN
=head2 C<find>
Arg [1] : Item to search, can be defined just in terms of the attribute
with which the items in the tree are compared.
Example : $tree->find({ id => 10 }); # objects in the tree can hold data as well
if($result) {
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else { print "Item with id $id not found\n"; }
Description : Query if an item exists in the tree.
Returntype : The item, if found, as stored in the tree or undef
lib/AVLTree.pm view on Meta::CPAN
=head2 C<insert>
Arg [1] : An item to insert in the tree.
Example : my $ok = $tree->insert({ id => 10, data => 'ten' });
croak "Unable to insert 10" unless $ok;
Description : Insert an item in the tree, use the provided, upon tree construction,
comparison function to determine the position of the item in the tree
AWS-CLI-Config
view release on metacpan or search on metacpan
lib/AWS/CLI/Config.pm view on Meta::CPAN
use strict;
use warnings;
sub new {
my $class = shift;
my $data = @_ ? @_ > 1 ? { @_ } : shift : {};
return bless $data, $class;
}
sub AUTOLOAD {
our $AUTOLOAD;
my $self = shift;
AWS-CLIWrapper
view release on metacpan or search on metacpan
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub amplifyuibuilder { shift->_execute('amplifyuibuilder', @_) }
sub apigateway { shift->_execute('apigateway', @_) }
sub apigatewaymanagementapi { shift->_execute('apigatewaymanagementapi', @_) }
sub apigatewayv2 { shift->_execute('apigatewayv2', @_) }
sub appconfig { shift->_execute('appconfig', @_) }
sub appconfigdata { shift->_execute('appconfigdata', @_) }
sub appfabric { shift->_execute('appfabric', @_) }
sub appflow { shift->_execute('appflow', @_) }
sub appintegrations { shift->_execute('appintegrations', @_) }
sub application_autoscaling { shift->_execute('application-autoscaling', @_) }
sub application_insights { shift->_execute('application-insights', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub cloudhsm { shift->_execute('cloudhsm', @_) }
sub cloudhsmv2 { shift->_execute('cloudhsmv2', @_) }
sub cloudsearch { shift->_execute('cloudsearch', @_) }
sub cloudsearchdomain { shift->_execute('cloudsearchdomain', @_) }
sub cloudtrail { shift->_execute('cloudtrail', @_) }
sub cloudtrail_data { shift->_execute('cloudtrail-data', @_) }
sub cloudwatch { shift->_execute('cloudwatch', @_) }
sub codeartifact { shift->_execute('codeartifact', @_) }
sub codebuild { shift->_execute('codebuild', @_) }
sub codecatalyst { shift->_execute('codecatalyst', @_) }
sub codecommit { shift->_execute('codecommit', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub connectcases { shift->_execute('connectcases', @_) }
sub connectparticipant { shift->_execute('connectparticipant', @_) }
sub controltower { shift->_execute('controltower', @_) }
sub cur { shift->_execute('cur', @_) }
sub customer_profiles { shift->_execute('customer-profiles', @_) }
sub databrew { shift->_execute('databrew', @_) }
sub dataexchange { shift->_execute('dataexchange', @_) }
sub datapipeline { shift->_execute('datapipeline', @_) }
sub datasync { shift->_execute('datasync', @_) }
sub dax { shift->_execute('dax', @_) }
sub deploy { shift->_execute('deploy', @_) }
sub detective { shift->_execute('detective', @_) }
sub devicefarm { shift->_execute('devicefarm', @_) }
sub devops_guru { shift->_execute('devops-guru', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub emr_serverless { shift->_execute('emr-serverless', @_) }
sub es { shift->_execute('es', @_) }
sub events { shift->_execute('events', @_) }
sub evidently { shift->_execute('evidently', @_) }
sub finspace { shift->_execute('finspace', @_) }
sub finspace_data { shift->_execute('finspace-data', @_) }
sub firehose { shift->_execute('firehose', @_) }
sub fis { shift->_execute('fis', @_) }
sub fms { shift->_execute('fms', @_) }
sub forecast { shift->_execute('forecast', @_) }
sub forecastquery { shift->_execute('forecastquery', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub importexport { shift->_execute('importexport', @_) }
sub inspector { shift->_execute('inspector', @_) }
sub inspector2 { shift->_execute('inspector2', @_) }
sub internetmonitor { shift->_execute('internetmonitor', @_) }
sub iot { shift->_execute('iot', @_) }
sub iot_data { shift->_execute('iot-data', @_) }
sub iot_jobs_data { shift->_execute('iot-jobs-data', @_) }
sub iot_roborunner { shift->_execute('iot-roborunner', @_) }
sub iot1click_devices { shift->_execute('iot1click-devices', @_) }
sub iot1click_projects { shift->_execute('iot1click-projects', @_) }
sub iotanalytics { shift->_execute('iotanalytics', @_) }
sub iotdeviceadvisor { shift->_execute('iotdeviceadvisor', @_) }
sub iotevents { shift->_execute('iotevents', @_) }
sub iotevents_data { shift->_execute('iotevents-data', @_) }
sub iotfleethub { shift->_execute('iotfleethub', @_) }
sub iotfleetwise { shift->_execute('iotfleetwise', @_) }
sub iotsecuretunneling { shift->_execute('iotsecuretunneling', @_) }
sub iotsitewise { shift->_execute('iotsitewise', @_) }
sub iotthingsgraph { shift->_execute('iotthingsgraph', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub medialive { shift->_execute('medialive', @_) }
sub mediapackage { shift->_execute('mediapackage', @_) }
sub mediapackage_vod { shift->_execute('mediapackage-vod', @_) }
sub mediapackagev2 { shift->_execute('mediapackagev2', @_) }
sub mediastore { shift->_execute('mediastore', @_) }
sub mediastore_data { shift->_execute('mediastore-data', @_) }
sub mediatailor { shift->_execute('mediatailor', @_) }
sub memorydb { shift->_execute('memorydb', @_) }
sub meteringmarketplace { shift->_execute('meteringmarketplace', @_) }
sub mgh { shift->_execute('mgh', @_) }
sub mgn { shift->_execute('mgn', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub organizations { shift->_execute('organizations', @_) }
sub osis { shift->_execute('osis', @_) }
sub outposts { shift->_execute('outposts', @_) }
sub panorama { shift->_execute('panorama', @_) }
sub payment_cryptography { shift->_execute('payment-cryptography', @_) }
sub payment_cryptography_data { shift->_execute('payment-cryptography-data', @_) }
sub personalize { shift->_execute('personalize', @_) }
sub personalize_events { shift->_execute('personalize-events', @_) }
sub personalize_runtime { shift->_execute('personalize-runtime', @_) }
sub pi { shift->_execute('pi', @_) }
sub pinpoint { shift->_execute('pinpoint', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub qldb_session { shift->_execute('qldb-session', @_) }
sub quicksight { shift->_execute('quicksight', @_) }
sub ram { shift->_execute('ram', @_) }
sub rbin { shift->_execute('rbin', @_) }
sub rds { shift->_execute('rds', @_) }
sub rds_data { shift->_execute('rds-data', @_) }
sub redshift { shift->_execute('redshift', @_) }
sub redshift_data { shift->_execute('redshift-data', @_) }
sub redshift_serverless { shift->_execute('redshift-serverless', @_) }
sub rekognition { shift->_execute('rekognition', @_) }
sub resiliencehub { shift->_execute('resiliencehub', @_) }
sub resource_explorer_2 { shift->_execute('resource-explorer-2', @_) }
sub resource_groups { shift->_execute('resource-groups', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<apigatewayv2>($operation:Str, $param:HashRef, %opt:Hash)
=item B<appconfig>($operation:Str, $param:HashRef, %opt:Hash)
=item B<appconfigdata>($operation:Str, $param:HashRef, %opt:Hash)
=item B<appfabric>($operation:Str, $param:HashRef, %opt:Hash)
=item B<appflow>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<cloudsearchdomain>($operation:Str, $param:HashRef, %opt:Hash)
=item B<cloudtrail>($operation:Str, $param:HashRef, %opt:Hash)
=item B<cloudtrail_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<cloudwatch>($operation:Str, $param:HashRef, %opt:Hash)
=item B<codeartifact>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<cur>($operation:Str, $param:HashRef, %opt:Hash)
=item B<customer_profiles>($operation:Str, $param:HashRef, %opt:Hash)
=item B<databrew>($operation:Str, $param:HashRef, %opt:Hash)
=item B<dataexchange>($operation:Str, $param:HashRef, %opt:Hash)
=item B<datapipeline>($operation:Str, $param:HashRef, %opt:Hash)
=item B<datasync>($operation:Str, $param:HashRef, %opt:Hash)
=item B<dax>($operation:Str, $param:HashRef, %opt:Hash)
=item B<deploy>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<evidently>($operation:Str, $param:HashRef, %opt:Hash)
=item B<finspace>($operation:Str, $param:HashRef, %opt:Hash)
=item B<finspace_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<firehose>($operation:Str, $param:HashRef, %opt:Hash)
=item B<fis>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<internetmonitor>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot_jobs_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot_roborunner>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iot1click_devices>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<iotdeviceadvisor>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iotevents>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iotevents_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iotfleethub>($operation:Str, $param:HashRef, %opt:Hash)
=item B<iotfleetwise>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<mediapackagev2>($operation:Str, $param:HashRef, %opt:Hash)
=item B<mediastore>($operation:Str, $param:HashRef, %opt:Hash)
=item B<mediastore_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<mediatailor>($operation:Str, $param:HashRef, %opt:Hash)
=item B<memorydb>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<panorama>($operation:Str, $param:HashRef, %opt:Hash)
=item B<payment_cryptography>($operation:Str, $param:HashRef, %opt:Hash)
=item B<payment_cryptography_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<personalize>($operation:Str, $param:HashRef, %opt:Hash)
=item B<personalize_events>($operation:Str, $param:HashRef, %opt:Hash)
lib/AWS/CLIWrapper.pm view on Meta::CPAN
=item B<rbin>($operation:Str, $param:HashRef, %opt:Hash)
=item B<rds>($operation:Str, $param:HashRef, %opt:Hash)
=item B<rds_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<redshift>($operation:Str, $param:HashRef, %opt:Hash)
=item B<redshift_data>($operation:Str, $param:HashRef, %opt:Hash)
=item B<redshift_serverless>($operation:Str, $param:HashRef, %opt:Hash)
=item B<rekognition>($operation:Str, $param:HashRef, %opt:Hash)
AWS-CloudFront
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
AWS-IP
view release on metacpan or search on metacpan
lib/AWS/IP.pm view on Meta::CPAN
use AWS::IP;
my $aws = AWS::IP->new(600, '/tmp/aws_ip_cache');
# get the raw data as a Perl reference
my $aws_ip_data = $aws->get_raw_data;
# check if an ip address is AWS
if ($aws->is_aws_ip('50.0.0.1')
{
..
lib/AWS/IP.pm view on Meta::CPAN
{
...
}
# time passes, cache has expired
$aws_ip_data = $aws->get_raw_data; # auto refreshes
=head2 DESCRIPTION
AWS L<publish|https://ip-ranges.amazonaws.com/ip-ranges.json> their IP ranges, which periodically change. This module downloads and serializes the IP ranges into a Perl data hash reference. It caches the data, and if the cache expires, re-downloads a...
=head2 new ($cache_timeout_secs, [$cache_path])
Creates a new AWS::IP object and sets up the cache. Requires an number for the cache timeout seconds. Optionally takes a cache path argument. If no cache path is supplied, AWS::IP will use a random temp directory. If you want to reuse the cache over ...
lib/AWS/IP.pm view on Meta::CPAN
my $ip_ranges;
if ($service)
{
$ip_ranges = Net::CIDR::Set->new( map { $_->{ip_prefix} } grep { $_->{service} eq $service } @{$self->get_raw_data->{prefixes}});
}
else
{
$ip_ranges = Net::CIDR::Set->new( map { $_->{ip_prefix} } @{$self->get_raw_data->{prefixes}} );
}
$ip_ranges->contains($ip);
}
=head2 get_raw_data
Returns the entire raw IP dataset as a Perl data structure.
=cut
sub get_raw_data
{
my ($self) = @_;
my $entry = $self->{cache}->entry(CACHE_KEY);
lib/AWS/IP.pm view on Meta::CPAN
}
}
=head2 get_cidrs
Returns an arrayref of the L<CIDRs|http://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing> in the AWS IP address data.
=cut
sub get_cidrs
{
my ($self) = @_;
[ map { $_->{ip_prefix} } @{$self->get_raw_data->{prefixes}} ];
}
=head2 get_cidrs_by_region ($region)
Returns an arrayref of CIDRs matching the provided region.
lib/AWS/IP.pm view on Meta::CPAN
sub get_cidrs_by_region
{
my ($self, $region) = @_;
croak 'Error must provide region' unless $region;
[ map { $_->{ip_prefix} } grep { $_->{region} eq $region } @{$self->get_raw_data->{prefixes}} ];
}
=head2 get_cidrs_by_service ($service)
Returns an arrayref of CIDRs matching the provided service (AMAZON|EC2|CLOUDFRONT|ROUTE53|ROUTE53_HEALTHCHECKS).
lib/AWS/IP.pm view on Meta::CPAN
sub get_cidrs_by_service
{
my ($self, $service) = @_;
croak 'Error must provide service' unless $service;
[ map { $_->{ip_prefix} } grep { $_->{service} eq $service } @{$self->get_raw_data->{prefixes}} ];
}
=head2 get_regions
Returns an arrayref of the regions in the AWS IP address data.
=cut
sub get_regions
{
my ($self) = @_;
my %regions;
for (@{$self->get_raw_data->{prefixes}})
{
$regions{ $_->{region} } = 1;
}
[ keys %regions ];
}
=head2 get_services
Returns an arrayref of the services (Amazon, EC2 etc) in the AWS IP address data.
=cut
sub get_services
{
my ($self) = @_;
my %services;
for (@{$self->get_raw_data->{prefixes}})
{
$services{ $_->{service} } = 1;
}
[ keys %services ];
}
lib/AWS/IP.pm view on Meta::CPAN
if ($response->{success})
{
my $entry = $self->{cache}->entry(CACHE_KEY);
$entry->set($response->{content});
# return the data
$response->{content};
}
else
{
croak "Error requesting $response->{url} $response->{code} $response->{reason}";
}
}
sub _refresh_cache_from_string
{
my ($self, $data) = @_;
my $entry = $self->{cache}->entry(CACHE_KEY);
$entry->set($data);
# return the data
$data;
}
1;
AWS-Lambda-Quick
view release on metacpan or search on metacpan
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
use AWS::Lambda::Quick (
name => 'hello-world',
);
sub handler {
my $data = shift;
my $name = $data->{queryStringParameters}{who} // "World";
return {
statusCode => 200,
headers => {
'Content-Type' => 'text/plain',
},
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
This module allows you to very quickly create a Perl based AWS
Lambda function which can be accessed via HTTP.
Coding Lambda functions in Perl is straight forward: You need only
implement a script with the one C<handler> function that returns the
expected data structure as described in the L<AWS::Lambda>
documentation.
The hard part is configuring AWS to execute the code. Traditionally
you have to complete the following steps.
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
use AWS::Lambda::Quick (
name => 'echo',
);
sub handler {
my $data = shift;
return {
statusCode => 200,
headers => {
'Content-Type' => 'application/json',
},
body => encode_json($data),
};
}
1;
=head3 Create a new integration-response and method-response
The integration response and method response are analogous to the
integration and method - but instead of getting data from HTTP to
Lambda, they get Lambda data back to HTTP.
Because we want our handler to have complete control over the output
we don't do anything special with what we create.
=head3 Deploying the Code.
AWS-Lambda
view release on metacpan or search on metacpan
author/pod-stripper/scripts/pod_stripper.pl view on Meta::CPAN
open my $pm, '<', $file;
$module = <$pm>;
close $pm
}
# it is not pod, but might be some data.
# skip it for safety.
if ($module =~ /^__DATA__$/m) {
return
}
AWS-Networks
view release on metacpan or search on metacpan
lib/AWS/Networks.pm view on Meta::CPAN
=head1 DESCRIPTION
This module parses the official public IP network information published by Amazon Web Services at https://ip-ranges.amazonaws.com/ip-ranges.json
Please read and understand the information can be found at http://docs.aws.amazon.com/general/latest/gr/aws-ip-ranges.html to make sense of the data retured by this module.
=head1 USAGE
Instance an object, and use it to filter information of interest to you with the attributes and methods provided.
lib/AWS/Networks.pm view on Meta::CPAN
Standard Moose constructor. Can specify a custom URL to download a document that follows the same schema
=head2 url
Returns the URL from which the information was retrieved. Returns undef on filtered datasets
=head2 sync_token
Returns a DateTime object created from the current timestamp of the syncToken reported from the service
lib/AWS/Networks.pm view on Meta::CPAN
region can be one of: ap-northeast-1 | ap-southeast-1 | ap-southeast-2 | cn-north-1 | eu-central-1 | eu-west-1 | sa-east-1 | us-east-1 | us-gov-west-1 | us-west-1 | us-west-2 | GLOBAL, but expect new values to appear
=head2 services
Returns an ArrayRef of the different services present in the current dataset
=head2 regions
Returns an ArrayRef of the different regions present in the current dataset
=head2 cidrs
Returns an ArrayRef with the CIDR blocks in the dataset
=head2 by_region($region)
Returns a new AWS::Networks object with the data filtered to only the objects in the
specified region
=head2 by_service($service)
Returns a new AWS::Networks object with the data filtered to only the services specified
=cut
=head1 CONTRIBUTE
AWS-S3
view release on metacpan or search on metacpan
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
sub new {
my ($class, %args) = @_;
my $s = bless {
data => [ ],
page_number => 0,
idx => 0,
%args,
}, $class;
$s->_init;
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
} # end foreach()
$s->{page_number}--;
$s->{marker} = '' unless defined( $s->{marker} );
$s->{__fetched_first_page} = 0;
$s->{data} = [];
$s->{pattern} ||= qr(.*);
} # end _init()
sub marker { shift->{marker} }
sub pattern { shift->{pattern} }
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
sub has_next { shift->{has_next} }
sub next {
my $s = shift;
if( exists( $s->{data}->[ $s->{idx} ] ) ) {
return $s->{data}->[ $s->{idx}++ ];
} else {
# End of the current resultset, see if we can get another page of records:
if( my $page = $s->next_page ) {
$s->{data} = $page;
$s->{idx} = 0;
return $s->{data}->[ $s->{idx}++ ];
} else {
# No more pages, no more data:
return;
}
}
}
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
} # end next_page()
sub _next {
my $s = shift;
if ( my $item = shift( @{ $s->{data} } ) ) {
return $item;
} else {
if ( my @chunk = $s->_fetch() ) {
push @{ $s->{data} }, @chunk;
return shift( @{ $s->{data} } );
} else {
return;
} # end if()
} # end if()
} # end _next()
AWS-SQS-Simple
view release on metacpan or search on metacpan
lib/AWS/SQS/Simple.pm view on Meta::CPAN
END_POINT => $parameter_hash{ END_POINT } ,
};
## Private and class data here.
bless( $self, $class );
return $self;
lib/AWS/SQS/Simple.pm view on Meta::CPAN
my $self = shift ;
my $url_to_access = shift ;
my $contents ;
my $attempts = 0 ;
my $got_data = 0 ;
my $this_profile_location ;
my $response;
until( $got_data or $attempts > 5 ) {
my $request = HTTP::Request->new(
GET => $url_to_access
);
lib/AWS/SQS/Simple.pm view on Meta::CPAN
$response = $ua->request( $request ) ;
if( $response->is_success() ) {
$contents = $response->content;
$got_data = 1;
} else {
$contents = $response->content ;
AWS-Signature-V2
view release on metacpan or search on metacpan
cpanfile.snapshot view on Meta::CPAN
URI::_punycode 0.04
URI::_query undef
URI::_segment undef
URI::_server undef
URI::_userpass undef
URI::data undef
URI::file 4.21
URI::file::Base undef
URI::file::FAT undef
URI::file::Mac undef
URI::file::OS2 undef
AWS-XRay
view release on metacpan or search on metacpan
lib/AWS/XRay.pm view on Meta::CPAN
my @args = @_;
capture(
$package,
sub {
my $segment = shift;
$segment->{metadata}->{method} = $method;
$segment->{metadata}->{package} = $package;
$orig->(@args);
},
);
};
}
lib/AWS/XRay.pm view on Meta::CPAN
=head1 DESCRIPTION
AWS::XRay is a tracing library with AWS X-Ray.
AWS::XRay sends segment data to L<AWS X-Ray Daemon|https://docs.aws.amazon.com/xray/latest/devguide/xray-daemon.html>.
=head1 FUNCTIONS
=head2 new_trace_id
Generate a Trace ID. (e.g. "1-581cf771-a006649127e371903a2de979")
L<Document|https://docs.aws.amazon.com/xray/latest/devguide/xray-api-sendingdata.html#xray-api-traceids>
=head2 capture($name, $code)
capture() executes $code->($segment) and send the segment document to X-Ray daemon.
lib/AWS/XRay.pm view on Meta::CPAN
add_capture() adds a capture to package::method.
AWS::XRay->add_capture("MyApp::Model", "foo", "bar");
The segments of these captures are named as "MyApp::Model".
These segments include metadata "method": "foo" or "bar".
=head1 CONFIGURATION
=head2 sampling_rate($rate)
lib/AWS/XRay.pm view on Meta::CPAN
=head2 auto_flush($mode)
Set/Get auto flush mode.
When $mode is 1 (default), segment data will be sent to xray daemon immediately after capture() called.
When $mode is 0, segment data are buffered in memory. You should call AWS::XRay->sock->flush() to send the buffered segment data or call AWS::XRay->sock->close() to discard the buffer.
=head2 AWS_XRAY_DAEMON_ADDRESS environment variable
Set the host and port of the X-Ray daemon. Default 127.0.0.1:2000
AXL-Client-Simple
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
inc/Module/Install/Metadata.pm view on Meta::CPAN
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
$v = $v + 0;
}
return $v;
}
sub add_metadata {
my $self = shift;
my %hash = @_;
for my $key (keys %hash) {
warn "add_metadata: $key is not prefixed with 'x_'.\n" .
"Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
$self->{values}->{$key} = $hash{$key};
}
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.yml\n";
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
# We need JSON to write the MYMETA.json file
unless ( eval { require JSON; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.json\n";
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return undef unless -f 'META.yml';
Aard
view release on metacpan or search on metacpan
lib/Aard.pm view on Meta::CPAN
printf "The tenth entry's key: %s\n", $dict->key(9);
printf "The tenth entry's value: %s\n", $dict->article(9);
=head1 DESCRIPTION
Aard is a module for reading files in the Aard Dictionary format (.aar). A dictionary is an array of I<(key, article)> pairs, with some associated metadata.
=over
=item B<new>(I<filename>)
lib/Aard.pm view on Meta::CPAN
Returns the total number of volumes for this dictionary.
=item B<meta>
Returns the raw metadata as a hashref.
=item B<article_count>
Returns the number of unique articles in this volume (if B<article_count_is_volume_total> is true) or in this dictionary (otherwise).
lib/Aard.pm view on Meta::CPAN
Returns the full license text
=item B<source>
Returns the dictionary data source
=back
=head1 SEE ALSO
Abilities
view release on metacpan or search on metacpan
lib/Abilities.pm view on Meta::CPAN
attributes to return objects. While this made it easier to calculate
abilities, it made this system a bit less flexible.
In version 0.3, C<Abilities> changed the requirement such that both these
attributes need to return strings (the names of the roles/actions). If your implementation
has granted roles and actions stored in a database by names, this made life a bit easier
for you. On other implementations, however, this has the potential of
requiring you to write a bit more code. If that is the case, I apologize,
but keep in mind that you can still store granted roles and actions
any way you want in a database (either by names or by references), just
as long as you correctly provide C<roles> and C<actions>.
Unfortunately, in both versions 0.3 and 0.4, I made a bit of a mess
that rendered both versions unusable. While I documented the C<roles>
attribute as requiring role names instead of role objects, the actual
implementation still required role objects. This has now been fixed,
but it also meant I had to add a new requirement: consuming classes
now have to provide a method called C<get_role()> that takes the name
of a role and returns its object. This will probably means loading the
role from a database and blessing it into your role class that also consumes
this module.
I apologize for any inconvenience this might have caused.
=head1 AUTHOR
Abstract-Meta-Class
view release on metacpan or search on metacpan
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
has '$.attr1' => (default => 0);
=head1 DESCRIPTION
An object that describes an attribute.
It includes required, data type, association validation, default value, lazy retrieval.
Name of attribute must begin with one of the follwoing prefix:
$. => Scalar,
@. => Array,
%. => Hash,
&. => Code,
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
my ($type, $accessor_name) = ($name =~ /^([\$\@\%\&])\.(.*)$/);
confess "invalid attribute defintion ${class}::" .($accessor_name || $name) .", supported prefixes are \$.,%.,\@.,&."
if ! $type || ! $supported_type{$type};
my %options;
$args{data_type_validation} = 1
if (! exists($args{data_type_validation})
&& ($type eq '@' || $type eq '%' || $args{associated_class}));
$options{'&.' . $_ } = $args{$_}
for grep {exists $args{$_}} (qw(on_read on_change on_validate));
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
$options{'$.storage_key'} = $storage_key;
$options{'$.mutator'} = "set_$accessor_name";
$options{'$.accessor'} = $accessor_name;
$options{'$.' . $_ } = $args{$_}
for grep {exists $args{$_}}
(qw(class required default item_accessor associated_class data_type_validation index_by the_other_end transistent storage_type));
$options{'$.perl_type'} = $supported_type{$type};
unless ($args{default}) {
if($type eq '%') {
$options{'$.default'} = sub{ {} };
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
=cut
sub the_other_end { shift()->{'$.the_other_end'} }
=item data_type_validation
Flag that turn on/off data type validation.
Data type validation happens when using association_class or Array or Hash data type
unless you explicitly disable it by seting data_type_validation => 0.
=cut
sub data_type_validation { shift()->{'$.data_type_validation'} }
=item on_read
Returns code reference that will be replace data read routine
has '%.attrs.' => (
item_accessor => 'attr'
on_read => sub {
my ($self, $attribute, $scope, $key) = @_;
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
sub on_read { shift()->{'&.on_read'} }
=item set_on_read
Sets code reference that will be replace data read routine
my $attr = MyClass->meta->attribute('attrs');
$attr->set_on_read(sub {
my ($self, $attribute, $scope, $key) = @_;
#do some stuff
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
}
=item on_change
Code reference that will be executed when data is set,
Takes reference to the variable to be set.
=cut
sub on_change { shift()->{'&.on_change'} }
=item set_on_change
Sets code reference that will be executed when data is set,
my $attr = MyClass->meta->attribute('attrs');
$attr->set_on_change(sub {
my ($self, $attribute, $scope, $value, $key) = @_;
if($scope eq 'mutator') {
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
=item on_validate
Returns on validate code reference.
It is executed before the data type validation happens.
=cut
sub on_validate { shift()->{'&.on_validate'} }
=item set_on_validate
Sets code reference that will be replace data read routine
my $attr = MyClass->meta->attribute('attrs');
$attr->set_on_read(sub {
my ($self, $attribute, $scope, $key) = @_;
#do some stuff
Ac_me-Local
view release on metacpan or search on metacpan
README
t/00-load.t
t/manifest.t
t/pod-coverage.t
t/pod.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
( run in 1.120 second using v1.01-cache-2.11-cpan-c966e8aa7e8 )