view release on metacpan or search on metacpan
lib/AnyEvent/RTPG.pm view on Meta::CPAN
use RTPG 0.3;
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = $class->SUPER::new(@_);
$self->{_rtpg} = RTPG->new(url=>$self->{url});
return $self
}
sub _tick {
view release on metacpan or search on metacpan
$out = $arg{out} || *STDOUT;
$prompt = $arg{prompt} // "> ";
$cb = $arg{on_line} || $arg{cb}
or do { require Carp; Carp::croak ("AnyEvent::ReadLine::Gnu->new on_line callback argument mandatry, but missing") };
$self = $class->SUPER::new ($arg{name} || $0, $in, $out);
$Term::ReadLine::Gnu::Attribs{term_set} = ["", "", "", ""];
$self->CallbackHandlerInstall ($prompt, \&on_line);
$hidden = 1;
view release on metacpan or search on metacpan
inc/Spiffy.pm view on Meta::CPAN
# This line is here to convince "autouse" into believing we are autousable.
sub can {
($_[1] eq 'import' and caller()->isa('autouse'))
? \&Exporter::import # pacify autouse's equality test
: $_[0]->SUPER::can($_[1]) # normal case
}
# TODO
#
# Exported functions like field and super should be hidden so as not to
view release on metacpan or search on metacpan
lib/AnyEvent/Run.pm view on Meta::CPAN
my ($parent, $child) = AnyEvent::Util::portable_socketpair
or croak "unable to create AnyEvent::Run socketpair: $!";
$args{fh} = $child;
my $self = $class->SUPER::new(%args);
my $pid = fork;
if ( $pid == 0 ) {
# child
lib/AnyEvent/Run.pm view on Meta::CPAN
my $self = shift;
# XXX: doesn't play nice with linger option, so clear wbuf
$self->{wbuf} = '';
$self->SUPER::DESTROY(@_);
if ( $self->{child_pid} ) {
kill 9 => $self->{child_pid};
waitpid $self->{child_pid}, 0;
}
view release on metacpan or search on metacpan
t/testlib.pl view on Meta::CPAN
sub new {
my ($class,%args) = @_;
my @lfields = qw( can_deliver_to dump_incoming dump_outgoing );
my %largs = map { $_ => delete $args{$_} } @lfields;
my $self = $class->SUPER::new( %args );
if ( my $ct = delete $largs{can_deliver_to} ) {
$self->{can_deliver_to} = _parse_addr($ct);
}
%$self = ( %$self, %largs );
return $self;
t/testlib.pl view on Meta::CPAN
foreach (qw( addr proto port )) {
next if ! $spec->{$_} || ! $ct->{$_};
return if $spec->{$_} ne $ct->{$_};
}
}
return $self->SUPER::can_deliver_to( @_ );
}
sub _parse_addr {
my $addr = shift;
$addr =~m{^(?:(udp|tcp):)?([\w\.-]+)(?::(\d+))?$} || die $addr;
return { proto => $1, addr => $2, port => $3 }
}
sub receive {
my $self = shift;
my @rv = $self->SUPER::receive(@_) or return;
invoke_callback( $self->{dump_incoming},@rv );
return @rv;
}
sub deliver {
my ($self,$packet,$to,$callback) = @_;
invoke_callback( $self->{dump_outgoing},$packet,$to );
return $self->SUPER::deliver( $packet,$to,$callback );
}
1;
view release on metacpan or search on metacpan
lib/AnyEvent/STOMP/Client.pm view on Meta::CPAN
my %DECODE_MAP = reverse %ENCODE_MAP;
sub new {
my $class = shift;
my $self = $class->SUPER::new;
$self->{connection_timeout_margin} = 250;
$self->{connected} = 0;
$self->{counter} = 0;
view release on metacpan or search on metacpan
lib/AnyEvent/STOMP.pm view on Meta::CPAN
croak 'No host provided' unless $host;
croak "ack value must be 0, undef, 'auto' or 'manual'"
if $ack && $ack ne 'auto' && $ack ne 'manual';
my $self = $class->SUPER::new;
$self->{ack} = $ack;
$port ||= ($ssl ? 61612 : 61613);
view release on metacpan or search on metacpan
lib/AnyEvent/SerialPort.pm view on Meta::CPAN
}
$s->write_settings();
sysopen($fh, $dev, O_RDWR|O_NOCTTY|O_NDELAY) or
croak "sysopen of '$dev' failed: $!";
$fh->autoflush(1);
my $self = $pkg->SUPER::new(fh => $fh, %p);
$self->{serial_port} = $s;
$self;
}
view release on metacpan or search on metacpan
lib/AnyEvent/Subprocess/Handle.pm view on Meta::CPAN
# if the on_read is not provided, we never get notified of handle
# close (presumably because no watchers are ever created)
push @args, on_read => sub { } if $is_read;
my $self = $class->SUPER::new(@args);
return $self;
}
sub on_finalize {
lib/AnyEvent/Subprocess/Handle.pm view on Meta::CPAN
sub destroy {
my ($self, @args) = @_;
my $rbuf = $self->{rbuf};
$self->_do_finalize;
$self->SUPER::destroy(@args);
$self->{rbuf} = $rbuf;
$self->{destroyed} = 1;
return;
}
view release on metacpan or search on metacpan
lib/AnyEvent/WebService/Notifo.pm view on Meta::CPAN
unless (ref($cb) eq 'CODE') {
my $cv = $cb;
$cb = sub { $cv->send(@_) };
}
my $req = $self->SUPER::send_notification(%args);
return $self->_do_request($cb, $req);
}
sub _do_request {
my ($self, $cb, $req) = @_;
view release on metacpan or search on metacpan
lib/AnyEvent/XMLRPC.pm view on Meta::CPAN
my $methods = delete $args{'methods'};
my $uri = delete $args{'uri'};
$uri ||= "/RPC2";
# get a new clean AnyEvent::HTTPD
my $self = $class->SUPER::new(%args);
return undef unless $self;
# Now I'm AnyEvent::XMLRPC
bless $self, $class;
view release on metacpan or search on metacpan
lib/AnyEvent/XMPP/Component.pm view on Meta::CPAN
unless (defined $args{port}) {
$args{port} = 5347;
}
my $self = $class->SUPER::new (%args);
$self->{parser}->set_stream_cb (sub {
my $secret = $self->{parser}->{parser}->xml_escape ($self->{secret});
my $id = $self->{stream_id} = $_[0]->attr ('id');
$self->{writer}->send_handshake ($id, $secret);
view release on metacpan or search on metacpan
inc/Module/Install/ExtraTests.pm view on Meta::CPAN
package # The newline tells PAUSE, "DO NOT INDEXING!"
MY;
sub test_via_harness {
my $self = shift;
return $self->SUPER::test_via_harness(@_)
unless $use_extratests;
my ($perl, $tests) = @_;
my $a_str = -d 'xt/author' ? 'xt/author' : '';
my $r_str = -d 'xt/release' ? 'xt/release' : '';
inc/Module/Install/ExtraTests.pm view on Meta::CPAN
}
sub dist_test {
my ($self, @args) = @_;
return $self->SUPER::dist_test(@args)
unless $use_extratests;
my $text = $self->SUPER::dist_test(@args);
my @lines = split /\n/, $text;
$_ =~ s/ (\S*MAKE\S* test )/ RELEASE_TESTING=1 $1 / for grep { m/ test / } @lines;
return join "\n", @lines;
}
}
view release on metacpan or search on metacpan
lib/AnyMongo/BSON/OID.pm view on Meta::CPAN
builder => 'build_value',
);
sub BUILDARGS {
my $class = shift;
return $class->SUPER::BUILDARGS(flibble => @_) if @_ % 2;
return $class->SUPER::BUILDARGS(@_);
}
sub build_value {
my ($self, $str) = @_;
$str = '' unless defined $str;
view release on metacpan or search on metacpan
inc/Pod/Markdown.pm view on Meta::CPAN
# ABSTRACT: Convert POD to Markdown
use parent qw(Pod::Parser);
sub initialize {
my $self = shift;
$self->SUPER::initialize(@_);
$self->_private;
$self;
}
sub _private {
view release on metacpan or search on metacpan
lib/Apache/ASP/Application.pm view on Meta::CPAN
}
bless \%self;
}
sub Lock { shift->SUPER::LOCK };
sub UnLock { shift->SUPER::UNLOCK };
sub SessionCount {
my $asp = tied(%{$_[0]})->{asp};
if($asp->{session_count}) {
$asp->{Internal}{SessionCount};
view release on metacpan or search on metacpan
examples/auth/AuthTest.pm view on Meta::CPAN
sub Configure {
my $self = shift;
# Pull defaults from AuthBase and save.
$self->SUPER::Configure();
my $conft = $self->{conf};
# Initial configuration. Put defaults here before the @_ args are
# pulled in.
$self->{conf} = { %{$conft},
view release on metacpan or search on metacpan
lib/Apache/Auth/UserDB/File.pm view on Meta::CPAN
# Implementation:
##############################################################################
sub new {
my ($class, %options) = @_;
my $self = $class->SUPER::new(%options);
$self->{file_write_mode} ||= $self->file_write_mode_write_rename;
return $self;
}
sub open {
view release on metacpan or search on metacpan
lib/Apache/AuthCookie/Params.pm view on Meta::CPAN
return Apache::Request->new($r);
}
else {
$r->server->log_error("params: using CGI") if $debug >= 3;
return $class->SUPER::_new_instance($r);
}
return;
}
view release on metacpan or search on metacpan
Session/Session.pm view on Meta::CPAN
unless ($nonce) {
$log->info('Apache::AuthDigest::API::Session - no session found for ',
"session key $key, using default request time instead");
return $r->SUPER::note_digest_auth_failure;
}
$log->info("Apache::AuthDigest::API::Session - using notes() key $key ",
"with session $nonce");
Session/Session.pm view on Meta::CPAN
sub compare_digest_response {
my $r = shift;
my $rc = $r->SUPER::compare_digest_response(@_);
return unless $rc;
my ($key, $session) = $r->get_session;
view release on metacpan or search on metacpan
lib/Apache/AuthTicket/Base.pm view on Meta::CPAN
##################### END STATIC METHODS ###########################3
sub new {
my ($class, $r) = @_;
return $class->SUPER::new({request => $r});
}
sub dbh {
my $self = shift;
view release on metacpan or search on metacpan
lib/Apache/AxKit/Provider/File/Formatter.pm view on Meta::CPAN
my $r = $self->apache_request();
# Let the superclass A:A:P:File handle the request if
# this is a directory. Nacho++
if ($self->_is_dir()) {
return $self->SUPER::get_strref();
}
# From SUPER:
my $fh = $self->SUPER::get_fh();
local $/;
my $contents = <$fh>;
my $whichformatter = $r->dir_config('FormatterModule');
AxKit::Debug(5, "Formatter Provider configured to use " . $whichformatter);
view release on metacpan or search on metacpan
return \$$self{xml} if ($self->{xml});
# Let the superclass A:A:P:File handle the request if
# this is a directory
if ($self->_is_dir()) {
return $self->SUPER::get_strref();
}
# Process the file with Text::VimColor
my $filetype = '';
$filetype = $self->_resolve_type unless $noMimeInfo;
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
eval { require Test::More } or return <<EOF;
test::
\t\@echo sorry, cannot run tests without Test::More
EOF
return $self->SUPER::test();
}
sub MY::postamble {
my $self = shift;
view release on metacpan or search on metacpan
CVS/Directory.pm view on Meta::CPAN
=cut
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = $class->SUPER::new(shift);
$self->{plain_files} = [];
$self->{files} = [];
$self->{directories} = [];
$self->{loaded} = 0;
view release on metacpan or search on metacpan
lib/Apache/Cache.pm view on Meta::CPAN
{
croak("$pkg object creation missing $name parameter.")
unless(defined($options->{$name}) && $options->{$name} ne '');
}
my $self = $class->SUPER::new(@_, namespace=>$options->{namespace});
return(undef()) unless(defined($self));
$self->{cache_options} = $options;
unless($self->SUPER::exists($options->{cachename}, $self->_lock_timeout))
{
return(undef()) if($self->SUPER::status eq FAILURE);
$self->_init_cache || return undef;
}
bless($self, $class);
return($self);
lib/Apache/Cache.pm view on Meta::CPAN
push(@{$data->{'_cache_metadata'}->{'queue'}}, $key);
$self->_check_keys($data);
$self->_check_size($data);
$self->SUPER::set($self->{cache_options}->{cachename}=>$data, NOWAIT);
my $rv = $self->status; # saving returned status
$self->unlock; # don't wait for Apache::SharedMem to auto unlock on destroy
return(undef()) if($rv eq FAILURE);
return($value);
lib/Apache/Cache.pm view on Meta::CPAN
if(exists $data->{$key})
{
$rv = delete($data->{$key});
delete($data->{_cache_metadata}->{timestamps}->{$key});
$data->{_cache_metadata}->{queue} = \@{grep($_ ne $key, @{$data->{_cache_metadata}->{queue}})};
$self->SUPER::set($self->{cache_options}->{cachename}=>$data);
return(undef()) if($self->status & FAILURE);
}
$self->unlock;
}
return($rv);
lib/Apache/Cache.pm view on Meta::CPAN
{
timestamps => {},
queue => [],
}
};
$self->SUPER::set($self->{cache_options}->{cachename}=>$cache_registry, $self->_lock_timeout);
return($self->SUPER::status eq FAILURE ? undef : 1);
}
sub _lock_timeout
{
my $self = shift;
lib/Apache/Cache.pm view on Meta::CPAN
sub _get_datas
{
my $self = shift;
my $data = $self->SUPER::get($self->{cache_options}->{cachename}, $self->_lock_timeout);
if($self->status eq FAILURE)
{
$self->_set_error("can't get the cacheroot: ", $self->error);
return(undef());
}
view release on metacpan or search on metacpan
eg/CacheWeather.pm view on Meta::CPAN
my $uri = $r->uri;
return(60) if ($uri=~ /hourly\.html$/);
return(60 * 24) if ($uri=~ /daily\.html$/);
return $self->SUPER::ttl($r);
}
sub handler ($$) {
my ($self,$r) = @_;
view release on metacpan or search on metacpan
lib/Apache/Clickable.pm view on Meta::CPAN
use URI::Find;
sub new {
my($class, %args) = @_;
my $self = $class->SUPER::new;
$self->{apr} = $args{apr};
$self->{currently_in_a} = 0;
return $self;
}
view release on metacpan or search on metacpan
my $conf_file = File::Spec->catfile($self->cwd, 't', 'httpd.conf');
$self->do_system(File::Spec->catfile('t', 'httpd'), '-f', $conf_file)
or die "Couldn't start httpd\n";
local $ENV{PORT} = $self->notes('apache_params')->{port};
$self->SUPER::ACTION_test;
my $pidfile = File::Spec->catfile('t', 'httpd.pid');
my $pid = do {open my($fh), $pidfile; local $/; <$fh>};
warn "Stopping httpd, process ID = $pid\n";
kill "TERM", $pid;
view release on metacpan or search on metacpan
lib/Apache/Config/Preproc.pm view on Meta::CPAN
}
}
if (@_) {
croak "Too many import parameters";
}
$class->SUPER::import();
}
sub new {
my $class = shift;
my $file = shift;
my $explist = Apache::Admin::Config::Tree::_get_arg(\@_, '-expand')
|| [ qw(include) ];
my $self = $class->SUPER::new($file, @_) or return;
bless $self, $class;
$self->{_filename} = $file;
$self->{_options} = \@_;
eval {