view release on metacpan or search on metacpan
author/benchmark.pl view on Meta::CPAN
$aniki->dbh->do($_) for split /;/, SampleAniki::DB::Schema->output;
$teng->dbh->do($_) for split /;/, SampleAniki::DB::Schema->output;
$dbic->storage->dbh->do($_) for split /;/, SampleAniki::DB::Schema->output;
say '=============== SCHEMA ===============';
print SampleAniki::DB::Schema->output;
say '=============== INSERT (no fetch) ===============';
my ($dbic_id, $teng_id, $aniki_id) = (0, 0, 0);
timethese 100000 => {
aniki => sub {
$aniki->insert('author' => {
name => "name:".$aniki_id++,
author/benchmark.pl view on Meta::CPAN
};
$aniki->dbh->do('DELETE FROM author');
$aniki->dbh->do('DELETE FROM sqlite_sequence WHERE name = ?', undef, 'author');
say '=============== INSERT (fetch auto increment id only) ===============';
($dbic_id, $teng_id, $aniki_id) = (0, 0, 0);
cmpthese timethese 100000 => {
teng => sub {
my $id = $teng->fast_insert('author' => {
name => "name:".$teng_id++,
author/benchmark.pl view on Meta::CPAN
$aniki->dbh->do('DELETE FROM author');
$aniki->dbh->do('DELETE FROM sqlite_sequence WHERE name = ?', undef, 'author');
$teng->dbh->do('DELETE FROM author');
$teng->dbh->do('DELETE FROM sqlite_sequence WHERE name = ?', undef, 'author');
say '=============== INSERT ===============';
($dbic_id, $teng_id, $aniki_id) = (0, 0, 0);
cmpthese {
%{
timethese 20000 => {
dbic => sub {
author/benchmark.pl view on Meta::CPAN
}
},
};
say '=============== SELECT ===============';
cmpthese timethese 20000 => {
dbic => sub {
my @rows = $dbic->resultset('Author')->search({}, { rows => 10, order_by => { -asc => 'id' } })->all;
},
teng => sub {
author/benchmark.pl view on Meta::CPAN
aniki => sub {
my @rows = $aniki->select('author' => {}, { limit => 10, order_by => { id => 'ASC' } })->all;
},
};
say '=============== UPDATE ===============';
cmpthese timethese 20000 => {
dbic => sub {
my $row = $dbic->resultset('Author')->single({ id => 1 });
$row->update({ message => 'good morning' });
},
author/benchmark.pl view on Meta::CPAN
aniki => sub {
$aniki->update('author' => { message => 'good morning' }, { id => 1 });
},
};
say '=============== DELETE ===============';
my ($dbic_delete_id, $teng_delete_id, $aniki_delete_id) = (0, 0, 0);
cmpthese {
%{
timethese 20000 => {
dbic => sub {
view release on metacpan or search on metacpan
t/data/cs61.anki view on Meta::CPAN
`
#basic
Describe what we mean when we say a function is a *special form* function?
It is a function that does not process arguments the way other scheme functions
do. The `define` function is an example.
`
view release on metacpan or search on metacpan
html/about.pod view on Meta::CPAN
The AnnoCPAN site has the documentation for all the CPAN modules, and a
database of "notes" that can be added through the web interface. When
a user views a module's documentation, the POD is shown as HTML together
with the notes. This allows users to write very short notes that fill gaps
in the documentation; for example, it might be sufficient to say "warning:
this method returns different things in scalar and in list context and the POD
doesn't mention it!".
The plan is to make the note database available for download under an open
license so that other CPAN sites can choose to show the notes. It might also
view release on metacpan or search on metacpan
lib/Announcements.pm view on Meta::CPAN
},
);
=head2 Communication
Teleports always send you to a random spot on the map. But say you want
to implement an artifact that grants teleport control. If the character
is holding this artifact and is teleported, then the player can pick
the teleport's destination.
package NetHack::Item::MasterKeyOfThievery;
lib/Announcements.pm view on Meta::CPAN
with 'NetHack::Item::Artifact';
sub
Some levels in our game forbid teleportation for various reasons. Let's
say we want to implement that behavior as an announcement to avoid
polluting the character's teleport method with "are we on a level
that blocks teleportation?" logic.
package NetHack::Announcement::Teleporting;
use Moose;
view release on metacpan or search on metacpan
t/ansible-test1/ansible.cfg view on Meta::CPAN
# plays will gather facts by default, which contain information about
# the remote system.
#
# smart - gather by default, but don't regather if already gathered
# implicit - gather by default, turn off with gather_facts: False
# explicit - do not gather by default, must say gather_facts: True
#gathering = implicit
# This only affects the gathering done by a play's gather_facts directive,
# by default gathering retrieves all facts subsets
# all - gather all subsets
view release on metacpan or search on metacpan
eg/available-properties.pl view on Meta::CPAN
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
gluLookAt(0,0,5, 0,0,0, 0,1,0);
glTranslatef(0, 0.6, -1);
say "window size: ${width} x ${height}";
AntTweakBar::window_size($width, $height);
}
glutInit;
eg/available-properties.pl view on Meta::CPAN
my $custom_ro = "a";
my $custom_rw = undef;
my $magic_var_rw = 1.234;
my $wizzard = wizard(
set => sub { say "set magic to ", ${$_[0]} },
);
cast $magic_var_rw, $wizzard;
# types: bool, integer, number, string, color3f, color4f, direction, quaternion, custom enums
eg/available-properties.pl view on Meta::CPAN
);
$bar->add_button(
name => "my-btn-name",
cb => sub {
say "bool_ro=$bool_ro, bool_rw=$bool_rw";
say "int_ro=$int_ro, int_rw=$int_rw";
say "number_ro=$number_ro, number_rw=$number_rw";
say "string_ro=$string_ro, string_rw=$string_rw";
say "color3f_ro=", dump($color3f_ro), ", color3f_rw=", dump($color3f_rw);
say "color4f_ro=", dump($color4f_ro), ", color4f_rw=", dump($color4f_rw);
say "direction_ro=", dump($direction_ro), ", direction_rw=", dump($direction_rw);
say "quaternion_ro=", dump($quaternion_ro), ", quaternion_rw=", dump($quaternion_rw);
say "custom_rw=$custom_rw";
},
definition => "label='dump'",
);
$bar->add_separator("separator2");
$bar->add_button(
eg/available-properties.pl view on Meta::CPAN
$b2->add_variable(
mode => 'ro',
name => "bool_ro_cb",
type => 'bool',
cb_read => sub {
say "hello from bool_ro_cb!, bool = $bool";
return undef;
},
);
$b2->add_variable(
mode => 'rw',
name => "bool_rw_cb",
type => 'bool',
cb_read => sub { $bool; },
cb_write => sub {
$bool = shift;
say "writing value $bool";
}
);
$b2->add_variable(
mode => 'ro',
name => "number_ro_cb",
type => 'number',
cb_read => sub {
say "returning double value $double";
$double;
},
);
$b2->add_variable(
mode => 'rw',
eg/available-properties.pl view on Meta::CPAN
name => "color3f_rw_cb",
type => 'color3f',
cb_read => sub { $color3f },
cb_write => sub {
@$color3f = @{$_[0]};
say "now color3f = " . dump($color3f);
},
);
$b2->add_variable(
mode => 'rw',
name => "color4f_rw_cb",
view release on metacpan or search on metacpan
examples/fg_bg_colors.pl view on Meta::CPAN
use Antsy;
my $fg_rgb = Antsy::iterm_fg_color();
say "@$fg_rgb";
my $bg_rgb = Antsy::iterm_bg_color();
say "@$bg_rgb";
view release on metacpan or search on metacpan
devel/test-combos.pl view on Meta::CPAN
my %results;
for my $modules (@{ powerset(@all_modules) }) {
my $list = join ',', @$modules;
say '=' x 60;
say "RUNNING WITHOUT $list";
say '=' x 60;
$ENV{PERL5OPT} = "-MTest::Without::Module=$list";
system("prove");
my $result = $? >> 8 ? "NOT OK" : "OK";
push @{ $results{$result} }, $list;
}
for my $result (sort keys %results) {
my @modules = @{ $results{$result} };
say "$result when testing without:";
say "* $_" for @modules;
say '';
}
__END__
... test results ...
view release on metacpan or search on metacpan
lib/AnyData2/Storage/File/Linewise.pm view on Meta::CPAN
=cut
sub write
{
my ( $self, $buf ) = @_;
$self->{fh}->say($buf) or die "Can't write to $self->{filename}: $!";
}
=head1 LICENSE AND COPYRIGHT
Copyright 2015,2016 Jens Rehsack.
view release on metacpan or search on metacpan
inc/Test/Builder.pm view on Meta::CPAN
}
sub _is_qr {
my $regex = shift;
# is_regexp() checks for regexes in a robust manner, say if they're
# blessed.
return re::is_regexp($regex) if defined &re::is_regexp;
return ref $regex eq 'Regexp';
}
view release on metacpan or search on metacpan
inc/Test/Builder.pm view on Meta::CPAN
}
sub _is_qr {
my $regex = shift;
# is_regexp() checks for regexes in a robust manner, say if they're
# blessed.
return re::is_regexp($regex) if defined &re::is_regexp;
return ref $regex eq 'Regexp';
}
view release on metacpan or search on metacpan
eg/ssh-add.pl view on Meta::CPAN
ttr => 10,
delay => 1,
encode => { target => 'localhost',
scripts => \@scripts }})->recv;
say STDERR "job added to queue: " . Dumper($job->id);
exit;
view release on metacpan or search on metacpan
lib/AnyEvent/BitTorrent.pm view on Meta::CPAN
This value is calculated every time the method is called. Keep that in mind.
=head2 C<complete( )>
Returns true if we have downloaded everything we L<wanted|/"wanted( )"> which
is not to say that we have all data and can L<seed|/"seed( )">.
=head2 C<seed( )>
Returns true if we have all data related to the torrent.
view release on metacpan or search on metacpan
lib/AE/CS.pm view on Meta::CPAN
my $cs = AE::CS;
my $cv = AE::cv;
$cs->add( sub { $cv->send( $_[0]->recv ) } );
$cs->start('hello world');
say $cv->recv;
# or
my $cs = AE::CS;
http_get http://BlueT.org => sub { $cs->start($_[0]) };
$cs->add( sub { say $_[0]->recv } );
# or
my $cs = AE::CS;
my %foo = (bar => vbar, yohoo => vyohoo);
lib/AE/CS.pm view on Meta::CPAN
$cv->cb( sub {
my @a = $_[0]->recv;
$cv->send( $a[0].$a[1] )
});
say $cv->recv;
=head1 METHODS
=head2 start
view release on metacpan or search on metacpan
examples/test.pl view on Meta::CPAN
=pod
=head1 SYNOPSIS
you> say hello
bot> hello
you> leave
bot> has left the room.
=cut
view release on metacpan or search on metacpan
examples/client.pl view on Meta::CPAN
'chrome.windows.getAll', [{ populate => Types::Serialiser::true }],
sub {
my ($status, $reply) = @_;
$status eq 'done' or return;
defined $reply and ref $reply eq 'ARRAY' or return;
map { say "$_->{url}" } @{$reply->[0]{tabs}};
$cv->send();
}
);
});
view release on metacpan or search on metacpan
lib/AnyEvent/Collect.pm view on Meta::CPAN
use AnyEvent::Collect;
# Wait for all of a collection of events to trigger once:
my( $w1, $w2 );
collect {
$w1 = AE::timer 2, 0, event { say "two" };
$w2 = AE::timer 3, 0, event { say "three" };
}; # Returns after 3 seconds having printed "two" and "three"
# Wait for any of a collection of events to trigger:
my( $w3, $w4 );
collect_any {
$w3 = AE::timer 2, 0, event { say "two" };
$w4 = AE::timer 3, 0, event { say "three" };
};
# Returns after 2 seconds, having printed 2. Note however that
# the other event will still be emitted in another second. If
# you were to then execute the sleep below, it would print three.
# Or using L<ONE>
use ONE::Timer;
use AnyEvent::Collect;
collect {
ONE::Timer->after( 2 => event { say "two" } );
ONE::Timer->after( 3 => event { say "three" } );
}; # As above, returns after three seconds having printed "two" and
# "three"
# And because L<ONE> is based on L<MooseX::Event> and L<MooseX::Event>
# is integrated with L<Event::Wrappable>, you can just pass in raw subs
# rather then using the event helper:
collect_any {
ONE::Timer->after( 2 => sub { say "two" } );
ONE::Timer->after( 3 => sub { say "three" } );
}; # Returns after 2 seconds having printed "two"
=head1 DESCRIPTION
This allows you to reduce a group of unrelated events into a single event.
view release on metacpan or search on metacpan
lib/AnyEvent/Connection.pm view on Meta::CPAN
%$self = ();
}
BEGIN {
no strict 'refs';
for my $m (qw(push_write push_read unshift_read say reply recv command want_command)) {
*$m = sub {
my $self = shift;
$self->{connected} or return $self->event( error => "Not connected for $m" );
$self->{con}->$m(@_);
};
view release on metacpan or search on metacpan
lib/AnyEvent/Consul/Exec.pm view on Meta::CPAN
# output, before terminating it
wait => 2,
# called once job is submitted to Consul
on_submit => sub {
say "job submitted";
},
# called as each target node starts to process the job
# multiple calls, once per node
on_ack => sub {
my ($node) = @_;
say "$node: ack";
},
# called when a node has output from the job
# can be called zero or more times per node, as more output
# becomes available
on_output => sub {
my ($node, $output) = @_;
say "$node: output:";
say "$node> $_" for split("\n", $output);
},
# called when the node completes a job
# multiple calls, one per node
on_exit => sub {
my ($node, $rc) = @_;
say "$node: exit: $rc";
},
# called once all nodes have reported completion
# object is unusable past this point
on_done => sub {
say "job done";
$cv->send;
},
# called if an error occurs anywhere during processing (not command errors)
# typically called if Consul is unable to service requests
# object is unusable past this point
on_error => sub {
my ($err) = @_;
say "error: $err";
$cv->send;
},
);
# begin execution
view release on metacpan or search on metacpan
lib/AnyEvent/Consul.pm view on Meta::CPAN
my ($v, $meta) = @_;
# now set up a long-poll to watch a key we're interested in
$kv->get("mykey", index => $meta->index, cb => sub {
my ($v, $meta) = @_;
say "mykey changed to ".$v->value;
$cv->send;
});
});
# make the change
view release on metacpan or search on metacpan
eg/replicate.pl view on Meta::CPAN
my $l = AnyEvent::CouchDB::Stream->new(
url => $host_orig,
database => $db_orig,
on_change => sub {
my $change = shift;
say "document "
. $change->{id}
. " with sequence "
. $change->{seq}
. " have been updated";
$couchdb_orig->open_doc( $change->{id} )->cb(
view release on metacpan or search on metacpan
inc/Test/Builder.pm view on Meta::CPAN
}
sub _is_qr {
my $regex = shift;
# is_regexp() checks for regexes in a robust manner, say if they're
# blessed.
return re::is_regexp($regex) if defined &re::is_regexp;
return ref $regex eq 'Regexp';
}
view release on metacpan or search on metacpan
lib/AnyEvent/DNS/Cache/Simple.pm view on Meta::CPAN
);
for my $i ( 1..3 ) {
my $cv = AE::cv;
AnyEvent::DNS::a "example.com", sub {
say join " | ",@_;
$cv->send;
};
$cv->recv;
}
view release on metacpan or search on metacpan
examples/dns.pl view on Meta::CPAN
use AnyEvent::DNS;
my $cv = AE::cv;
AnyEvent::DNS::any $domain, sub {
say foreach map { $_->[4] } grep { $_->[1] =~ /^(a|aaaa)$/ } @_;
$cv->send;
};
$cv->recv;
view release on metacpan or search on metacpan
lib/AnyEvent/Debounce.pm view on Meta::CPAN
Create a debouncer:
my $damper = AnyEvent::Debounce->new( cb => sub {
my (@events) = @_;
say "Got ", scalar @events, " event(s) in the batch";
say "Got event with args: ", join ',', @$_ for @events;
});
Send it events in rapid succession:
$damper->send(1,2,3);
view release on metacpan or search on metacpan
lib/AnyEvent/Delay/Simple.pm view on Meta::CPAN
use AnyEvent::Delay::Simple;
my $cv = AE::cv;
delay(
sub {
say('1st step');
pop->send('1st result'); # send data to 2nd step
},
sub {
say(@_); # receive data from 1st step
say('2nd step');
die();
},
sub { # never calls because 2nd step failed
say('3rd step');
},
sub { # calls on error, at this time
say('Fail: ' . $_[1]);
$cv->send();
},
sub { # calls on success, not at this time
say('Ok');
$cv->send();
}
);
$cv->recv();
view release on metacpan or search on metacpan
lib/AnyEvent/Delay.pm view on Meta::CPAN
=head1 SYNOPSIS
# Synchronize multiple events
my $cv = AE::cv;
my $delay = AnyEvent::Delay->new();
$delay->on_finish(sub { say 'BOOM!'; $cv->send });
for my $i (1 .. 10) {
my $end = $delay->begin;
Mojo::IOLoop->timer($i => sub {
say 10 - $i;
$end->();
});
}
$cv->recv;
lib/AnyEvent/Delay.pm view on Meta::CPAN
# First step (parallel events)
sub {
my $delay = shift;
Mojo::IOLoop->timer(2 => $delay->begin);
http_get( 'http://www.yinyuetai.com' => $delay->begin );
say 'Second step in 2 seconds.';
},
# Second step (parallel timers)
sub {
my ($delay, @args) = @_;
say "This http response is $args[1]->[1]{Status}";
Mojo::IOLoop->timer(1 => $delay->begin);
Mojo::IOLoop->timer(3 => $delay->begin);
say 'Third step in 3 seconds.';
},
# Third step (the end)
sub {
my ($delay, @args) = @_;
say 'And done after 5 seconds total.';
$cv->send;
}
);
$cv->recv;
view release on metacpan or search on metacpan
lib/AnyEvent/Discord/Client.pm view on Meta::CPAN
die "no connection!" unless $self->{conn};
$self->{conn}->send(encode_json({op=>$op, d=>$d}));
}
sub say {
my ($self, $channel_id, $message) = @_;
$self->api(POST => "/channels/$channel_id/messages", {content => $message});
}
sub typing {
lib/AnyEvent/Discord/Client.pm view on Meta::CPAN
my $bot = new AnyEvent::Discord::Client(
token => $token,
commands => {
'commands' => sub {
my ($bot, $args, $msg, $channel, $guild) = @_;
$bot->say($channel->{id}, join(" ", map {"`$_`"} sort grep {!$commands_hidden{$_}} keys %{$bot->commands}));
},
},
);
$bot->add_commands(
'hello' => sub {
my ($bot, $args, $msg, $channel, $guild) = @_;
$bot->say($channel->{id}, "hi, $msg->{author}{username}!");
},
);
$bot->connect();
AnyEvent->condvar->recv;
lib/AnyEvent/Discord/Client.pm view on Meta::CPAN
Causes the client to connect to Discord. Will automatically attempt to reconnect if disconnected. Returns nothing and immediately; to wait forever and prevent the program from exiting, follow this call with:
AnyEvent->condvar->recv;
=item C<say(I<$channel_id>, I<$message>)>
Sends the given C<$message> text to the given C<$channel_id>.
=item C<typing(I<$channel>)>
lib/AnyEvent/Discord/Client.pm view on Meta::CPAN
$bot->add_commands(
# register "!hello" command
'hello' => sub {
my ($bot, $args, $msg, $channel, $guild) = @_;
$bot->say($channel->{id}, "hi, $msg->{author}{username}!");
},
);
=item C<api(I<$method>, I<$path>, I<$data>, I<$cb>)>
view release on metacpan or search on metacpan
lib/AnyEvent/Discord.pm view on Meta::CPAN
}
}
# Send debug messages to console if verbose is >=1
method _debug(Str $message) {
say time . ' ' . $message if ($self->verbose);
}
# Send trace messages to console if verbose is 2
method _trace(Str $message) {
say time . ' ' . $message if ($self->verbose and $self->verbose == 2);
}
# Called when Discord provides the 'hello' event
method _event_hello(AnyEvent::Discord::Payload $payload) {
$self->_debug('Received hello event');
view release on metacpan or search on metacpan
lib/AnyEvent/Handle.pm view on Meta::CPAN
$hdl->push_write ("getinfo\015\012");
# read the response line
$hdl->push_read (line => sub {
my ($hdl, $line) = @_;
say "got line <$line>";
$cv->send;
});
$cv->recv;
lib/AnyEvent/Handle.pm view on Meta::CPAN
data.
Example: read 2 bytes.
$handle->push_read (chunk => 2, sub {
say "yay " . unpack "H*", $_[1];
});
=cut
register_read_type chunk => sub {