view release on metacpan or search on metacpan
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
);
### use OUR stdin, not $kidin. Somehow,
### we never get the input.. so jump through
### some hoops to do it :(
my $selector = IO::Select->new(
(IS_WIN32 ? \*STDERR : $kiderror),
\*STDIN,
(IS_WIN32 ? \*STDOUT : $kidout)
);
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
$kidout->autoflush(1) if UNIVERSAL::can($kidout, 'autoflush');
$kiderror->autoflush(1) if UNIVERSAL::can($kiderror, 'autoflush');
### add an epxlicit break statement
### code courtesy of theorbtwo from #london.pm
OUTER: while ( my @ready = $selector->can_read ) {
for my $h ( @ready ) {
my $buf;
### $len is the amount of bytes read
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Align/Sequence.pm view on Meta::CPAN
my $Ycurrent = -1;
my $Xtemp;
my $Ytemp;
my @L; # LCS
my $R = 0; # records the position of last selected symbol
my $i;
my $Pi;
my $Pi1;
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/AlignDB/SQL.pm view on Meta::CPAN
use YAML qw(Dump Load DumpFile LoadFile);
with Storage( 'format' => 'YAML' );
our $VERSION = '1.0.2';
has 'select' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'select_map' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
has 'select_map_reverse' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
has 'from' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'joins' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'where' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'bind' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
has 'limit' => ( is => 'rw', isa => 'Int' );
lib/AlignDB/SQL.pm view on Meta::CPAN
has 'where_values' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
has '_sql' => ( is => 'rw', isa => 'Str', default => '' );
has 'indent' => ( is => 'rw', isa => 'Str', default => ' ' x 2 );
has 'replace' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
sub add_select {
my $self = shift;
my ( $term, $col ) = @_;
$col ||= $term;
push @{ $self->select }, $term;
$self->select_map->{$term} = $col;
$self->select_map_reverse->{$col} = $term;
}
sub add_join {
my $self = shift;
my ( $table, $joins ) = @_;
lib/AlignDB/SQL.pm view on Meta::CPAN
sub as_header {
my $self = shift;
my @terms;
if ( @{ $self->select } ) {
my %select_map = %{ $self->select_map };
for my $term ( @{ $self->select } ) {
if ( exists $select_map{$term} ) {
my $alias = $select_map{$term};
push @terms, $alias;
}
else {
push @terms, $term;
}
lib/AlignDB/SQL.pm view on Meta::CPAN
my $self = shift;
my $indent = $self->indent;
my $sql = '';
if ( @{ $self->select } ) {
my %select_map = %{ $self->select_map };
my @terms;
for my $term ( @{ $self->select } ) {
if ( exists $select_map{$term} ) {
my $alias = $select_map{$term};
# add_select( 'f.foo' => 'foo' ) ===> f.foo
# add_select( 'COUNT(*)' => 'count' ) ===> COUNT(*) count
if ( $alias and $term =~ /(?:^|\.)\Q$alias\E$/ ) {
push @terms, $term;
}
else {
push @terms, "$term $alias";
lib/AlignDB/SQL.pm view on Meta::CPAN
sub add_having {
my $self = shift;
my ( $col, $val ) = @_;
if ( my $orig = $self->select_map_reverse->{$col} ) {
$col = $orig;
}
my ( $term, $bind ) = $self->_mk_term( $col, $val );
push @{ $self->{having} }, "($term)";
lib/AlignDB/SQL.pm view on Meta::CPAN
AlignDB::SQL - An SQL statement generator.
=head1 SYNOPSIS
my $sql = AlignDB::SQL->new();
$sql->select([ 'id', 'name', 'bucket_id', 'note_id' ]);
$sql->from([ 'foo' ]);
$sql->add_where('name', 'fred');
$sql->add_where('bucket_id', { op => '!=', value => 47 });
$sql->add_where('note_id', \'IS NULL');
$sql->limit(1);
my $sth = $dbh->prepare($sql->as_sql);
$sth->execute(@{ $sql->{bind} });
my @values = $sth->selectrow_array();
my $obj = SomeObject->new();
$obj->set_columns(...);
=head1 DESCRIPTION
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Capture/Tiny.pm view on Meta::CPAN
my ($which, $stash) = @_; # $which is "stdout" or "stderr"
# setup pipes
$stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
pipe $stash->{reader}{$which}, $stash->{tee}{$which};
# _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
# setup desired redirection for parent and child
$stash->{new}{$which} = $stash->{tee}{$which};
$stash->{child}{$which} = {
stdin => $stash->{reader}{$which},
stdout => $stash->{old}{$which},
view all matches for this distribution
view release on metacpan or search on metacpan
B<list_attributes()> returns the names of all declared attributes. The
B<attribute()> method returns the type of the specified attribute, or an
undefined value if the attribute is not declared. I<$type> is one of
C<'p'> (B<positional>), C<'s'> (B<structural>), or C<'a'> (B<alignment>).
Passing one of these type codes to B<list_attributes()> will return
attributes of the selected type only.
=cut
sub list_attributes ( $;$ ) {
my ($self, $type) = @_;
view all matches for this distribution
view release on metacpan or search on metacpan
KEY_s|5.003007||Viu
KEY_say|5.009003||Viu
KEY_scalar|5.003007||Viu
KEY_seek|5.003007||Viu
KEY_seekdir|5.003007||Viu
KEY_select|5.003007||Viu
KEY_semctl|5.003007||Viu
KEY_semget|5.003007||Viu
KEY_semop|5.003007||Viu
KEY_send|5.003007||Viu
KEY_setgrent|5.003007||Viu
PerlSock_listen|5.005000||Viu
PerlSock_ntohl|5.005000||Viu
PerlSock_ntohs|5.005000||Viu
PerlSock_recv|5.005000||Viu
PerlSock_recvfrom|5.005000||Viu
PerlSock_select|5.005000||Viu
PerlSock_send|5.005000||Viu
PerlSock_sendto|5.005000||Viu
PerlSock_sethostent|5.005000||Viu
PerlSock_setnetent|5.005000||Viu
PerlSock_setprotoent|5.005000||Viu
seedDrand01|5.006000|5.006000|
SEEK_CUR|5.003007||Viu
seekdir|5.005000||Viu
SEEK_END|5.003007||Viu
SEEK_SET|5.003007||Viu
select|5.005000||Viu
Select_fd_set_t|5.003007|5.003007|Vn
SELECT_MIN_BITS|5.005003|5.005003|Vn
Semctl|5.004005||Viu
semun|5.006000||Viu
send|5.005000||Viu
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Crypt/RSA/Key.pm view on Meta::CPAN
# Switch from Maurer prime to nbit prime, then add some more primality
# testing. This is faster and gives us a wider set of possible primes.
# We really ought to consider the distribution. See:
# https://crocs.fi.muni.cz/_media/public/papers/usenixsec16_1mrsakeys_trfimu_201603.pdf
# for comments on p/q selection.
while (1) {
my $p = random_nbit_prime($size);
my $q = random_nbit_prime($size);
$p = Math::BigInt->new("$p") unless ref($p) eq 'Math::BigInt';
view all matches for this distribution
view release on metacpan or search on metacpan
0.003 2014-12-31 00:39:04-0600
- add a role for Rlike data frames
* support for methods: head(), tail(), subset()
- use MooX::Traits to support loading roles easily
- fix: select_rows() with no arguments should return an empty Data::Frame
- bump PDL version to use its `unpdl()` method
- Column::Helper now uses AUTOLOAD to make accessing columns easier in `subset()`
0.002 2014-12-25 03:34:04-0600
- fix stringifiable length test
view all matches for this distribution
view release on metacpan or search on metacpan
inc/TestML/Runtime.pm view on Meta::CPAN
}
}
sub run_statement {
my ($self, $statement) = @_;
my $blocks = $self->select_blocks($statement->points || []);
for my $block (@$blocks) {
$self->function->setvar('Block', $block) if $block != 1;
my $result = $self->run_expression($statement->expr);
if (my $assert = $statement->assert) {
$self->run_assertion($result, $assert);
inc/TestML/Runtime.pm view on Meta::CPAN
}
$value =~ s/^\\//gm;
return TestML::Str->new(value => $value);
}
sub select_blocks {
my ($self, $wanted) = @_;
return [1] unless @$wanted;
my $selected = [];
OUTER: for my $block (@{$self->function->data}) {
my %points = %{$block->points};
next if exists $points{SKIP};
if (exists $points{ONLY}) {
for my $point (@$wanted) {
return [] unless exists $points{$point};
}
$selected = [$block];
last;
}
for my $point (@$wanted) {
next OUTER unless exists $points{$point};
}
push @$selected, $block;
last if exists $points{LAST};
}
return $selected;
}
sub compile_testml {
my ($self) = @_;
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Capture/Tiny.pm view on Meta::CPAN
my ($which, $stash) = @_; # $which is "stdout" or "stderr"
# setup pipes
$stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
pipe $stash->{reader}{$which}, $stash->{tee}{$which};
# _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
# setup desired redirection for parent and child
$stash->{new}{$which} = $stash->{tee}{$which};
$stash->{child}{$which} = {
stdin => $stash->{reader}{$which},
stdout => $stash->{old}{$which},
view all matches for this distribution
view release on metacpan or search on metacpan
lib/NewRelic/Agent/FFI/Procedural.pm view on Meta::CPAN
my $seg = newrelic_segment_datastore_begin $tx, $parent_seg, $table, $operation, $sql, $sql_trace_rollup_name;
my $seg = newrelic_segment_datastore_begin $tx, $parent_seg, $table, $operation, $sql, $sql_trace_rollup_name, $sql_obfuscator;
Begins a new datastore segment. C<$parent_seg> is a parent segment id (C<undef> no parent). C<$operation> should be
one of C<select>, C<insert>, C<update> or C<delete>.
If you want to provide your own obfuscator, you need to pass in the address of a C function. To do that from Perl you can
create a closure with L<FFI::Platypus>, like so:
use 5.010;
view all matches for this distribution
view release on metacpan or search on metacpan
}
while( my($chromo, $rna) = each %zygote ) {
$call_sym_table->{$chromo} = $rna->[rand @$rna];
print $Grunts[rand @Grunts], "\n";
#select(undef, undef, undef, 0.45);
}
# push @{$caller.'::ISA'}, @modules;
print "\n";
view all matches for this distribution
view release on metacpan or search on metacpan
t/Test/Builder.pm view on Meta::CPAN
}
sub _autoflush {
my($fh) = shift;
my $old_fh = select $fh;
$| = 1;
select $old_fh;
}
sub _dup_stdhandles {
my $self = shift;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Tickit/Widget/CheckButton.pm view on Meta::CPAN
Tickit->new( root => $vbox )->run;
=head1 DESCRIPTION
This class provides a widget which allows a true/false selection. It displays
a clickable indication of status and a caption. Clicking on the status or
caption inverts the status of the widget.
This widget is part of an experiment in evolving the design of the
L<Tickit::Style> widget integration code, and such is subject to change of
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
bin/linkBags view on Meta::CPAN
my $SORTCODE = "LC_ALL=en_US.UTF-8; export LC_ALL;" ;
############ END CONFIGURATION ######################
# autoflush
select((select(STDERR), $| = 1)[0]);
# encoding pragmas follow any includes like "use"
use encoding 'utf8';
use open ':utf8';
binmode STDIN, ":utf8";
bin/linkBags view on Meta::CPAN
close(IN);
close(OUT);
# we want to write to the front of the file,
# without destroying rest of contents, this open does it
sysopen(OUT, $tfile, O_RDWR) or die "Cannot reopen $tfile: $!";
my $oldfh = select(OUT); $| = 1; select($oldfh);
# now, rewrite header
print OUT sprintf("%8d\n%8d\n", $doccount, $featcount);
close(OUT);
print STDERR "\nNow build the document bags with mpdata\n";
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Alvis/Buffer.pm view on Meta::CPAN
# start new one
if ( ! open(ABUF,">>$BUFFER") ) {
print STDERR "Cannot open $BUFFER: $!\n";
return 0;
}
select((select(ABUF), $| = 1)[0]);
print ABUF $HEADER;
} else {
# check old one first
if ( ! open(ABUF,"<$BUFFER") ) {
print STDERR "Cannot open $BUFFER: $!\n";
lib/Alvis/Buffer.pm view on Meta::CPAN
# now open for append
if ( ! open(ABUF,">>$BUFFER") ) {
print STDERR "Cannot open $BUFFER: $!\n";
return 0;
}
select((select(ABUF), $| = 1)[0]);
}
1;
}
############################################
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Alvis/NLPPlatform/NLPWrappers.pm view on Meta::CPAN
my %corpus;
my %lc_corpus;
my $sent_id;
my $command_line;
my %corpus_index;
my %idtrm_select;
my @tab_results;
my $semtag;
my $token_start;
my $token_end;
lib/Alvis/NLPPlatform/NLPWrappers.pm view on Meta::CPAN
if (scalar(@term_list_FR) == 0) {
Alvis::TermTagger::load_TermList($h_config->{'NLP_misc'}->{'TERM_LIST_FR'},\@term_list_FR);
Alvis::TermTagger::get_Regex_TermList(\@term_list_FR, \@regex_term_list_FR);
}
Alvis::TermTagger::corpus_Indexing(\%lc_corpus, \%corpus_index);
Alvis::TermTagger::term_Selection(\%corpus_index, \@term_list_FR, \%idtrm_select);
Alvis::TermTagger::term_tagging_offset_tab(\@term_list_FR, \@regex_term_list_FR, \%idtrm_select, \%corpus, \%tabh_sent_terms);
} else {
if (scalar(@term_list_EN) == 0) {
Alvis::TermTagger::load_TermList($h_config->{'NLP_misc'}->{'TERM_LIST_EN'},\@term_list_EN);
Alvis::TermTagger::get_Regex_TermList(\@term_list_EN, \@regex_term_list_EN);
}
Alvis::TermTagger::corpus_Indexing(\%lc_corpus, \%corpus_index);
Alvis::TermTagger::term_Selection(\%corpus_index, \@term_list_EN, \%idtrm_select);
Alvis::TermTagger::term_tagging_offset_tab(\@term_list_EN, \@regex_term_list_EN, \%idtrm_select, \%corpus, \%tabh_sent_terms);
}
%lc_corpus = ();
%corpus_index = ();
%idtrm_select = ();
%corpus = ();
# TODO : taking into account the case where terms appear at least twice in a sentence
$i=0;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Alvis/Treetagger.pm view on Meta::CPAN
}
sleep(1);
if ( $verbose ) { print STDERR "Starting fifo input $FIFO.in\n"; }
open(FI,">$FIFO.in");
select((select(FI), $| = 1)[0]);
# send some stuff down the pipe to warm it up;
# note we add to extra "\n." two evey message
# to force TreeTagger to run the buffer
print FI "Start\nup\nnow\n.\n.\n.\n";
view all matches for this distribution
view release on metacpan or search on metacpan
bin/TermTagger-brat.pl view on Meta::CPAN
TermTagger-brat.pl -- A Perl script for tagging text with terms (Brat format output)
=head1 SYNOPSIS
TermTagger.pl [options] corpus termlist selected_term_list lemmatised_corpus
=head1 OPTIONS
=over 4
bin/TermTagger-brat.pl view on Meta::CPAN
This script tags a corpus with terms and provide a output compatible with Brat (<http://brat.nlplab.org/>). Corpus (C<corpus>) is a file
with one sentence per line. Term list (C<termlist>) is a file
containing one term per line. For each term, additionnal information
(as canonical form) can be given after a column. Each line of the
output file (C<selected_term_list>) contains the sentence number, the
term, additional information, all separated by a tabulation character.
==hea1 EXAMPLES
Tag the textual corpus in C<corpus-test.txt> with terms in the file
view all matches for this distribution
view release on metacpan or search on metacpan
my $default = $config->{mason_web_dir};
$default =~ s,/alzabo\Z,, if $default;
do
{
print "\n *** The directory you selected does not exist ***\n"
if defined $config->{mason_web_dir} && ! -d $config->{mason_web_dir};
print <<'EOF';
Where would you like to install the mason components for this
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Alzabo/Driver.pm view on Meta::CPAN
Returns an array of array references containing the data requested.
=head2 rows_hashref
Returns an array of hash references containing the data requested.
The hash reference keys are the columns being selected. All the key
names are in uppercase.
=head2 one_row
Returns an array or scalar containing the data returned, depending on
context.
=head2 one_row_hash
Returns a hash containing the data requested. The hash keys are the
columns being selected. All the key names are in uppercase.
=head2 column
Returns an array containing the values for the first column of each
row returned.
lib/Alzabo/Driver.pm view on Meta::CPAN
Throws: L<C<Alzabo::Exception::Driver>|Alzabo::Exceptions>
=head2 all_rows
If the select for which this statement is cursor was for a single
column (or aggregate value), then this method returns an array
containing each B<remaining> value from the database.
Otherwise, it returns an array of array references, each one
containing a returned row from the database.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Amazon/Dash/Button.pm view on Meta::CPAN
The first thing to do once you have received your button is to set it and discover it.
Here is the basic setting process:
=over 4
=item use your phone or table to perform the basic setting, but do not complete it, stop when asking to select to link a product with the button.
=item in the mobile app you would find a menu "Your Dash Button" -> "Settings" then "Set up a new device".
=item choose your dash device, then follow the instructions: long press on the button until it discovery mode (blue light)
=item provide the wifi password of your network
=item but do not select the exact product linked to your button exit from there !
=back
=head2 Detecting the button
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Amazon/DynamoDB/Simple.pm view on Meta::CPAN
$table->keys();
# delete $old_key, create $new_key
$table->rename($old_key, $new_key);
# sync data between AWS regions using the 'last_updated' field to select
# the newest data. This method will permanently delete any items marked as
# 'deleted'.
$table->sync_regions();
# This sets the value of the hosts attribute. The value shown is the
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Amazon/DynamoDB/LWP.pm view on Meta::CPAN
sub delay {
my $self = shift;
my $amount = shift;
Future->call(sub {
# Sleep could be less than one second, so use select.
if ($amount > 0) {
select(undef, undef, undef, $amount);
}
Future->new->done();
});
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
}
=item force
Same as above, but only for the selected items. An arrayref is
expected here with the B<skus>.
=cut
has force => (is => 'ro',
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
has existing_products => (is => 'lazy');
sub _build_existing_products {
my $self = shift;
my $sth = $self->_exe_query($self->sqla->select(amazon_mws_products => [qw/sku
timestamp_string
status
listed
error_code
/],
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
status => 'pending',
warnings => '', # clear out
timestamp_string => $p->timestamp_string,
);
my $check = $self
->_exe_query($self->sqla->select(amazon_mws_products => [qw/sku/], { %identifier }));
my $existing = $check->fetchrow_hashref;
$check->finish;
if ($existing) {
$self->_exe_query($self->sqla->update(amazon_mws_products => \%data, \%identifier));
}
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
}
}
if (@named_jobs) {
$additional{amws_job_id} = { -in => \@named_jobs };
}
my ($stmt, @bind) = $self->sqla->select(amazon_mws_jobs => '*',
{
%additional,
aborted => 0,
success => 0,
shop_id => $self->_unique_shop_id,
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
# upload the feeds one by one and stop if something is blocking
my $job_id = $row->{amws_job_id};
print "Processing job $job_id\n";
# query the feeds table for this job
my ($stmt, @bind) = $self->sqla->select(amazon_mws_feeds => '*',
{
amws_job_id => $job_id,
aborted => 0,
success => 0,
shop_id => $self->_unique_shop_id,
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
while (my $feed = $sth->fetchrow_hashref) {
last unless $self->upload_feed($feed);
}
$sth->finish;
($stmt, @bind) = $self->sqla->select(amazon_mws_feeds => '*',
{
shop_id => $self->_unique_shop_id,
amws_job_id => $job_id,
});
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
=cut
sub order_already_registered {
my ($self, $order) = @_;
die "Bad usage, missing order" unless $order;
my $sth = $self->_exe_query($self->sqla->select(amazon_mws_orders => '*',
{
amazon_order_id => $order->amazon_order_number,
shop_id => $self->_unique_shop_id,
}));
if (my $exists = $sth->fetchrow_hashref) {
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
print "Trying to purge missing items " . join(" ", @skus) . "\n";
# delete only products which are not in pending status
my $check = $self
->_exe_query($self->sqla
->select('amazon_mws_products', [qw/sku status/],
{
sku => { -in => \@skus },
shop_id => $self->_unique_shop_id,
}));
my %our_skus;
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
}
else {
warn "register_order_ack_errors couldn't parse " . Dumper($result);
}
# then get the amazon order number and recheck
my $sth = $self->_exe_query($self->sqla->select('amazon_mws_orders',
[qw/amazon_order_id
shop_order_id
/],
{
amws_job_id => $job_id,
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
=cut
sub skus_in_job {
my ($self, $job_id) = @_;
my $sth = $self->_exe_query($self->sqla->select('amazon_mws_products',
[qw/sku/],
{
amws_job_id => $job_id,
shop_id => $self->_unique_shop_id,
}));
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
=cut
sub order_already_shipped {
my ($self, $order) = @_;
my $condition = $self->_condition_for_shipped_orders($order);
my $sth = $self->_exe_query($self->sqla->select(amazon_mws_orders => '*', $condition));
if (my $row = $sth->fetchrow_hashref) {
die "Multiple results found in amazon_mws_orders for " . Dumper($condition)
if $sth->fetchrow_hashref;
return $row;
}
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
=cut
sub orders_waiting_for_shipping {
my $self = shift;
my $sth = $self->_exe_query($self->sqla->select('amazon_mws_orders',
[qw/amazon_order_id
shop_order_id/],
{
shop_id => $self->_unique_shop_id,
shipping_confirmation_job_id => undef,
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
=cut
sub orders_in_shipping_job {
my ($self, $job_id) = @_;
die unless $job_id;
my $sth = $self->_exe_query($self->sqla->select(amazon_mws_orders => [qw/amazon_order_id/],
{
shipping_confirmation_job_id => $job_id,
shop_id => $self->_unique_shop_id,
}));
my @orders;
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
);
# check if we have it
my $sth = $self->_exe_query($self->sqla
->select('amazon_mws_products',
[qw/sku/], { %identifier }));
if ($sth->fetchrow_hashref) {
$sth->finish;
print "Updating $product{sku} with error $product{error_msg}\n";
$self->_exe_query($self->sqla->update('amazon_mws_products',
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
sub cancel_feed {
my ($self, $feed) = @_;
die "Missing feed id argument" unless $feed;
# do the api call
my $sth = $self->_exe_query($self->sqla
->select(amazon_mws_feeds => [qw/amws_job_id/],
{
shop_id => $self->_unique_shop_id,
feed_id => $feed,
aborted => 0,
success => 0,
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
sub update_amw_order_status {
my ($self, $order) = @_;
# first, check if it exists
return unless $order;
my $sth = $self->_exe_query($self->sqla->select('amazon_mws_orders',
'*',
{
amazon_order_id => $order,
shop_id => $self->_unique_shop_id,
}));
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
my $where = { '>' => 0 };
if (@errcodes) {
$where = { -in => \@errcodes };
}
my $sth = $self->_exe_query($self->sqla
->select('amazon_mws_products', '*',
{
status => { '!=' => 'deleted' },
shop_id => $self->_unique_shop_id,
error_code => $where,
},
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
}
sub get_products_with_warnings {
my $self = shift;
my $sth = $self->_exe_query($self->sqla
->select('amazon_mws_products', '*',
{
status => 'ok',
shop_id => $self->_unique_shop_id,
warnings => { '!=' => '' },
},
lib/Amazon/MWS/Uploader.pm view on Meta::CPAN
if (my $shop_id = $self->shop_id) {
push @and, shop_id => $shop_id;
}
my $sth = $self->_exe_query($self->sqla
->select(amazon_mws_jobs => [qw/amws_job_id shop_id/],
[ -and => \@and ] ));
my @purge_jobs;
my $count = 0;
while (my $where = $sth->fetchrow_hashref) {
if ($limit) {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Amazon/S3/Thin.pm view on Meta::CPAN
of your credentials.
=item * C<version> (B<OPTIONAL [provider: metadata]>) - version of metadata service to use, either 1 or 2.
L<read more|https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/configuring-instance-metadata-service.html>
=item * C<role> (B<OPTIONAL [provider: metadata]>) - IAM instance role to use, otherwise the first is selected
=item * C<secure> - whether to use https or not. Default is 0 (http).
=item * C<ua> - a user agent object, compatible with LWP::UserAgent.
Default is an instance of L<LWP::UserAgent>.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Amazon/S3.pm view on Meta::CPAN
=head2 list_object_versions
list_object_versions( args )
Returns metadata about all versions of the objects in a bucket. You
can also use request parameters as selection criteria to return
metadata about a subset of all the object versions.
This method will only return the raw result set and does not perform
pagination or unravel common prefixes as do other methods like
C<list_bucket>. This may change in the future.
lib/Amazon/S3.pm view on Meta::CPAN
default: 1000
=item prefix
Use this parameter to select only those keys that begin with the
specified prefix. You can use prefixes to separate a bucket into
different groupings of keys. (You can think of using prefix to make
groups in the same way that you'd use a folder in a file system.) You
can use prefix with delimiter to roll up numerous objects into a
single result under CommonPrefixes.
view all matches for this distribution