view release on metacpan or search on metacpan
lib/AnyEvent/EC2/Tiny.pm view on Meta::CPAN
success_cb => sub {
my $xml = shift;
# prints ec2.us-east-1.amazonaws.com
say $xml->{'regionInfo'}{'item'}[0]{'regionEndpoint'};
},
fail_cb => sub {
my $error = shift;
$error->{'type'} # HTTP or XML
view release on metacpan or search on metacpan
lib/AnyEvent/Emitter.pm view on Meta::CPAN
# Subscribe to events
my $tiger = Cat->new;
$tiger->on(roar => sub {
my ($tiger, $times) = @_;
say 'RAWR!' for 1 .. $times;
});
$tiger->poke;
=head1 DESCRIPTION
lib/AnyEvent/Emitter.pm view on Meta::CPAN
This is a special event for errors, it will not be emitted directly by this
class but is fatal if unhandled.
$e->on(error => sub {
my ($e, $err) = @_;
say "This looks bad: $err";
});
=head1 METHODS
=head2 catch
view release on metacpan or search on metacpan
example/fget.pl view on Meta::CPAN
my $remote = shift;
unless(defined $remote)
{
say STDERR "usage: perl fget.pl [ -d | -p ] [ -a ] remote";
say STDERR " where remote is a URL for a file on an FTP server";
say STDERR " and local is a local filename (optional) where to transfer it to";
say STDERR " -d (optional) prints FTP commands and responses";
say STDERR " -p (optional) displays a progress bar as the file uploads";
say STDERR " -a (optional) use active mode transfer";
exit 2;
}
$remote = URI->new($remote);
unless($remote->scheme eq 'ftp')
{
say STDERR "only FTP URLs are supported";
exit 2;
}
unless(defined $remote->password)
{
$remote->password(prompt('p', 'Password: ', '', ''));
say '';
}
do {
my $from = $remote->clone;
$from->password(undef);
say "SRC: ", $from;
};
my @path = split /\//, $remote->path;
my $fn = pop @path;
if(-e $fn)
{
say STDERR "local file already exists";
exit 2;
}
my $ftp = AnyEvent::FTP::Client->new( passive => $active ? 0 : 1 );
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments"
if $debug;
});
$ftp->on_each_response(sub {
my $res = shift;
if($debug)
{
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
}
});
$ftp->connect($remote->host, $remote->port)->recv;
$ftp->login($remote->user, $remote->password)->recv;
example/fget.pl view on Meta::CPAN
if(defined $remote_size)
{
}
else
{
say STDERR "could not determine size of remote file, cannot provide progress bar";
$progress = 0;
}
}
open my $fh, '>', $fn;
view release on metacpan or search on metacpan
example/server.pl view on Meta::CPAN
$server->start(
sub {
my $tx = shift;
if($tx->req->listing_request)
{
$tx->res->say('list of sers:', '', '- grimlock');
}
else
{
if($tx->req->username eq 'grimlock')
{
view release on metacpan or search on metacpan
=item stop => $seconds (default: 10)
When a worker has no jobs to execute it becomes idle. An idle worker that
hasn't executed a job within this amount of time will be stopped, unless
the other parameters say otherwise.
Setting this to a very high value means that workers stay around longer,
even when they have nothing to do, which can be good as they don't have to
be started on the netx load spike again.
view release on metacpan or search on metacpan
->require ("MyWorker")
->AnyEvent::Fork::RPC::run ("My::Arith::run",
on_error => ..., on_event => ..., on_destroy => ...,
);
$rpc->(add => 1, 3, Coro::rouse_cb); say Coro::rouse_wait;
$rpc->(mul => 3, 2, Coro::rouse_cb); say Coro::rouse_wait;
The C<say>'s will print C<4> and C<6>.
=head2 Example 4: Forward AnyEvent::Log messages using C<on_event>
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
examples/http_get.pl view on Meta::CPAN
defined $data ? $done->( $data ) : $fail->( $headers->{Reason} );
};
};
}
say HTTP_GET( $ARGV[0] )->get;
view release on metacpan or search on metacpan
print "< $line\n"
if $self->{trace};
for ($line) {
if (/^\(gdb\)\s*$/gc) { # docs say "(gdb)", but reality says "(gdb) "
# nop
} else {
/^([0-9]*)/gc; # [token], actually ([0-9]+)?
my $token = $1;
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/Git/Wrapper.pm view on Meta::CPAN
# add all files and make a commit...
my $git = AnyEvent::Git::Wrapper->new($dir);
$git->add('.', sub {
$git->commit({ message => 'initial commit' }, sub {
say "made initial commit";
});
});
=head1 DESCRIPTION
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
0.05
-adding help
-try to curve dns caching problem :)
0.04
-remove the -file param releted code.
-change the all say to perl due the perl 5.8.x(really because this version is using be RHEL/CentOS )
0.03
-adding the command line args. ( -url , -c , -n , -debug , -file, -proxy , useragent )
0.02
-add some stats output + small code refactoring
0.01
view release on metacpan or search on metacpan
bin/bench.pl view on Meta::CPAN
$redis->command(['SET', $key.$i, $value], $i < 0 ? $done : $set);
};
$set->() for 1..100;
my $timer = AnyEvent->timer( after => 3, interval => 3, cb => sub {
say "$i items remaining";
});
my $start = AnyEvent->now;
$done->recv;
my $end = AnyEvent->now;
say "It took ". ($end - $start). " seconds";
say " that is ". ($ii/($end - $start)). " per second";
view release on metacpan or search on metacpan
lib/AnyEvent/I3.pm view on Meta::CPAN
use AnyEvent::I3 qw(:all);
my $i3 = i3();
$i3->connect->recv or die "Error connecting";
say "Connected to i3";
my $workspaces = $i3->message(TYPE_GET_WORKSPACES)->recv;
say "Currently, you use " . @{$workspaces} . " workspaces";
...or, using the sugar methods:
use AnyEvent::I3;
my $workspaces = i3->get_workspaces->recv;
say "Currently, you use " . @{$workspaces} . " workspaces";
A somewhat more involved example which dumps the i3 layout tree whenever there
is a workspace event:
use Data::Dumper;
lib/AnyEvent/I3.pm view on Meta::CPAN
$i3->subscribe({
workspace => sub {
$i3->get_tree->cb(sub {
my ($tree) = @_;
say "tree: " . Dumper($tree);
});
}
})->recv->{success} or die "Error subscribing to events";
AE::cv->recv
lib/AnyEvent/I3.pm view on Meta::CPAN
Establishes the connection to i3. Returns an C<AnyEvent::CondVar> which will
be triggered with a boolean (true if the connection was established) as soon as
the connection has been established.
if ($i3->connect->recv) {
say "Connected to i3";
}
=cut
sub connect {
my ($self) = @_;
lib/AnyEvent/I3.pm view on Meta::CPAN
Subscribes to the given event types. This function awaits a hashref with the
key being the name of the event and the value being a callback.
my %callbacks = (
workspace => sub { say "Workspaces changed" }
);
if ($i3->subscribe(\%callbacks)->recv->{success}) {
say "Successfully subscribed";
}
The special callback with name C<_error> is called when the connection to i3
is killed (because of a crash, exit or restart of i3 most likely). You can
use it to print an appropriate message and exit cleanly or to try to reconnect.
my %callbacks = (
_error => sub {
my ($msg) = @_;
say "I am sorry. I am so sorry: $msg";
exit 1;
}
);
$i3->subscribe(\%callbacks)->recv;
lib/AnyEvent/I3.pm view on Meta::CPAN
structure C<content> (or C<content>, encoded as utf8, if C<content> is a
scalar), if specified.
my $reply = $i3->message(TYPE_RUN_COMMAND, "reload")->recv;
if ($reply->{success}) {
say "Configuration successfully reloaded";
}
=cut
sub message {
my ($self, $type, $content) = @_;
lib/AnyEvent/I3.pm view on Meta::CPAN
=head2 get_workspaces
Gets the current workspaces from i3.
my $ws = i3->get_workspaces->recv;
say Dumper($ws);
=cut
sub get_workspaces {
my ($self) = @_;
lib/AnyEvent/I3.pm view on Meta::CPAN
=head2 get_outputs
Gets the current outputs from i3.
my $outs = i3->get_outputs->recv;
say Dumper($outs);
=cut
sub get_outputs {
my ($self) = @_;
lib/AnyEvent/I3.pm view on Meta::CPAN
=head2 get_tree
Gets the layout tree from i3 (>= v4.0).
my $tree = i3->get_tree->recv;
say Dumper($tree);
=cut
sub get_tree {
my ($self) = @_;
lib/AnyEvent/I3.pm view on Meta::CPAN
=head2 get_marks
Gets all the window identifier marks from i3 (>= v4.1).
my $marks = i3->get_marks->recv;
say Dumper($marks);
=cut
sub get_marks {
my ($self) = @_;
lib/AnyEvent/I3.pm view on Meta::CPAN
=head2 get_bar_config
Gets the bar configuration for the specific bar id from i3 (>= v4.1).
my $config = i3->get_bar_config($id)->recv;
say Dumper($config);
=cut
sub get_bar_config {
my ($self, $id) = @_;
lib/AnyEvent/I3.pm view on Meta::CPAN
Gets the i3 version via IPC, with a fall-back that parses the output of i3
--version (for i3 < v4.3).
my $version = i3->get_version()->recv;
say "major: " . $version->{major} . ", minor = " . $version->{minor};
=cut
sub get_version {
my ($self) = @_;
view release on metacpan or search on metacpan
examples/sample-ircd.pl view on Meta::CPAN
'servername' => 'localhost'
);
$ircd->reg_cb(
daemon_join => sub {
my ($irc, $nick, $chan) = @_;
say "join: $nick, $chan";
},
daemon_part => sub {
my ($irc, $nick, $chan) = @_;
say "part: $nick, $chan";
},
daemon_topic => sub {
my ($irc, $nick, $chan, $topic) = @_;
say "topic: $nick, $chan, $topic";
},
daemon_privmsg => sub {
my ($irc, $nick, $chan, $text) = @_;
say "privmsg: $nick, $chan, $text";
},
daemon_notice => sub {
my ($irc, $nick, $chan, $text) = @_;
say "notice: $nick, $chan, $text";
},
);
$ircd->run();
print "irc server is ready in irc://0:$port/\n";
view release on metacpan or search on metacpan
lib/AnyEvent/InMemoryCache.pm view on Meta::CPAN
use AnyEvent::InMemoryCache;
my $cache = AnyEvent::InMemoryCache->new;
$cache->set(immortal => "Don't expire!"); # It lasts forever by default
say $cache->get("immortal"); # "Don't expire!"
$cache->set(a_second => "Expire soon", "1s"); # Expires in one-second.
say $cache->get('a_second'); # "Expires soon"
AE::timer 2, 0, sub{ # 2 seconds later
$cache->exists('a_second'); # false
};
# You can overwrite key, and it's mortal now.
view release on metacpan or search on metacpan
lib/AnyEvent/Inotify/Simple.pm view on Meta::CPAN
wanted_events => [ qw(create move) ],
event_receiver => sub {
my ($event, $file, $moved_to) = @_;
given($event) {
when('create'){
say "Someone just uploaded $file!"
}
};
},
);
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
lib/AnyEvent/Lingr.pm view on Meta::CPAN
Scalar::Util::weaken($self);
$self->_polling_guard( $guard );
}
sub say {
my ($self, $room, $msg, $cb) = @_;
$self->post('room/say', { session => $self->session, room => $room, text => $msg }, sub {
my ($res, $hdr) = @_;
return unless $self;
lib/AnyEvent/Lingr.pm view on Meta::CPAN
=head2 update_room_info
Update joined room info, and fire on_room_info callback.
This method also update subscription rooms which is target room for on_event callback.
=head2 say($room, $message [, $cb ])
Say something to lingr room.
$lingr->say('perl_jp', 'hi!');
If you want response data, you can speficy callback.
The callback is invoked when the API call was successful.
$lingr->say('perl_jp', 'hi there!', sub {
my $res = shift;
warn $res->{message}->{id};
});
=head1 CALLBACKS
view release on metacpan or search on metacpan
lib/AnyEvent/MSN.pm view on Meta::CPAN
Make the client appear Idle. This is a sub-state of NLN.
=item BRB
Make the client say they'll Be Right Back. This is a sub-state of NLN.
=item AWY
Make the client appear to be Away from their computer. This is a sub-state of
NLN.
view release on metacpan or search on metacpan
lib/AnyEvent/Mac/Pasteboard.pm view on Meta::CPAN
interval => [0.5, 0.5, 1, 2, 3, 4, 5],
This key is optional.
Default interval is defined by $AnyEvent::Mac::Pasteboard::DEFAULT_INTERVAL.
perl -MAnyEvent::Mac::Pasteboard -E 'say $AnyEvent::Mac::Pasteboard::DEFAULT_INTERVAL;'
=item * on_change => CALLBACK
on_change => sub {
my $pb_content = shift;
view release on metacpan or search on metacpan
lib/AnyEvent/Memcached/Peer.pm view on Meta::CPAN
}
sub request {
my $self = shift;
if ($self->{connected}) {
return $self->{con}->say(@_);
}
else {
# no cb
$self->conntrack( say => \@_ );
}
}
sub reader {
my $self = shift;
view release on metacpan or search on metacpan
lib/AnyEvent/Monitor/CPU.pm view on Meta::CPAN
=item cb
cb => sub {
my ($monitor, $high_low_flag) = @_;
say $high_low_flag? "I'm bored..." : "I'm high as a kite!";
},
The callback to be used when the CPU usage rises above or lowers below
the defined thresholds.
lib/AnyEvent/Monitor/CPU.pm view on Meta::CPAN
=head2 is_high()
if ($monitor->is_high()) {
say "Your eggs will be ready in a minute";
}
Returns true if the CPU usage is over the defined limits.
=head2 is_low()
if ($monitor->is_low()) {
say "Its chilly in here, wanna generate some heat?";
}
Returns true if the CPU usage is below the defined limits.
=head2 stats()
my $stats = $monitor->stats;
my $count = $stats->{usage_count};
say "Average usage was $stats->{usage_avg} over the last $count samples"
if $count;
Returns a hashref with statistics. The following keys are available:
=over 4
lib/AnyEvent/Monitor/CPU.pm view on Meta::CPAN
=head2 is_running()
if ($monitor->is_running()) {
say "Big brother is watching, play it cool";
}
else {
say "Bring on the bacon and eggs, lets make breakfast!";
}
Returns true if the monitor is polling the CPU usage.
view release on metacpan or search on metacpan
examples/backup_cpan.pl view on Meta::CPAN
my $cachekey = "$key:$ctime,$mtime,$size,$inodenum";
$db->db_get( $cachekey, my $md5_hex );
if ($md5_hex) {
#say "hit $cachekey $md5hex";
} else {
$md5_hex = file_md5_hex($filename)
|| die "Failed to find MD5 for $filename";
$m->txn_do(
sub {
$db->db_put( $cachekey, $md5_hex );
}
);
#say "miss $cachekey $md5_hex";
}
$files{$key} = {
filename => $filename,
key => $key,
md5_hex => $md5_hex,
examples/backup_cpan.pl view on Meta::CPAN
key => $key,
md5_hex => $object->etag,
size => $object->size,
};
# say $object->key . ' ' . $object->size . ' ' . $object->etag;
$s3_set->insert( $object->key );
}
}
my @to_add;
examples/backup_cpan.pl view on Meta::CPAN
my $file = $files{$key};
my $object = $objects{$key};
if ($object) {
if ( $file->{md5_hex} eq $object->{md5_hex} ) {
# say "$key same";
} else {
# say "$key different";
push @to_add, $file;
}
} else {
#say "$key missing";
push @to_add, $file;
}
}
foreach my $key ( sort keys %objects ) {
my $object = $objects{$key};
my $file = $files{$key};
if ($file) {
} else {
# say "$key to delete";
push @to_delete, $object;
}
}
my $total_size = sum map { file( $_->{filename} )->stat->size } @to_add;
examples/backup_cpan.pl view on Meta::CPAN
my $key = $file->{key};
my $filename = $file->{filename};
my $md5_hex = $file->{md5_hex};
my $size = $file->{size};
# say "put $key";
$progress += $size;
my $object = $bucket->object(
key => $key,
etag => $md5_hex,
size => $size
examples/backup_cpan.pl view on Meta::CPAN
foreach my $object (@to_delete) {
my $key = $object->{key};
my $filename = $object->{filename};
my $object = $bucket->object(key => $key);
# say "delete $key";
$object->delete;
$progress++;
}
view release on metacpan or search on metacpan
eg/CrawlApache.pm view on Meta::CPAN
has '+use_stats' => (default => sub { 1 });
after finish => sub {
my ($self, $result) = @_;
say $result . "\t" . $self->final_url;
if (
not $self->has_error
and $self->getinfo('content_type') =~ m{^text/html}x
) {
view release on metacpan or search on metacpan
lib/AnyEvent/Open3/Simple.pm view on Meta::CPAN
my $ipc = AnyEvent::Open3::Simple->new(
on_start => sub {
my $proc = shift; # isa AnyEvent::Open3::Simple::Process
my $program = shift; # string
my @args = @_; # list of arguments
say 'child PID: ', $proc->pid;
},
on_stdout => sub {
my $proc = shift; # isa AnyEvent::Open3::Simple::Process
my $line = shift; # string
say 'out: ', $string;
},
on_stderr => sub {
my $proc = shift; # isa AnyEvent::Open3::Simple::Process
my $line = shift; # string
say 'err: ', $line;
},
on_exit => sub {
my $proc = shift; # isa AnyEvent::Open3::Simple::Process
my $exit_value = shift; # integer
my $signal = shift; # integer
say 'exit value: ', $exit_value;
say 'signal: ', $signal;
$done->send;
},
on_error => sub {
my $error = shift; # the exception thrown by IPC::Open3::open3
my $program = shift; # string
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
examples/listen.pl view on Meta::CPAN
my $cv = AE::cv();
my $db = AnyEvent::Pg::Pool->new("dbname=pgpqtest");
my $w = $db->listen('foo',
on_listener_started => sub { say "started!!!" },
on_notify => sub { say "foo!" });
warn "waiting for notifications!\n";
$cv->recv();