view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
'clean' => { FILES => "*~ tmp*"}
);
sub MY::top_targets {
package MY;
my $inherited = shift->SUPER::top_targets(@_);
$inherited =~ s/(pure_all\s+::.+)/$1 README/;
$inherited;
}
sub MY::post_constants {
view release on metacpan or search on metacpan
t/lib/RPC/ExtDirect/Test/Qux.pm view on Meta::CPAN
use base 'RPC::ExtDirect::Test::Bar';
use RPC::ExtDirect Action => 'Qux';
# Redefine subs into Qux package without actually changing them
sub foo_foo : ExtDirect( 1 ) { shift; __PACKAGE__->SUPER::foo_foo(@_); }
sub foo_bar : ExtDirect( 2 ) { shift; __PACKAGE__->SUPER::foo_bar(@_); }
sub foo_baz : ExtDirect( params => [ qw( foo bar baz ) ] )
{ shift; __PACKAGE__->SUPER::foo_baz(@_); }
sub bar_foo : ExtDirect( 4 ) { shift; __PACKAGE__->SUPER::bar_foo(@_); }
sub bar_bar : ExtDirect( 5 ) { shift; __PACKAGE__->SUPER::bar_bar(@_); }
sub bar_baz : ExtDirect( formHandler ) {
shift;
__PACKAGE__->SUPER::bar_baz(@_);
}
1;
view release on metacpan or search on metacpan
lib/Apache/Filter.pm view on Meta::CPAN
# Prevent early filters from messing up the content-length of late filters
$self->header_out('Content-Length'=> undef);
return;
}
return $self->SUPER::send_http_header(@_);
}
sub send_fd {
my $self = shift;
if ($self->is_last_filter and eval{fileno $_[0]}) {
# Can send native filehandle directly to client
$self->SUPER::send_fd(@_);
} else {
my $fd = shift;
print while <$fd>;
}
}
view release on metacpan or search on metacpan
Client/lib/HTTunnel/Client.pm view on Meta::CPAN
sub new {
my $class = shift ;
my $url = shift ;
my %lwp_agent_args = @_ ;
my $this = $class->SUPER::new(
agent => 'HTTunnel::Client/$HTTunnel::Client::VERSION',
keep_alive => 1,
%lwp_agent_args
) ;
view release on metacpan or search on metacpan
lib/Apache/Hadoop/WebHDFS.pm view on Meta::CPAN
if ($_[0]->{'namenodeport'}) { $namenodeport = $_[0]->{'namenodeport'}; }
if ($_[0]->{'authmethod'}) { $authmethod = $_[0]->{'authmethod'}; }
if ($_[0]->{'user'}) { $user = $_[0]->{'user'}; }
# stack_depth set to 0 so we don't blow-up ram by saving content with each request.
my $self = $class-> SUPER::new( agent=>"Apache_Hadoop_WebHDFS",
stack_depth=>"0",
);
$self->{'namenode'} = $namenode;
$self->{'namenodeport'} = $namenodeport;
view release on metacpan or search on metacpan
examples/site/modules/Apache/JAF/MyJAF.pm view on Meta::CPAN
sub site_handler {
my ($self) = @_;
# common stuff before handler is called
# $self->{m} = JAF::MyJAF->new(); # create modeller -- if needed
$self->SUPER::site_handler();
# common stuff after handler is called
return $self->{status}
}
1;
view release on metacpan or search on metacpan
use vars qw(@ISA);
@ISA = qw(DBI::db);
sub prepare {
my ($dbh, @args) = @_;
my $sth = $dbh->SUPER::prepare(@args)
or return;
$sth->{private_mysubdbi_info} = { foo => 'bar' };
return $sth;
}
use vars qw(@ISA);
@ISA = qw(DBI::st);
sub fetch {
my ($sth, @args) = @_;
my $row = $sth->SUPER::fetch(@args)
or return;
do_something_magical_with_row_data($row)
or return $sth->set_err(1234, "The magic failed", undef, "fetch");
return $row;
}
When calling a SUPER::method that returns a handle, be careful to
check the return value before trying to do other things with it in
your overridden method. This is especially important if you want
to set a hash attribute on the handle, as Perl's autovivification
will bite you by (in)conveniently creating an unblessed hashref,
which your method will then return with usually baffling results
view release on metacpan or search on metacpan
if (param('Add to Playlist')) {
my $dir = dirname($r->uri);
my @new = param('file') or return HTTP_NO_CONTENT;
my %seen;
# The line below is the only line that's different than SUPER::process_playlist
@playlist = grep !$seen{$_}++,(@playlist,map {(m/^\//) ? "$_" : "$dir/$_" } @new);
$changed++;
}
if (param('Play Selected') and param('playlist')) {
my $uri = dirname($r->uri);
$self->send_playlist([map { (m/^\//) ? "$_" : "$uri/$_" } @files]);
return OK;
}
return $self->SUPER::run();
}
$page =~ s!(</BODY[^>]*>)!</FORM>$1!oi;
print $page;
} else {
return $self->SUPER::list_directory($dir);
}
return OK;
}
=over 4
=item list_directory()
Checks to see if this is a skin file, if not hands off to SUPER::list_directory().
If there is a skin files, gets it, processes it, adds in the <SCRIPT> and <FORM>
tags and the prints it.
=item run()
Looks for the "Shuffle Selected" parameter and handles the request if there is one.
Otherwise, sends to SUPER::run().
=item process_playlist()
Same as SUPER::process_playlist with only one line changed. If there is an 'Add to
Playlist' param. file param values that begin with '/' are not prepended with the
current uri and are treated as document root relative.
=back
view release on metacpan or search on metacpan
MP3/L10N/ar.pm view on Meta::CPAN
package Apache::MP3::L10N::ar; # Arabic
use strict;
use Apache::MP3::L10N::RightToLeft;
use vars qw($VERSION @ISA %Lexicon);
@ISA = qw(Apache::MP3::L10N::RightToLeft);
sub language_tag {__PACKAGE__->SUPER::language_tag}
# Translators for this module, in no particular order:
# Isam Bayazidi <bayazidi|@arabeyes.org>
sub encoding { "utf-8" }
view release on metacpan or search on metacpan
PAR/PerlRun.pm view on Meta::CPAN
}
sub can_compile {
my $pr = shift;
my $status = $pr->SUPER::can_compile();
return $status unless $status eq OK();
return $pr->_can_compile();
}
sub namespace_from {
PAR/PerlRun.pm view on Meta::CPAN
}
sub compile {
my ($pr, $eval) = @_;
$pr->_set_path_info();
return $pr->SUPER::compile($eval);
}
1;
__END__
view release on metacpan or search on metacpan
lib/Apache/PageKit/View.pm view on Meta::CPAN
sub new {
require Template;
require Template::Parser;
require Template::Context;
return shift->SUPER::new(@_);
}
sub fill_in_view {
my ($view) = @_;
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
sub postamble {
my $self = shift;
my $q = ($^O =~ /MSWin32/i ? '"' : "'");
my $string = $self->SUPER::postamble;
$string .= <<"EOF";
tag :
svn copy -m $q\$(VERSION_SYM) tag$q https://svn.apache.org/repos/asf/perl/Apache-Reload/trunk https://svn.apache.org/repos/asf/perl/Apache-Reload/tags/\$(VERSION_SYM)
EOF
Makefile.PL view on Meta::CPAN
sub clean {
my $self = shift;
return $self->Apache::TestMM::clean(@_) if $HAS_APACHE_TEST;
return $self->SUPER::clean(@_);
}
sub constants {
my $self = shift;
view release on metacpan or search on metacpan
# If the parameters are already encoded (ie. EncodeParms is not blank)
# then our job is done. Otherwise, we have to decode from UTF-8.
#
# TODO: Should we bother to re-encode?
return $self->SUPER::param(@_) if $self->encode_parms;
# param() is identical to parms() in scalar context
return $self->parms if !wantarray && !@_;
# Encode everything back to UTF-8. (The second argument may be an
: encode_utf8($_),
@_;
# param() is context-sensitive
if (wantarray) {
return map decode_utf8($_), $self->SUPER::param(@args);
} else {
return decode_utf8 scalar $self->SUPER::param(@args);
}
}
sub parms {
my $self = shift;
# (Maybe we could subclass Apache::Table and perform some magic?)
carp 'Calling parms() with empty ENCODE_PARMS is unsupported'
unless $self->encode_parms;
return $self->SUPER::parms(@_);
}
sub upload {
my ($self, $arg) = @_;
# upload(UPLOAD) is implemented, but undefined, so there's little
# harm in not supporting it...
if (UNIVERSAL::isa($arg, 'Apache::Upload')) {
carp 'Calling upload($upload) is unsupported';
return $self->SUPER::upload($arg);
}
unless ($self->{_uploads}) {
my @uploads = $self->SUPER::upload;
my %uploads;
foreach (@uploads) {
$upload_class->rebless($_, $self);
push @{ $uploads{ $_->name } }, $_;
}
$is_urlenc = 1;
my %tmp = @$ctype;
$charset = $tmp{charset};
}
my $old_parms = $self->SUPER::parms;
my $new_parms = new Apache::Table $self, scalar keys %$old_parms;
$old_parms->do( sub {
my ($key, $val) = @_;
$key = $self->_decode_value($key);
}
# Same thing for filenames
if ($self->SUPER::upload($key)) {
$val = $self->_decode_value($val)
} else {
$val = $self->_decode($val, $charset);
}
return 1;
} );
$self->{_old_parms} = $old_parms;
$self->SUPER::parms($new_parms);
}
package Apache::Upload::I18N;
sub DESTROY { $_[0]->_delete_stash }
sub name { $_[0]->_stash->{name} }
sub filename { $_[0]->_stash->{filename} }
sub _old_name { $_[0]->SUPER::name }
sub _old_filename { $_[0]->SUPER::filename }
sub next { carp "next() is not supported"; $_[0]->SUPER::next }
package Apache::Request::I18N;
=head1 HANDLER
view release on metacpan or search on metacpan
# Could be File::Spec-ified, but this is mostly a Unix module
$self->add_to_cleanup(qw(t/httpd t/httpd.conf t/error_log));
$self->do_system('t/httpd', '-f', "%s/t/httpd.conf");
$ENV{PORT} = %s; # Used by the test scripts
eval { $self->SUPER::ACTION_test };
warn $@ if $@;
$self->do_system("kill `cat t/httpd.pid`");
}
EOF
view release on metacpan or search on metacpan
lib/Apache/SWIT/Security/Maker.pm view on Meta::CPAN
package Apache::SWIT::Security::Maker::MF;
use base 'Apache::SWIT::Subsystem::Makefile';
sub make_this_subsystem_dumps {
my %ot = shift()->SUPER::make_this_subsystem_dumps(@_);
delete $ot{original_tree}->{dumped_tests}->{"020_secparams.t"};
return %ot;
}
package Apache::SWIT::Security::Maker;
lib/Apache/SWIT/Security/Maker.pm view on Meta::CPAN
, $s . read_file("blib/conf/do_swit_startups.pl"));
}
sub install_subsystem {
my ($self, $module) = @_;
$self->SUPER::install_subsystem($module);
my $tree = Apache::SWIT::Maker::Config->instance;
my $full_class = Apache::SWIT::Maker::Config->instance->root_class
. '::' . $module;
my $ot = $self->this_subsystem_original_tree;
view release on metacpan or search on metacpan
lib/Apache/SWIT/HTPage/Safe.pm view on Meta::CPAN
use base 'Apache::SWIT::HTPage';
use Carp;
sub swit_render {
my ($class, $r) = @_;
my $stash = $class->SUPER::swit_render($r);
my $es = $r->param('swit_errors') or goto OUT;
$class->ht_root_class->ht_error_render($stash, 'swit_errors', $es);
OUT:
return $stash;
}
lib/Apache/SWIT/HTPage/Safe.pm view on Meta::CPAN
|| exists($_->options->{safe_bind}) }
@{ $root->Widgets_List };
return $class->swit_encode_errors(\@errs);
ORIG_ERROR:
return shift()->SUPER::ht_swit_update_die(@_);
}
1;
view release on metacpan or search on metacpan
lib/Apache/Session/Browseable/DBI.pm view on Meta::CPAN
if ( $class->_fieldIsIndexed( $args, $selectField ) ) {
return $class->_query( $args, $selectField, $value,
{ query => "$selectField=?", values => [$value] }, @fields );
}
else {
return $class->SUPER::searchOn(@_);
}
}
sub searchOnExpr {
my $class = shift;
lib/Apache/Session/Browseable/DBI.pm view on Meta::CPAN
$value =~ s/\*/%/g;
return $class->_query( $args, $selectField, $value,
{ query => "$selectField like ?", values => [$value] }, @fields );
}
else {
return $class->SUPER::searchOnExpr(@_);
}
}
sub _query {
my ( $class, $args, $selectField, $value, $query, @fields ) = @_;
view release on metacpan or search on metacpan
lib/Apache/Session/DBMS.pm view on Meta::CPAN
my $key = shift;
if( $self->{isObjectPerKey} ) {
&{$self->{unserialize}}( $self, $self->{object_store}->{dbh}->FETCH( $key ) ); # yep we do unserialize it each time
} else {
$self->SUPER::FETCH( $key );
};
};
sub STORE {
my $self = shift;
lib/Apache/Session/DBMS.pm view on Meta::CPAN
my $value = shift;
if( $self->{isObjectPerKey} ) {
$self->{object_store}->{dbh}->STORE( $key, &{$self->{serialize}}( $self, $value ) ); # yep we do serialize it each time
} else {
$self->SUPER::STORE( $key, $value );
};
};
sub DELETE {
my $self = shift;
my $key = shift;
if( $self->{isObjectPerKey} ) {
$self->{object_store}->{dbh}->DELETE( $key );
} else {
$self->SUPER::DELETE( $key );
};
};
sub CLEAR {
my $self = shift;
if( $self->{isObjectPerKey} ) {
$self->{object_store}->{dbh}->CLEAR();
} else {
$self->SUPER::CLEAR();
};
};
sub EXISTS {
my $self = shift;
my $key = shift;
if( $self->{isObjectPerKey} ) {
$self->{object_store}->{dbh}->EXISTS( $key );
} else {
$self->SUPER::EXISTS( $key );
};
};
sub FIRSTKEY {
my $self = shift;
if( $self->{isObjectPerKey} ) {
$self->{object_store}->{dbh}->FIRSTKEY();
} else {
$self->SUPER::FIRSTKEY();
};
};
sub NEXTKEY {
my $self = shift;
if( $self->{isObjectPerKey} ) {
$self->{object_store}->{dbh}->NEXTKEY( shift );
} else {
$self->SUPER::NEXTKEY( shift );
};
};
sub DESTROY {
my $self = shift;
if( $self->{isObjectPerKey} ) {
#$self->{object_store}->{dbh}->sync();
} else {
$self->SUPER::DESTROY();
};
};
# override persistence methods if object-per-key mode on
# NOTE: basically we bypass the whole Apache::Session "caching" one-key-object layer
lib/Apache/Session/DBMS.pm view on Meta::CPAN
my $self = shift;
if( $self->{isObjectPerKey} ) {
$self->{object_store}->connection($self);
} else {
$self->SUPER::restore();
};
};
sub save {
my $self = shift;
if( $self->{isObjectPerKey} ) {
$self->{object_store}->connection($self);
} else {
$self->SUPER::save();
};
};
sub delete {
my $self = shift;
lib/Apache/Session/DBMS.pm view on Meta::CPAN
$self->{object_store}->connection($self);
$self->{object_store}->{dbh}->DROP()
or die $DBMS::ERROR."\n"; #shall we do a fire-safe check here?
} else {
$self->SUPER::delete();
};
};
1;
view release on metacpan or search on metacpan
lib/Apache/Session/Cassandra.pm view on Meta::CPAN
our $VERSION = '0.01';
sub populate {
my $self = shift;
$self->{args}->{Driver} = 'Cassandra';
return $self->SUPER::populate(@_);
}
1;
__END__
view release on metacpan or search on metacpan
lib/Apache/Session/Wrapper.pm view on Meta::CPAN
sub new
{
my $class = shift;
my %p = @_;
my $self = $class->SUPER::new(%p);
$self->_check_session_params;
$self->_set_session_params;
if ( $self->{use_cookie} && ! ( $ENV{MOD_PERL} || $self->{header_object} ) )
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
Makefile.PL view on Meta::CPAN
sub postamble {
my $self = shift;
my $q = ($^O =~ /MSWin32/i ? '"' : "'");
my $string = $self->SUPER::postamble;
$string .= <<"EOF";
tag :
svn copy -m $q\$(VERSION_SYM) tag$q https://svn.apache.org/repos/asf/perl/Apache-SizeLimit/trunk https://svn.apache.org/repos/asf/perl/Apache-SizeLimit/tags/\$(VERSION_SYM)
EOF
Makefile.PL view on Meta::CPAN
\t\@echo sorry, cannot run tests without Test::More
EOF
return $self->Apache::TestMM::test(@_) if $HAS_APACHE_TEST;
return $self->SUPER::test(@_);
}
sub clean {
my $self = shift;
return $self->Apache::TestMM::clean(@_) if $HAS_APACHE_TEST;
return $self->SUPER::clean(@_);
}
sub constants {
my $self = shift;
view release on metacpan or search on metacpan
lib/Apache/Solr/JSON.pm view on Meta::CPAN
sub init($)
{ my ($self, $args) = @_;
$args->{format} ||= 'JSON';
$self->SUPER::init($args);
$self->{ASJ_json} = $args->{json} || JSON->new->utf8;
$self;
}
lib/Apache/Solr/JSON.pm view on Meta::CPAN
# Solr server 3.6.2 seems not to detect the JSON input from the
# body content, so requires this work-around
# https://solr.apache.org/guide/6_6/uploading-data-with-index-handlers.html#UploadingDatawithIndexHandlers-JSONUpdateConveniencePaths
$url =~ s!/update\?!/update/json?!;
$self->SUPER::request($url, $result, $body, $body_ct);
}
sub decodeResponse($)
{ my ($self, $resp) = @_;
lib/Apache/Solr/JSON.pm view on Meta::CPAN
my $params = $args{params} ||= [];
if(ref $params eq 'HASH') { $params->{wt} ||= 'json' }
else { $args{params} = [ wt => 'json', @$params ] }
$self->SUPER::endpoint($action, %args);
}
1;
view release on metacpan or search on metacpan
TaintRequest.pm view on Meta::CPAN
# Escape any HTML content if the data is tainted.
$value = escape_html($value) if tainted($value);
}
$self->SUPER::print(@data);
}
sub TIEHANDLE {
my ($class, $r) = @_;
view release on metacpan or search on metacpan
lib/Apache/Template.pm view on Meta::CPAN
package My::Service::Module;
use base qw( Template::Service::Apache );
sub params {
my $self = shift;
my $params = $self->SUPER::params(@_);
$params->{ message } = 'Hello World';
return $params;
}
</perl>
view release on metacpan or search on metacpan
lib/Apache/TestConfigPHP.pm view on Meta::CPAN
$test_more = <DATA>;
chomp $test_more;
}
sub new {
return shift->SUPER::new(@_);
}
my %warn_style = (
html => sub { "<!-- @_ -->" },
c => sub { "/* @_ */" },
view release on metacpan or search on metacpan
sub new_test_config {
my $self = shift;
$self->{conf_opts}->{maxclients} ||= MIN_MAXCLIENTS;
return $self->SUPER::new_test_config;
}
view release on metacpan or search on metacpan
lib/Apache/Voodoo/Validate/text.pm view on Meta::CPAN
sub config {
my ($self,$c) = @_;
$c->{length} = 0;
return $self->SUPER::config($c);
}
1;
################################################################################
view release on metacpan or search on metacpan
sub new_test_config {
my $self = shift;
$self->{conf_opts}->{maxclients} ||= MIN_MAXCLIENTS;
return $self->SUPER::new_test_config;
}
view release on metacpan or search on metacpan
lib/Apache/Wombat/FileLogger.pm view on Meta::CPAN
Construct and return a B<Wombat::Logger::FileLogger> instance,
initializing fields appropriately. If subclasses override the
constructor, they must be sure to call
$self->SUPER::new();
=back
=cut
sub new {
my $self = shift;
$self = fields::new($self) unless ref $self;
$self->SUPER::new();
$self->{fh} = undef;
$self->{filename} = undef;
return $self;
lib/Apache/Wombat/FileLogger.pm view on Meta::CPAN
=cut
sub start {
my $self = shift;
$self->SUPER::start();
# ungh dum
undef $self->{started};
$self->{fh} = Apache::LogFile->new($self->{filename}) or do {
lib/Apache/Wombat/FileLogger.pm view on Meta::CPAN
=cut
# sub stop {
# my $self = shift;
# $self->SUPER::stop();
# $self->{fh}->close or do {
# my $msg = "cannot close $self->{filename}";
# throw Wombat::LifecycleException->new($msg, $!);
# };