view release on metacpan or search on metacpan
lib/AI/NeuralNet/Kohonen/Visual.pm view on Meta::CPAN
Calls TK's C<MainLoop> at the end of training.
=item missing_colour
When selecting a colour using L<METHOD get_colour_for>,
every node weight holding the value of C<missing_mask>
will be given the value of this paramter. If this paramter
is not defined, the default is 0.
=back
lib/AI/NeuralNet/Kohonen/Visual.pm view on Meta::CPAN
}
$self->{t}++; # Measure epoch
&{$self->{epoch_start}} if exists $self->{epoch_start};
for (0..$#{$self->{input}}){
my $target = $self->_select_target;
my $bmu = $self->find_bmu($target);
$self->_adjust_neighbours_of($bmu,$target);
if (exists $self->{show_training}){
view all matches for this distribution
view release on metacpan or search on metacpan
examples/ex_add2.pl view on Meta::CPAN
my @percent_diff;
$inputs = 3;
$outputs = 1;
my ($maxinc,$maxtop,$incstep);
select OUTFP; $OUTPUT_AUTOFLUSH = 1; select STDOUT;
print OUTFP "layers inc top forgetfulness time \%diff1 \%diff2 \%diff3
\%diff4\n\n";
for( $layers = 1; $layers <= 3; $layers++ ){
if( $layers <= 2 ){
view all matches for this distribution
view release on metacpan or search on metacpan
example/PSOTest-MultiCore.pl view on Meta::CPAN
sub calcFit {
my @values = @_;
my $offset = int (-@values / 2);
my $sum;
select( undef, undef, undef, 0.01 ); # Simulation of heavy processing...
$sum += ($_ - $offset++) ** 2 for @values;
return $sum;
}
#=======================================================================
example/PSOTest-MultiCore.pl view on Meta::CPAN
-dimensions => 10,
-iterations => 10,
-numParticles => 1000,
# only for many-core version # the best if == $#cores of your system
# selecting best value if undefined
-workers => 4,
);
my $beg = time;
view all matches for this distribution
view release on metacpan or search on metacpan
example/PSOTest-MultiCore.pl view on Meta::CPAN
sub calcFit {
my @values = @_;
my $offset = int (-@values / 2);
my $sum;
select( undef, undef, undef, 0.01 ); # Simulation of heavy processing...
$sum += ($_ - $offset++) ** 2 for @values;
return $sum;
}
#=======================================================================
example/PSOTest-MultiCore.pl view on Meta::CPAN
-dimensions => 10,
-iterations => 10,
-numParticles => 1000,
# only for many-core version # the best if == $#cores of your system
# selecting best value if undefined
-workers => 4,
);
my $beg = time;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/ParticleSwarmOptimization.pm view on Meta::CPAN
(in principle) allows the creation of derived classes to reimplement all aspects
of the optimization engine (a future version will describe the replaceable
engine components).
This implementation allows communication of a local best point between a
selected number of neighbours. It does not support a single global best position
that is known to all particles in the swarm.
=head1 Methods
AI::ParticleSwarmOptimization provides the following public methods. The parameter lists shown
view all matches for this distribution
view release on metacpan or search on metacpan
- added typemap.
- added test 06 for this functions
- remove some duplicated code
0.18 September 26 15:24 2010
- added clone_rect for selection rectangle
0.19 September 28 05:35 2010
- added test for dastar algorithm
- Some doc fix
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
has _iter_idx => ( isa => 'Int', is => 'rw', default => sub { 0; }, );
has _num_boards => ( isa => 'Int', is => 'ro', init_arg => 'num_boards', );
has _orig_scans_data => ( isa => 'PDL', is => 'rw' );
has _optimize_for => ( isa => 'Str', is => 'ro', init_arg => 'optimize_for', );
has _scans_data => ( isa => 'PDL', is => 'rw' );
has _selected_scans =>
( isa => 'ArrayRef', is => 'ro', init_arg => 'selected_scans', );
has _status => ( isa => 'Str', is => 'rw' );
has _quotas => ( isa => 'ArrayRef[Int]', is => 'ro', init_arg => 'quotas' );
has _total_boards_solved => ( isa => 'Int', is => 'rw' );
has _total_iters => ( is => 'rw' );
has _trace_cb =>
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
defined($factor)
? ( ( $pdl >= 0 ) * ( ( $pdl / $factor )->ceil() ) +
( $pdl < 0 ) * $pdl )
: $pdl
);
} @{ $self->_selected_scans() }
);
$self->_orig_scans_data($scans_data);
$self->_scans_data( $self->_orig_scans_data()->copy() );
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
{
my $self = shift;
my $iters_quota = 0;
my $num_solved_in_iter = 0;
my $selected_scan_idx;
# If no boards were solved, then try with a larger quota
while ( $num_solved_in_iter == 0 )
{
my $q_more = $self->_get_next_quota();
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
my $solved_moves_sums = _my_sum_over($solved_moves);
my $solved_moves_counts = _my_sum_over($solved);
my $solved_moves_avgs = $solved_moves_sums / $solved_moves_counts;
( undef, undef, $selected_scan_idx, undef ) =
$solved_moves_avgs->minmaximum();
$num_solved_in_iter = $solved_moves_counts->at($selected_scan_idx);
}
return {
quota => $iters_quota,
num_solved => $num_solved_in_iter,
scan_idx => $selected_scan_idx,
};
}
sub _get_iter_state_params_minmax_len
{
my $self = shift;
my $iters_quota = 0;
my $num_solved_in_iter = 0;
my $selected_scan_idx;
# If no boards were solved, then try with a larger quota
while ( $num_solved_in_iter == 0 )
{
my $q_more = $self->_get_next_quota();
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
my $solved_moves = $solved * $num_moves;
my $solved_moves_maxima = $solved_moves->maximum()->slice(":,(0),(0)");
my $solved_moves_counts = _my_sum_over($solved);
( undef, undef, $selected_scan_idx, undef ) =
$solved_moves_maxima->minmaximum();
$num_solved_in_iter = $solved_moves_counts->at($selected_scan_idx);
}
return {
quota => $iters_quota,
num_solved => $num_solved_in_iter,
scan_idx => $selected_scan_idx,
};
}
sub _get_iter_state_params_speed
{
my $self = shift;
my $iters_quota = 0;
my $num_solved_in_iter = 0;
my $selected_scan_idx;
# If no boards were solved, then try with a larger quota
while ( $num_solved_in_iter == 0 )
{
my $q_more = $self->_get_next_quota();
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
error => "No q_more" );
}
$iters_quota += $q_more;
( undef, $num_solved_in_iter, undef, $selected_scan_idx ) =
PDL::minmaximum(
PDL::sumover(
( $self->_scans_data() <= $iters_quota ) &
( $self->_scans_data() > 0 )
)
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
}
return {
quota => $iters_quota,
num_solved => $num_solved_in_iter->at(0),
scan_idx => $selected_scan_idx->at(0),
};
}
sub _get_selected_scan
{
my $self = shift;
my $iter_state =
AI::Pathfinding::OptimizeMultiple::IterState->new(
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
sub _inspect_quota
{
my $self = shift;
my $state = $self->_get_selected_scan();
$state->register_params();
$state->update_total_iters();
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
return ( ( $self->_scans_data()->dims() )[$SCANS_DIM] );
}
sub _calc_chosen_scan
{
my ( $self, $selected_scan_idx, $iters_quota ) = @_;
return AI::Pathfinding::OptimizeMultiple::ScanRun->new(
{
iters => (
$iters_quota * (
$self->_stats_factors->{
( $self->_selected_scans->[$selected_scan_idx]->id() ),
} // 1
)
),
scan_idx => $selected_scan_idx,
}
);
}
sub calc_flares_meta_scan
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
# The number of moves for dimension 0,1,2 above.
my $num_moves_repeat = $num_moves->clump( 1 .. 2 )->xchg( 0, 1 )
->dummy( 0, $self->_get_num_scans() );
my $selected_scan_idx;
my $loop_iter_num = 0;
my $UNSOLVED_NUM_MOVES_CONSTANT = 64 * 1024 * 1024;
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
# print join(",", $solved_moves_avgs->minmaximum()), "\n";
my $min_avg;
( $min_avg, undef, $selected_scan_idx, undef ) =
$solved_moves_avgs->minmaximum();
$last_avg = $min_avg;
push @{ $self->chosen_scans() },
$self->_calc_chosen_scan( $selected_scan_idx, $iters_quota );
$flares_num_iters->set( $selected_scan_idx,
$flares_num_iters->at($selected_scan_idx) + $iters_quota );
$self->_selected_scans()->[$selected_scan_idx]->mark_as_used();
$iters_quota = 0;
my $num_solved = $solved_moves_counts->at($selected_scan_idx);
my $flares_num_iters_repeat =
$flares_num_iters->dummy( 0, $self->_num_boards() );
# A boolean tensor:
lib/AI/Pathfinding/OptimizeMultiple.pm view on Meta::CPAN
{
first_search => $first_search_pdl,
second_search => $second_search_pdl,
},
quotas => [400, 300, 200],
selected_scans =>
[
AI::Pathfinding::OptimizeMultiple::Scan->new(
id => 'first_search',
cmd_line => "--preset first_search",
),
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/Pathfinding/SMAstar/Examples/PalUtils.pm view on Meta::CPAN
}
sub flush {
my $h = select($_[0]); my $a=$|; $|=1; $|=$a; select($h);
}
{my $spinny_thing = "-";
my $call_num = 0;
my $state;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AI/TensorFlow/Libtensorflow/Manual/Notebook/InferenceUsingTFHubCenterNetObjDetect.pod view on Meta::CPAN
undef;
=head2 Results summary
Then we use a score threshold to select the objects of interest.
my $min_score_thresh = 0.30;
my $which_detect = which( $pdl_output_by_name{detection_scores} > $min_score_thresh );
view all matches for this distribution
view release on metacpan or search on metacpan
ck_retarget|||
ck_return|||
ck_rfun|||
ck_rvconst|||
ck_sassign|||
ck_select|||
ck_shift|||
ck_sort|||
ck_spair|||
ck_split|||
ck_subr|||
view all matches for this distribution
view release on metacpan or search on metacpan
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(SOCK, $paddr) || die "connect: $!";
# SOCK->autoflush(1);
my $ofh = select SOCK;
$| = 1;
select $ofh;
my $Query = join("\r\n", # "CRLF"
"GET $Desired HTTP/1.1",
# Do we need a Host: header with an "AbsoluteURI?"
# not needed: http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html#sec5.2
# but this is trumped by an Apache error message invoking RFC2068 sections 9 and 14.23
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AIX/LVM.pm view on Meta::CPAN
my $reader_h = new IO::Handle;
my $error_h = new IO::Handle;
my $pid = open3($writer_h, $reader_h, $error_h, @_) or croak "Not able to open3: $! \n";
$reader_h->autoflush();
$error_h->autoflush();
my $selector = IO::Select->new();
$selector->add($reader_h, $error_h); ## Add the handlers to select call ##
while( my @ready = $selector->can_read ){
foreach my $fh ( @ready ){
if( fileno($fh) == fileno($reader_h) ){
my $ret = $reader_h->sysread($_, 1024);
$result .= $_;
$selector->remove($fh) unless $ret;
}
if( fileno($fh) == fileno($error_h) ){
my $ret = $error_h->sysread($_, 1024);
$error .= $_;
$selector->remove($fh) unless $ret;
}
}
}
$reader_h->autoflush();
$error_h->autoflush();
view all matches for this distribution
view release on metacpan or search on metacpan
ck_retarget|||
ck_return|||
ck_rfun|||
ck_rvconst|||
ck_sassign|||
ck_select|||
ck_shift|||
ck_sort|||
ck_spair|||
ck_split|||
ck_subr|||
view all matches for this distribution
view release on metacpan or search on metacpan
lib/LiteratureBasedDiscovery/Discovery.pm view on Meta::CPAN
my $db = $cuiFinder->_getDB();
# retreive the table as a nested hash where keys are CUI1,
# then CUI2, value is N11
my @keyFields = ('cui_1', 'cui_2');
my $matrixRef = $db->selectall_hashref(
"select * from $tableName", \@keyFields);
# set values of the loaded table to n_11
# ...default is hash of hash of hash
foreach my $key1(keys %{$matrixRef}) {
foreach my $key2(keys %{${$matrixRef}{$key1}}) {
view all matches for this distribution
view release on metacpan or search on metacpan
ck_require|||
ck_return|||
ck_rfun|||
ck_rvconst|||
ck_sassign|||
ck_select|||
ck_shift|||
ck_sort|||
ck_spair|||
ck_split|||
ck_subr|||
view all matches for this distribution
view release on metacpan or search on metacpan
doc/examples/petmarket/petmarket/api/cartservice.pm view on Meta::CPAN
my ($self) = @_;
my ($id, $count);
do
{
$id = "cart" . time() . "." . (int(rand 1000000) + 1);
my $ary_ref = $self->dbh->selectall_arrayref("SELECT count(*) FROM cart_details WHERE cartid = '$id'");
$count = $ary_ref->[0]->[0];
}
while ($count > 0);
$self->dbh->do("INSERT INTO cart_details SET cartid='$id'");
doc/examples/petmarket/petmarket/api/cartservice.pm view on Meta::CPAN
#TODO - where does the item quantity come from?
sub getCartItems
{
my ($self, $cartid) = @_;
my @result;
my $ary_ref = $self->dbh->selectall_arrayref("SELECT d.quantity, a.productid, a.itemid, unitcost, b.descn, attr1, c.name,e.catid FROM item a, item_details b, product_details c, cart_details d, product e WHERE a.itemid=b.itemid AND a.productid= c....
foreach my $rowRef (@$ary_ref)
{
my ($cartQuantity, $productid, $itemid, $unitcost, $descn, $attr, $productname, $catid) = @$rowRef;
my @row;
push @row, $itemid;
doc/examples/petmarket/petmarket/api/cartservice.pm view on Meta::CPAN
sub getCartTotal
{
my ($self, $cartid) = @_;
my ($count, $total);
my $ary_ref = $self->dbh->selectall_arrayref("SELECT unitcost, quantity FROM cart_details a, item_details b WHERE a.itemid=b.itemid AND a.cartid='$cartid'");
foreach my $rowRef (@$ary_ref)
{
my ($unitcost, $quantity) = @$rowRef;
$total += $quantity * $unitcost;
$count += $quantity;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/API/CPanel/Mysql.pm view on Meta::CPAN
# temporary => CREATE TEMPORARY TABLES
# routine => CREATE ROUTINE
# create => CREATE
# delete => DELETE
# drop => DROP
# select => SELECT
# insert => INSERT
# update => UPDATE
# references => REFERENCES
# index => INDEX
# lock => LOCK TABLES
view all matches for this distribution
view release on metacpan or search on metacpan
lib/API/DirectAdmin.pm view on Meta::CPAN
ip => $ip,
});
# Switch off account:
my $suspend_result = $da->user->disable( {
select0 => $user_name,
} );
if ( $suspend_result->{error} == 1 ) {
die "Cannot suspend account $suspend_result->{text}";
}
# Switch on account
my $resume_result = $da->user->enable( {
select0 => $user_name,
} );
if ( $resume_result->{error} == 1 ) {
die "Cannot Resume account $resume_result->{text}";
}
# Delete account
my $delete_result = $da->user->delete( {
select0 => $user_name,
} );
if ( $delete_result->{error} == 1 ) {
die "Cannot delete account $delete_result->{text}";
}
lib/API/DirectAdmin.pm view on Meta::CPAN
=item delete
Delete DirectAdmin user and all user's data
Note: Some DirectAdmin's API methods required parameter "select0" for choose value from list. Like list of users, databases, ip, etc.
Example:
my $result = $da->user->delete( {
select0 => 'username',
} );
=item disable/enable
Two different methods for disable and enable users with same params.
Example:
my $disable_result = $da->user->disable( {
select0 => 'username',
} );
my $enable_result = $da->user->enable( {
select0 => 'username',
} );
=item change_password
Change password for user
lib/API/DirectAdmin.pm view on Meta::CPAN
passwd2 => 'password',
} );
=item deldb
Delete selected database from user.
Example:
my $result = $da->mysql->deldb({ select0 => 'database_name' });
=back
=head2 API::DirectAdmin::Ip
lib/API/DirectAdmin.pm view on Meta::CPAN
Remove ip from server
Example:
my $result = $da->ip->remove({
select0 => '123.234.123.234',
});
=back
=head2 API::DirectAdmin::DNS
view all matches for this distribution
view release on metacpan or search on metacpan
lib/API/INSEE/Sirene.pm view on Meta::CPAN
my $response_json = $sirene->getLegalUnitBySIREN(123456789, 'dateCreationUniteLegale');
# or
my $response_json = $sirene->getLegalUnitBySIREN(123456789, 'all');
When you don't specify any desired field, the module returns a selection of fields that are most likely to interest you. (see C<$useful_fields_legal_unit> and C<$useful_fields_establishment> in source code to find out which ones)
If you want all fields, you have to specify it explicitly by passing the value 'all' as parameter.
=head1 RETURN VALUES
view all matches for this distribution
view release on metacpan or search on metacpan
lib/API/Plesk.pm view on Meta::CPAN
my ( $self, $classes ) = @_;
my $version = version->parse($self->{api_version});
for my $item ( @$classes ) {
# select compitable version of component
if ( $version >= $item->[0] ) {
my $pkg = 'API::Plesk::' . $item->[1];
my $module = "$pkg.pm";
view all matches for this distribution
view release on metacpan or search on metacpan
lib/API/PleskExpand/Accounts.pm view on Meta::CPAN
=item create()
Params:
'select' => 'optimal',
'template-id' => 1,
'attach_to_template' => 1, # attach account to a certain template
'general_info' => {
login => 'plesk_login',
pname => 'perldonal name',
lib/API/PleskExpand/Accounts.pm view on Meta::CPAN
state => '', # state, for USA only
pcode => '',
country => 'RU',
}
You can let Plesk Expand automatically select a Plesk server based on certain filtering parameters (params for 'select' field):
'optimal' -- Least Integral Estimate (% used) selects the least loaded server (integrally estimated).
'min_domains' -- Least Domains (% used) registers a client on the server with the minimum number of domains.
'max_diskspace' -- Least Disk Space (% used) registers a client on the server with the minimum disk space used.
'' -- Select manually, Specify the target Plesk server by selecting its name from the list.
When choosing a 'manual' (select => '') option you should set server_id!
For 'optimal', 'min_domains', 'max_diskspace' you can ask additional server group id ('group_id' params) or server keyword ('server_keyword' param);
Return (Data::Dumper output):
lib/API/PleskExpand/Accounts.pm view on Meta::CPAN
( $params{'attach_to_template'} ? create_node('attach_to_template', '') : '' );
} else {
return ''; # template required
}
my $select = '';
if ($params{'select'}) {
if ( $params{'group_id'} ) {
$select = create_node( 'server_auto', create_node( $params{'select'}, '') .
create_node( 'group_id', $params{'group_id'} )
);
} elsif ( $params{'server_keyword'} ) {
$select = create_node( 'server_auto', create_node( $params{'select'}, '') ).
create_node( 'server_keyword', $params{'server_keyword'} );
} else {
$select = create_node( 'server_auto', create_node( $params{'select'}, '') );
}
} else {
if ( $params{'server_id'} ) {
$select = create_node( 'server_id', $params{'server_id'} );
} else {
return ''; # server_id required!
}
}
return create_node( 'add_use_template',
generate_info_block('gen_info', %{ $params{'general_info'} } ) . '<!-- create_client -->' . $template . $select);
} else {
return ''; # not enought data
}
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Arc/Connection.pm view on Meta::CPAN
__linequeue => [], # internal line buffer (idea From Net::Cmd)
__partial => "", # a partial line (idea From Net::Cmd)
# protected:
_connection => undef, # IO::Socket for the ARCv2 Connection
_cmdclientsock => undef, # IO::Socket for the command connection (encrypted)
_select => undef, # IO::Select for the ARCv2 Connection
_authenticated => 0, # Are we authenticated
#_sasl => undef, # Authen::SASL::Cyrus Handle
#_saslmech => "", # SASL mechnanism used at authentication
lib/Arc/Connection.pm view on Meta::CPAN
close($locout) unless $stop; # Local pipe is not needed anymore
}
last if $stop;
} else {
# select the appropriate write-"select"
my $tsel = $r->fileno == $locin->fileno ? $nwsel : $lwsel;
# encryption, decode or encode
$buf = $r->fileno == $locin->fileno ?
$this->{_sasl}->encode($buf) :
$this->{_sasl}->decode($buf);
lib/Arc/Connection.pm view on Meta::CPAN
my $this = shift;
return unless @_;
my $line = join("",@_);
$line =~ s/\r//g;
$line =~ s/\n/ /g;
return $this->_SetError("SendLine only available when connection and select is set.") unless $this->{_connected};
if ($this->{_select}->can_write($this->{timeout})) {
$this->_Debug(substr ($line,0,30),"..");
$line .= "\015\012";
# encrypt if necessary
$line = $this->{_sasl}->encode($line)
lib/Arc/Connection.pm view on Meta::CPAN
my $this = shift;
return shift @{$this->{__linequeue}} if scalar @{$this->{__linequeue}};
# no connection is set not connected
return $this->_SetError("RecvCommand only Available when connection and select is set.") unless $this->{_connected};
my $partial = defined($this->{__partial}) ? $this->{__partial} : "";
my $buf = "";
until (scalar @{$this->{__linequeue}}) {
if ($this->{_select}->can_read($this->{timeout})) { # true if select thinks there is data
my $inbuf;
unless ($this->{_connection}->sysread($inbuf,4096)) {
$this->{_connected} = 0;
$this->{_connection}->close();
return $this->_SetError("Connection closed by foreign host.");
view all matches for this distribution
view release on metacpan or search on metacpan
examples/generate_fid_hash.pl view on Meta::CPAN
print "Enter the name of the Remedy form: ";
my $form = <STDIN>;
chomp $form;
#----------
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
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ARSObject.pm view on Meta::CPAN
: '')
: '')
.' ORDER BY ' .$s->{-dbi}->quote_identifier($mts) .' ASC '
.', ' .$s->{-dbi}->quote_identifier($mpk) .' ASC ';
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
$lm =$s->{-dbi}->selectcol_arrayref($sql,{'MaxRows'=>$arg{-lim_rf}});
return(&{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'selectcol_arrayref',$sql)))
if !$lm && $s->{-dbi}->errstr;
# print $s->dsquot($lm),"\n";
# die('TEST')
# -form=>'HPD:HelpDesk_AuditLogSystem'
# ,-master=>'HPD:Help Desk', -master_pk=>'Entry ID',-master_fk=>'Original Request ID', -master_ts=>'Last Modified Date'
lib/ARSObject.pm view on Meta::CPAN
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 =>
# -filter=> undef
# -undefs=>1
# -strFields=>1|0
lib/ARSObject.pm view on Meta::CPAN
,(ref($arg{-fields})
? join(', ', map {$s->{-dbi}->quote_identifier($m->{-fields}->{$_} || $m->{-ids}->{$_} || $_)
} @{$arg{-fields}})
: $arg{-fields} && ($arg{-fields} ne '*')
? dbidsqq($s, $arg{-fields}, $m)
: ($arg{-fields} ||$arg{-select} ||'*')
)
,'FROM'
,($arg{-from}
? $arg{-from}
: join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $s->sqlname($arg{-form})))
lib/ARSObject.pm view on Meta::CPAN
);
print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
local $s->{-dbi}->{LongReadLen} =$s->{-dbi}->{LongReadLen} <= 1024 ? 4*64*1024 : $s->{-dbi}->{LongReadLen};
my $h =$s->dbiquery($sql);
my $xu=exists($arg{-undefs}) && !$arg{-undefs};
my $yc=$arg{-select} ||ref($arg{-fields})
|| ($arg{-fields} && ($arg{-fields} eq '*'));
my $ys=defined($arg{-strFields}) ? $arg{-strFields} : $s->{-strFields};
local $s->{-strFields} =defined($arg{-strFields}) ? $arg{-strFields} : $s->{-strFields};
my ($r, $r1, @r);
while ($r =$h->fetchrow_hashref()) {
lib/ARSObject.pm view on Meta::CPAN
sub cgistring { # CGI string field
$_[0]->{-cgi}->textfield(@_[1..$#_])
}
sub cgiselect { # CGI selection field composition
# -onchange=>1 reloads form
my ($s, %a) =@_;
my $cs =$a{-onchange} && (length($a{-onchange}) ==1);
($cs
? '<input type="hidden" name="' .$a{-name} .'__C_" value="" />'
lib/ARSObject.pm view on Meta::CPAN
: '')
}
sub cgiddlb { # CGI drop-down listbox field composition
# -strict=> - disable text edit, be alike cgiselect
my ($s, %a) =@_;
$s->cgi();
my $n =$a{-name};
my $nl="${n}__L_";
my $av=sub{ return($a{-values}) if $a{-values};
lib/ARSObject.pm view on Meta::CPAN
.($_[0] eq '4' ? '' : 'return(true)') .'}else{'
.(!$_[0] # onkeypess - input
? "if (String.fromCharCode($ek) ==\"\\r\") {${n}__S_.focus(); ${n}__S_.click(); return(true)}; k=window.document.forms[0].$n.value +String.fromCharCode($ek);"
: $_[0] eq '1' # onkeypess - list -> input (first char)
? "if (String.fromCharCode($ek) ==\"\\r\") {${n}__S_.focus(); ${n}__S_.click(); return(true)}; window.document.forms[0].$n.focus(); k=window.document.forms[0].$n.value =String.fromCharCode($ek); "
: $_[0] eq '2' # onkeypess - list -> prompt (selected char)
# ? "k=prompt('Enter search string',String.fromCharCode($ek));"
? "if (String.fromCharCode($ek) ==\"\\r\") {${n}__S_.focus(); ${n}__S_.click(); return(true)}; k =String.fromCharCode($ek); for (var i=0; i <l.length; ++i) {if (l.options.item(i).value.toLowerCase().indexOf(k)==0 || l.options.item(i).text....
: $_[0] eq '3' # button - '..'
? "k=prompt('Enter search substring',''); $nl.focus();"
: $_[0] eq '4' # onload - document
? "k=window.document.forms[0].$n.value; window.document.forms[0].$nl.focus();"
: ''
lib/ARSObject.pm view on Meta::CPAN
.($_[0] eq '3' ?'>=' :'==') .'0 : l.options.item(i).value.toLowerCase().indexOf(k)'
.($_[0] eq '3' ?'>=' :'==') .'0){'
: "if (l.options.item(i).text !='' ? l.options.item(i).text.toLowerCase().indexOf(k)"
.($_[0] eq '3' ?'>=' :'==') .'0 : l.options.item(i).value.toLowerCase().indexOf(k)'
.($_[0] eq '3' ?'>=' :'==') .'0){')
.'l.selectedIndex =i; break;};}};'
.($_[0] && ($_[0] ne '4')
? 'return(false);'
: $_[0] && ($_[0] eq '2')
? 'return(false);'
: '')
lib/ARSObject.pm view on Meta::CPAN
)
.($s->{-cgi}->param("${n}__O_")
? ("<input type=\"submit\" name=\"${n}__X_\" value=\"X\" title=\"close\"$ac$as />"
."<input type=\"hidden\" name=\"${n}__P_\" value=\"" .(defined($v) ? $s->{-cgi}->escapeHTML($v) : '') ."\"$ac$as />\n"
."<br />\n"
."<select name=\"${n}__L_\" title=\"select value\" size=\"10\""
."$ac$as"
." ondblclick=\"{${n}__S_.focus(); ${n}__S_.click(); return(true)}\""
." onkeypress=\"" .($s->{-cgi}->user_agent('MSIE') ? &$fs(1) : &$fs(2))
."\">\n"
.join('',map {'<option'
.((defined($v) ? $v : '') eq (defined($_) ? $_ : '') ? ' selected' : '')
.' value="' .$s->{-cgi}->escapeHTML(defined($_) ? $_ : '') .'">'
.$s->{-cgi}->escapeHTML(
!defined($_)
? ''
: !$a{-labels}
? (length($_) > $aw ? substr($_,0,$aw) .'...' : $_)
: defined($a{-labels}->{$_})
? (length($a{-labels}->{$_}) > $aw ? substr($a{-labels}->{$_},0,$aw) .'...' : $a{-labels}->{$_})
: '') ."</option>\n"
} @{&$av()})
."</select>\n"
."<input type=\"submit\" name=\"${n}__S_\" value=\"<\" title=\"set\"$ac$as />"
.$s->{-cgi}->button(-value=>'...', -title=>'find', -onClick=>&$fs(3))
."<input type=\"submit\" name=\"${n}__X_\" value=\"X\" title=\"close\"$ac$as />"
."</div>\n"
."<script for=\"window\" event=\"onload\">{window.document.forms[0].${n}__L_.focus()}</script>"
lib/ARSObject.pm view on Meta::CPAN
? &{$f->{-widget}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
: !$f->{-namecgi}
? ''
: ref($f->{-widget}) eq 'HASH'
? ( $f->{-values}
? $s->cgiselect(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -onchange=>1
, map {defined($f->{$_}) ? ($_=>$f->{$_}) : ()} qw(-values -labels)
, -id => $f->{-namecgi}
, %{$f->{-widget}})
: $f->{-rows}
lib/ARSObject.pm view on Meta::CPAN
: $s->cgistring(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, %{$f->{-widget}})
)
: ( $f->{-values}
? $s->cgiselect(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, -onchange=>1
, map { my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
defined($v) ? ($_=>$v) : ()} qw(-values -labels -onchange -readonly -disabled -class -style))
: $f->{-rows}
view all matches for this distribution
view release on metacpan or search on metacpan
# $retval[ENUM]->{TIME}
#
# so if you have a status field that has two states: Open and Closed,
# where Open is enum 0 and Closed is enum 1, this routine will return:
#
# $retval[0]->{USER} = the user to last selected this enum
# $retval[1]->{TIME} = the time that this enum was last selected
#
# You can map from enum values to selection words by using
# arsGetField().
sub ars_decodeStatusHistory {
my ($sval) = shift;
my ($enum) = 0;
view all matches for this distribution
view release on metacpan or search on metacpan
applications/archive.pl view on Meta::CPAN
$day = get_day ($eventsAgo);
$timeslot = timelocal ( 0, 0, 0, $day, ($month-1), ($year-1900) );
if ($debug) {
$sql = "select SQL_NO_CACHE catalogID, id, endDate, startDate, timeslot, uKey from $SERVERTABLEVENTS force index (key_timeslot) where timeslot < '" .$timeslot. "'";
print "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot', Date: " .scalar(localtime($timeslot)). "\n<$sql>\n";
} else {
$sql = "select SQL_NO_CACHE catalogID, id, endDate from $SERVERTABLEVENTS force index (key_timeslot) where timeslot < '" .$timeslot. "'";
print EMAILREPORT "\nTable: '$SERVERTABLEVENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot'\n";
}
$sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
applications/archive.pl view on Meta::CPAN
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
}
$sql = "select SQL_NO_CACHE distinct $SERVERTABLCOMMENTS.catalogID, $SERVERTABLCOMMENTS.uKey, $SERVERTABLCOMMENTS.commentData from $SERVERTABLCOMMENTS, $SERVERTABLPLUGINS, $SERVERTABLVIEWS, $SERVERTABLDISPLAYDMNS, $SERVERTABLCRONTABS as crontabOu...
if ($debug) {
print "\nUpdate table '$SERVERTABLCOMMENTS': <$sql>\n";
} else {
print EMAILREPORT "\nUpdate table '$SERVERTABLCOMMENTS': <$sql>\n";
applications/archive.pl view on Meta::CPAN
$month = get_month ($commentsAgo);
$day = get_day ($commentsAgo);
$timeslot = timelocal ( 0, 0, 0, $day, ($month-1), ($year-1900) );
$sql = "select SQL_NO_CACHE catalogID, id, solvedDate, solvedTimeslot, uKey from $SERVERTABLCOMMENTS force index (solvedTimeslot) where problemSolved = '1' and solvedTimeslot < '" .$timeslot. "'";
if ($debug) {
print "\nTable: '$SERVERTABLCOMMENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot', Date: " .scalar(localtime($timeslot)). "\n<$sql>\n";
} else {
print EMAILREPORT "\nTable: '$SERVERTABLCOMMENTS', Year: '$year', Month: '$month', Day: '$day', Timeslot: '$timeslot'\n";
view all matches for this distribution
view release on metacpan or search on metacpan
}
$VERSION='1.07';
$ASPOUT = tie *RESPONSE_FH, 'ASP::IO';
select RESPONSE_FH unless $APACHE;
$SIG{__WARN__} = sub { ASP::Print(@_) };
sub _END { &$_() for @DeathHooks; @DeathHooks = (); 1; }
=head1 NAME
print "Testing, testing.<BR><BR>";
my $item = param('item');
if($item eq 'Select one...') {
die "Please select a value from the list.";
}
print "You selected $item.";
exit;
=head1 DESCRIPTION
This module is based on Matt Sergeant's excellent
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ASP4.pm view on Meta::CPAN
<div style="float: right; width: 40%; border: dotted 1px #000;">
<h3>Send New Message</h3>
<form id="send_form" method="post" action="/handlers/app.send">
<p>
<label>Recipient:</label>
<select name="to_user_id">
<%
my @users = App::db::user->search_where({
user_id => {'!=' => $user->id }
}, {
order_by => "email"
lib/ASP4.pm view on Meta::CPAN
%>
<option value="<%= $user->id %>"><%= $Server->HTMLEncode( $user->email ) %></option>
<%
}# end foreach()
%>
</select>
</p>
<p>
<label>Subject:</label>
<input type="text" name="subject" maxlength="100" />
</p>
view all matches for this distribution
view release on metacpan or search on metacpan
runtests.sh view on Meta::CPAN
#!/bin/sh
cover --delete
PERL5OPT=-MDevel::Cover=+select_re,/tmp/PAGE_CACHE/ASP4xLinker,+select_re,handlers,+select_re,htdocs,+ignore,.*\.t,-ignore,prove prove t -r
cover
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/Lambda.pm view on Meta::CPAN
Create a new function and give it a name and an IAM Role.
=item 3
For the "Runtime" selection, select B<Provide your own bootstrap on Amazon Linux 2>.
=item 4
In the "Designer" section of your function dashboard, select the B<Layers> box.
=item 5
Scroll down to the "Layers" section and click B<Add a layer>.
lib/AWS/Lambda.pm view on Meta::CPAN
Create a new layer and give it a name.
=item 3
For the "Code entry type" selection, select B<Upload a file from Amazon S3>.
=item 4
In the "License" section, input L<https://github.com/shogo82148/p5-aws-lambda/blob/main/LICENSE>.
view all matches for this distribution