Result:
found more than 344 distributions - search limited to the first 2001 files matching your query
( run in 2.893 )
AI-NeuralNet-Kohonen-Visual
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}){
AI-NeuralNet-Mesh
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 ){
AI-ParticleSwarmOptimization-MCE
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;
AI-ParticleSwarmOptimization-Pmap
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;
AI-ParticleSwarmOptimization
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
AI-Pathfinding-AStar-Rectangle
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
AI-Pathfinding-OptimizeMultiple
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",
),
AI-Pathfinding-SMAstar
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;
AI-TensorFlow-Libtensorflow
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 );
AIIA-GMT
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|||
AIS-client
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
AIX-LVM
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();
AIX-Perfstat
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|||
ALBD
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}}) {
ALPM
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|||
AMF-Perl
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;
API-CPanel
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
API-DirectAdmin
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
API-Docker
view release on metacpan or search on metacpan
lib/API/Docker/Role/HTTP.pm view on Meta::CPAN
# Whether the connect that has just failed failed because the bound fired.
# Asked with nothing in between, because $@ and $! are the whole of the
# evidence and both are global.
#
# $@ rather than errno: IO::Socket writes 'connect: timeout' there, and only
# there, when its own select() ran out -- measured, against a host that drops
# SYNs, where $! is ETIMEDOUT, which the kernel also produces on its own after
# two minutes with no Timeout set at all.
#
# EAGAIN is the second shape and belongs to unix:// alone. Measured against a
# listener whose backlog is full: with no Timeout the connect blocks
lib/API/Docker/Role/HTTP.pm view on Meta::CPAN
sub _connect_timeout_value {
my ($self, $timeout) = @_;
return $self->_timeout_value('connect_timeout', $timeout);
}
# Why SO_RCVTIMEO and not select(): a bound that reads the socket cannot see
# what is already buffered above it, and would fire while the data it was
# waiting for was in hand. That was true of PerlIO's read-ahead when this was
# written (measured: after one readline of a socket holding
# "one\ntwo\nthree\n", two whole lines sit in the PerlIO buffer and select()
# says the handle is not ready), and it is true of _read_buffer now. A
# select-based bound would have to be asked only when that buffer is empty,
# which is one more invariant to keep for no gain: SO_RCVTIMEO bounds the one
# syscall in _pull for one setsockopt, and gets idle-since-the-last-byte
# semantics for free, which is the semantics these endpoints need (karr k52:
# the buffered frames arrive, and *then* the socket stalls -- a
# time-to-first-byte bound would never fire).
lib/API/Docker/Role/HTTP.pm view on Meta::CPAN
#
# Why it could not be fixed at the one site that had the bug: _read_head read
# the status line and the headers with <$sock>, and PerlIO reads ahead. The
# bytes past the header block were sitting in a buffer this code cannot reach
# -- there is no supported way to take them back out; ungetc is layer-
# dependent, seek does not work on a socket, and select/MSG_PEEK see the
# kernel's buffer rather than PerlIO's. So switching only the body reads to
# sysread would have silently dropped the start of every body. Either all read
# sites move together or none do.
#
# The buffer lives on the handle rather than on the client or in the context:
API-INSEE-Sirene
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
API-Plesk
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";
API-PleskExpand
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
}
}
ARCv2
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.");
ARS-Simple
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
ARSObject
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}
ARSperl
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;
ASNMTAP
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";
ASP
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
ASP4
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>
ASP4x-Linker
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
( run in 2.893 seconds using v1.01-cache-2.11-cpan-e623d60df62 )