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?!;
my $resp = $self->SUPER::request($url, $result, $body, $body_ct);
my $ct = $resp->content_type;
# At least until Solr 4.0 response ct=text/plain while producing JSON
# $ct =~ m/json/i
# or error __x"Answer from solr server is not json but {type}"
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, $!);
# };
view release on metacpan or search on metacpan
sub _setup {
my $self = shift;
...do something here...
return $self->SUPER::_setup();
}
=head2 HTML ATTRIBUTES
Any legal attribute can generally be used. Some, however, are important
view release on metacpan or search on metacpan
lib/Apache/XPointer/RDQL/Parser.pm view on Meta::CPAN
sub parse {
my $self = shift;
my $query = shift;
$self->{'__query'} = $query;
return $self->SUPER::parse($query);
}
=head2 $obj->query_string()
Returns the original RDQL query string.
view release on metacpan or search on metacpan
lib/Apache2/API.pm view on Meta::CPAN
$self->{request} = undef unless( $self->{request} );
$self->{response} = undef unless( $self->{response} );
$self->{apache_request} = $r unless( $self->{apache_request} );
# 200Kb
$self->{compression_threshold} = 204800 unless( length( $self->{compression_threshold} ) );
$self->SUPER::init( @_ ) || return( $self->pass_error );
unless( $r = $self->apache_request )
{
$r ||= Apache2::RequestUtil->request;
return( $self->error( "No Apache2::RequestRec object was provided." ) ) if( !$r );
$self->apache_request( $r ) || return( $self->pass_error );
lib/Apache2/API.pm view on Meta::CPAN
{
$data = $json->encode( $hash );
};
if( $@ )
{
return( $self->error( "An error occurred while trying to encode perl data: $@\nPerl data are: ", sub{ $self->SUPER::dump( $hash ) } ) );
}
return( $data );
}
sub encode_url
view release on metacpan or search on metacpan
lib/Apache2/ASP/ASPDOM/Document.pm view on Meta::CPAN
#==============================================================================
sub new
{
my ($class) = shift;
my $s = $class->SUPER::new( @_ );
return $s;
}# end new()
1;# return true:
view release on metacpan or search on metacpan
}
sub configure {
my $self = shift;
bless $self->{server}, "Apache2::AUS::TestServer";
return $self->SUPER::configure(@_);
}
package Apache2::AUS::TestServer;
use base q(Apache::TestServer);
dbh => $dbh,
);
$mh->full_migrate;
$dbh->disconnect;
}
return $self->SUPER::start(@_);
}
sub stop {
my $self = shift;
my $rv;
if($rv = $self->SUPER::stop(@_)) {
warn "removing database schema!";
if(my $dbh = dbh) {
my $mh = DBIx::Migration::Directories->new(
schema => "Schema::RDBMS::AUS",
dbh => $dbh,
view release on metacpan or search on metacpan
lib/Apache2/AuthCASpbh/UserAgent.pm view on Meta::CPAN
my $cas_cookie_map;
if (exists($conf{cas_cookie_map})) {
$cas_cookie_map = $conf{cas_cookie_map}; delete($conf{cas_cookie_map});
}
my $self = $class->SUPER::new(%conf);
$self->{apache_r} = $r;
$self->{_log} = new Apache2::AuthCASpbh::Log(__PACKAGE__, $r->log);
if (defined($cas_cookie_map)) {
lib/Apache2/AuthCASpbh/UserAgent.pm view on Meta::CPAN
$_log->l($debug_level, 'denying ' . $response->header('Location') .
' redirect, matches ' . $self->{cas_login_url});
return 0;
}
return $self->SUPER::redirect_ok($new_request, $response);
}
sub request {
my ($self, $request, $arg, $size, $previous) = @_;
my $_log = $self->{_log};
lib/Apache2/AuthCASpbh/UserAgent.pm view on Meta::CPAN
}
}
NO_SET_COOKIE:
my $response = $self->SUPER::request($request, $arg, $size, $previous);
if ($response->code() == 302 && $response->header('Location') =~ $self->{cas_login_url}) {
$_log->l($debug_level, "request redirected to CAS login URL $self->{cas_login_url}");
if (!exists($self->{cas_ua})) {
view release on metacpan or search on metacpan
lib/Apache2/AuthCookieLDAP.pm view on Meta::CPAN
To make "LogoutURL" working you can subsclass Apache2::ApacheCookieLDAP and provide it with:
sub logout {
my ( $self, $r ) = @_;
$self->SUPER::logout($r);
my $logout_url = $r->dir_config( $r->auth_name . 'LogoutURL' );
if ($logout_url) {
$r->headers_out->set( Location => $logout_url );
$r->status(Apache2::Const::REDIRECT);
}
view release on metacpan or search on metacpan
lib/Apache2/CondProxy.pm view on Meta::CPAN
$r->content_type($subr->content_type) if $subr->content_type;
$r->content_encoding($subr->content_encoding)
if $subr->content_encoding;
$r->set_last_modified($subr->mtime) if $subr->mtime;
$r->SUPER::handler('modperl');
$r->set_handlers(PerlResponseHandler => \&_response_handler);
$r->push_handlers(PerlCleanupHandler => \&_cleanup_handler);
$r->add_output_filter(\&_output_filter_release);
return Apache2::Const::OK;
lib/Apache2/CondProxy.pm view on Meta::CPAN
# URIs. AHA: MAGIC.
$r->notes->set('proxy-nocanon', 1);
$r->filename(sprintf 'proxy:%s', $base);
$r->proxyreq(Apache2::Const::PROXYREQ_REVERSE);
$r->SUPER::handler('proxy-server');
$r->add_output_filter(\&_output_filter_fix_location);
if ($first) {
$r->push_handlers(PerlCleanupHandler => \&_cleanup_handler);
$r->add_input_filter(\&_input_filter_tee);
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
sub clean {
my $self = shift;
return $self->Apache::TestMM::clean(@_) if $HAS_APACHE_TEST;
return $self->SUPER::clean(@_);
}
__DATA__
<IfModule mod_perl.c>
PerlSetVar arp_binary '%s'
PerlLoadModule Apache2::Connection::Arp
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
sub clean {
my $self = shift;
return $self->Apache::TestMM::clean(@_) if $HAS_APACHE_TEST;
return $self->SUPER::clean(@_);
}
1;