Result:
found more than 877 distributions - search limited to the first 2001 files matching your query
( run in 0.619 )
Apache-Language
view release on metacpan or search on metacpan
Language.pm view on Meta::CPAN
}
return $current;
}
sub LanguageForced($$@) {
my ($cfg, $parms, $language) = @_;
if(is_language_tag($language)){
push @ {$cfg->{LanguageForced}}, $language;
}
else {
warning("Bad Language Tag $language");
}
return OK;
}
sub DefaultLanguage($$$:*){
#piggy-back mod_mime settings.
my ($cfg, $parms, $string) = @_;
foreach my $language ( split /\s+/, $string ){
if(is_language_tag($language)){
if (exists $cfg->{LanguageDefaultActive}){
Language.pm view on Meta::CPAN
}
}
return Apache->module('mod_mime.c') ? DECLINE_CMD : OK;
}
sub LanguageDefault($$@) {
my ($cfg, $parms, $language) = @_;
if(is_language_tag($language)){
if (exists $cfg->{LanguageDefaultActive}){
delete $cfg->{LanguageDefaultActive};
delete $cfg->{LanguageDefault};
Language.pm view on Meta::CPAN
# NotFoundPostfix=<--
# Prefix=']'
# Postfix=']'
# Verbose=digit
sub LanguageDebug($$$) {
my ($cfg, $parms, $debug) = @_;
#print STDERR "LanguageDebug ($debug)\n";
if($debug =~ /\d+/)
Language.pm view on Meta::CPAN
}
return OK;
}
sub LanguageHandler($$$;*){
my ($cfg, $parms, $directives, $cfg_fh) = @_;
foreach my $module (split /\s+/, $directives)
{
(my $action, $module ) = $module =~ /(\+|-)?(.*)/;
Apache-Log-Spread
view release on metacpan or search on metacpan
no strict;
@ISA = qw(DynaLoader);
__PACKAGE__->bootstrap($VERSION);
}
sub spconnect($)
{
my $daemon = shift;
my %args;
$args{'spread_name'} = $daemon;
$args{'private_name'} = "http-$PID";
$args{'priority'} = 0;
$args{'group_membership'} = 0;
return ($mailbox, $private_group) = Spread::connect( \%args );
}
sub handler($$)
{
my $self = shift;
$self = bless {}, $self;
my $apache_req = shift;
my %log_hash;
$hashref->{U} = $orig->uri;
$hashref->{v} = $r->hostname;
$hashref->{V} = $r->hostname;
}
sub MLS_LogFormat($$$$)
{
my ($cfg, $parms, $format, $name, $env) = @_;
$cfg->{logformat}->{$name}= $format;
}
sub MLS_Log($$$$;$)
{
my ($cfg, $parms, $fname, $format, $mask) = @_;
my $env;
eval "\$env = sub { my \$r = shift; $mask}";
push @{$cfg->{mls_logs}}, { name => $fname, format => $format, mask => $env};
}
sub SpreadDaemon($$$)
{
my ($cfg, $parms, $daemon) = @_;
$cfg->{spreaddaemon} = $daemon;
}
use My::Cookies;
use vars qw( @ISA);
@ISA = qw(Logger::Spread);
sub handler($$)
{
my $self = shift;
my $ar = shift;
Apache::Log::Spread::handler($self, $ar);
}
Apache-LoggedAuthDBI
view release on metacpan or search on metacpan
print STDERR "$prefix fall through, return DECLINED\n" if $Apache::AuthDBI::DEBUG > 1;
return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
}
sub dec2hex($) {
my ($dec) = @_;
return sprintf("%lx", $dec );
}
Apache-MiniWiki
view release on metacpan or search on metacpan
MiniWiki.pm view on Meta::CPAN
return OK;
}
# returns a string containing the contents of the given filename
sub get_file($) {
my ($filename) = @_;
my $data = "";
open (FILE, "$filename") || die "$filename - $!";
MiniWiki.pm view on Meta::CPAN
return $data;
}
# write the given data to the given filename
sub put_file($$) {
my ($filename, $data) = @_;
open (OUT, "> $filename") || die $!;
print OUT $data;
close(OUT);
MiniWiki.pm view on Meta::CPAN
$filename =~ s/^ //g;
return $filename;
}
# returns the timestamp of the given filename in the datadir
sub get_mtime($) {
my ($filename) = @_;
if (-f "$datadir/$filename") {
my $mtime = stat("$datadir/$filename")->mtime;
}
}
sub render($) {
my ($newtext) = @_;
# While the text contains Wiki-style links, we go through each one and
# change them into proper HTML links.
while ($newtext =~ /\[\[([^\]|]*)\|?([^\]]*)\]\]/) {
MiniWiki.pm view on Meta::CPAN
# this function returns the HTML for a form that allows the
# user to specify two revisions to compare, in either unidiff or context
# formats. It is called by the log and diff viewing functions,
# diff_function and log_function.
sub diff_form($) {
my ($uri) = @_;
my $form .= <<END;
<hr/>
<a name="#diff_form">
Apache-MultiAuth
view release on metacpan or search on metacpan
MultiAuth.pm view on Meta::CPAN
$r->note_basic_auth_failure;
return AUTH_REQUIRED;
}
sub AuthModule($$@) {
my ($cfg, $parms, $module) = @_;
my $auth_modules = $cfg->{AuthModules} ||= [];
push @{$auth_modules}, $module;
}
sub DumpAuthModules($$$) {
my ($cfg, $parms, $dump) = @_;
$DUMP_AUTH_MODULES = $dump;
}
sub DIR_MERGE {
Apache-NavBarDD
view release on metacpan or search on metacpan
NavBarDD.pm view on Meta::CPAN
my $bottom = 0;
# $depth is the vassal bar's depth down the document hierarchy.
my $depth = 2;
sub handler($$) {
my ($self, $r) = @_;
my $bar = $self->read_configuration($r) || return DECLINED;
$r->content_type eq 'text/html' || return DECLINED;
my $fh = Apache::File->new($r->filename) || return DECLINED;
Apache-No404Proxy
view release on metacpan or search on metacpan
lib/Apache/No404Proxy.pm view on Meta::CPAN
use Apache::Constants qw(:response);
use LWP::UserAgent;
use URI;
sub handler($$) {
my($class, $r) = @_;
return DECLINED unless $r->proxyreq;
$r->handler('perl-script');
$r->set_handlers(PerlHandler => [ sub { $class->proxy_handler($r); } ]);
return OK;
Apache-OutputChain
view release on metacpan or search on metacpan
OutputChain.pm view on Meta::CPAN
use vars qw( $VERSION $DEBUG );
$VERSION = '0.11';
use Apache::Constants ':common';
$DEBUG = 0;
sub DEBUG() { $DEBUG; }
sub handler
{
my $r = shift;
my $class = shift;
$class = __PACKAGE__ unless defined $class;
Apache-RSS
view release on metacpan or search on metacpan
lib/Apache/RSS.pm view on Meta::CPAN
no strict;
@ISA = qw(DynaLoader);
__PACKAGE__->bootstrap($VERSION);
}
sub handler($$){
my($class, $r) = @_;
my $cfg = Apache::ModuleConfig->get($r) || {};
# check permission
unless (-d $r->filename) {
return DECLINED;
lib/Apache/RSS.pm view on Meta::CPAN
}
##----------------------------------------------------------------
## Directives
##----------------------------------------------------------------
sub RSSEnableRegexp($$$){
my($cfg, $params, $arg) = @_;
$cfg->{RSSEnableRegexp} = eval "qr/$arg/";
die $@ if $@;
}
sub RSSChannelTitle($$$) {
my($cfg, $params, $arg) = @_;
$cfg->{RSSChannelTitle} = $arg;
}
sub RSSChannelDescription($$$) {
my($cfg, $params, $arg) = @_;
$cfg->{RSSChannelDescription} = $arg;
}
sub RSSCopyRight($$$) {
my($cfg, $params, $arg) = @_;
$cfg->{RSSCopyRight} = $arg;
}
sub RSSScanHTMLTitle($$$){
my($cfg, $params, $arg) = @_;
$cfg->{RSSScanHTMLTitle} = $arg;
}
sub RSSLanguage($$$){
my($cfg, $params, $arg) = @_;
$cfg->{RSSLanguage} = $arg;
}
sub RSSEncoding($$$){
my($cfg, $params, $arg) = @_;
$cfg->{RSSEncoding} = $arg;
}
sub RSSEncodeHandler($$$) {
my($cfg, $params, $arg) = @_;
$arg =~ m/([a-zA-Z0-9:]+)/; # untaint
my $class = $1;
eval "require $class";
if ($@ && $@ !~ m/^Can't locate/) {
Apache-Reload
view release on metacpan or search on metacpan
my $header = join '', <DATA>;
my $initial = <<'EOF';
sub simple { 'simple' }
use constant const => 'const';
sub prototype($) { 'prototype' }
sub promised;
EOF
my $modified = <<'EOF';
sub simple { 'SIMPLE' }
use constant const => 'CONST';
sub prototype($$) { 'PROTOTYPE' }
EOF
t_write_test_lib($test_file, $header, $initial);
{
Apache-Request-I18N
view release on metacpan or search on metacpan
strings instead of EUC-JP bytes strings.
=cut
use Apache::Constants 'DECLINED';
sub handler($$) {
my ($class, $r) = @_;
$class->instance($r);
DECLINED;
Apache-Request-Redirect
view release on metacpan or search on metacpan
Redirect.pm view on Meta::CPAN
}
}
return $self;
}
sub redirect() {
# passare un riferimento ad hash con
# i parametri della query in quanto la query string (GET)
# o il content (POST) deve essere ricostruito
# (Mason si mangia il content)
my $self = shift;
Redirect.pm view on Meta::CPAN
$self->_log(id => $LOG_RESPONSE, message => "Response:\n" .
$response_text);
return $response;
}
sub _prepare_request() {
my $self = shift;
my $request_args = $self->{args};
# Costruisco l'header della richiesta da quello originale
my $headers = new HTTP::Headers(%{$self->{apachereq}->headers_in});
Redirect.pm view on Meta::CPAN
$content
);
return $request;
}
sub _send_request() {
my $self = shift;
my $request = shift;
if ($self->{use_http10}) {
require LWP::Protocol::http10;
Redirect.pm view on Meta::CPAN
my $ua = new LWP::UserAgent;
my $response = $ua->send_request($request);
return $response;
}
sub _log() {
my $self = shift;
$self->{log} && $self->{log}->log(@_);
}
sub _built_content() {
my $self = shift;
my $request_args = $self->{args};
my $request = $self->{apachereq};
my $content;
Apache-SPARQL
view release on metacpan or search on metacpan
lib/Apache/SPARQL.pm view on Meta::CPAN
'OperationPointError' => 500,
'UnsupportedOperation' => 501,
'Unavailable' => 503
);
sub handler($$) {
my ($class, $ap) = @_;
return $Apache::SPARQL::Responses{ 'MalformedRequest' }
unless( $ap->method eq 'GET' or
$ap->method eq 'OPTIONS' );
Apache-SSI
view release on metacpan or search on metacpan
lib/Apache/SSI.pm view on Meta::CPAN
$VERSION = '2.19';
my $debug = 0;
sub handler($$) {
my ($pack, $r) = @_>1 ? @_ : (__PACKAGE__, shift());
my $fh;
if (lc($r->dir_config('Filter')) eq 'on') {
$r = $r->filter_register;
lib/Apache/SSI.pm view on Meta::CPAN
$req = $self->{_r};
}
return $req;
}
sub ssi_printenv() {
return join "", map( {"$_: $ENV{$_}<br>\n"} keys %ENV );
}
sub ssi_exec {
my($self, $args) = @_;
Apache-SWIT-Security
view release on metacpan or search on metacpan
lib/Apache/SWIT/Security/Session.pm view on Meta::CPAN
my ($self, $rel_uri) = @_;
my $uri = URI->new_abs($rel_uri, $self->request->uri);
return $self->_is_allowed($uri->path, %{ $uri->query_form_hash });
}
sub access_handler($$) {
my ($class, $r) = @_;
my $res = $class->SUPER::access_handler($r);
my $apr = Apache2::Request->new($r);
return $r->pnotes('SWITSession')->_is_allowed($r->uri
, %{ $apr->param || {} }) ? $res : Apache2::Const::FORBIDDEN();
Apache-SWIT
view release on metacpan or search on metacpan
lib/Apache/SWIT.pm view on Meta::CPAN
redirect to the second array item is produced.
Of C<$to> parameters only $to->[0] is mandatory.
=cut
sub swit_update_handler($$) {
my ($class, $r) = @_;
my $ar;
# Sometimes request fails - cannot find a testcase though...
eval { $ar = Apache2::Request->new($r
, POST_MAX => $class->swit_post_max); };
lib/Apache/SWIT.pm view on Meta::CPAN
$TEMPLATE->process($file, $vars, \$out) or $class->swit_die(
"No result for $file\: " . $TEMPLATE->error, $r);
return $out;
}
sub swit_render_handler($$) {
my ($class, $r) = @_;
$r->pnotes('SWITTemplate', $r->dir_config('SWITTemplate'));
my $ar = Apache2::Request->new($r);
my $vars = $class->swit_render($ar);
return $class->_raw_respond($ar, $vars) if (ref($vars) ne 'HASH');
Apache-SiteConfig
view release on metacpan or search on metacpan
inc/Test/More.pm view on Meta::CPAN
return $tb->unlike(@_);
}
#line 476
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
return $tb->cmp_ok(@_);
}
Apache-SiteControl
view release on metacpan or search on metacpan
lib/Apache/SiteControl/GrantAllRule.pm view on Meta::CPAN
my $this = { };
bless ($this, $class);
return $this;
}
sub grants($$$$)
{
my $this = shift;
my $user = shift;
my $action = shift;
my $resource = shift;
return "Default is to allow";
}
sub denies($$$$)
{
my $this = shift;
my $user = shift;
my $action = shift;
my $resource = shift;
Apache-Solr
view release on metacpan or search on metacpan
lib/Apache/Solr.pm view on Meta::CPAN
# overrule this when your host has a different unique field
our $uniqueKey = 'id';
my $mimetypes = MIME::Types->new;
my $http_agent;
sub _to_bool($)
{ my $b = shift;
!defined $b ? undef
: ($b && $b ne 'false' && $b ne 'off') ? 'true'
: 'false';
}
sub new(@)
{ my ($class, %args) = @_;
if($class eq __PACKAGE__)
{ my $format = delete $args{format} || 'XML';
$format eq 'XML' || $format eq 'JSON'
or panic "unknown communication format '$format' for solr";
lib/Apache/Solr.pm view on Meta::CPAN
eval "require $class"; panic $@ if $@;
}
(bless {}, $class)->init(\%args)
}
sub init($)
{ my ($self, $args) = @_;
$self->server($args->{server});
$self->{AS_core} = $args->{core};
$self->{AS_commit} = exists $args->{autocommit} ? $args->{autocommit} : 1;
$self->{AS_sversion} = $args->{server_version} || LATEST_SOLR_VERSION;
lib/Apache/Solr.pm view on Meta::CPAN
$self;
}
#---------------
sub core(;$) { my $s = shift; @_ ? $s->{AS_core} = shift : $s->{AS_core} }
sub autocommit(;$) { my $s = shift; @_ ? $s->{AS_commit} = shift : $s->{AS_commit} }
sub agent() {shift->{AS_agent}}
sub serverVersion() {shift->{AS_sversion}}
sub server(;$)
{ my ($self, $uri) = @_;
$uri or return $self->{AS_server};
$uri = URI->new($uri)
unless blessed $uri && $uri->isa('URI');
$self->{AS_server} = $uri;
}
#--------------------------
sub select(@)
{ my $self = shift;
my $args = @_ && ref $_[0] eq 'HASH' ? shift : {};
$self->_select($args, scalar $self->expandSelect(@_));
}
sub _select($$) {panic "not extended"}
sub queryTerms(@)
{ my $self = shift;
$self->_terms(scalar $self->expandTerms(@_));
}
sub _terms(@) {panic "not implemented"}
#-------------------------------------
sub addDocument($%)
{ my ($self, $docs, %args) = @_;
$docs = [ $docs ] if ref $docs ne 'ARRAY';
my $sv = $self->serverVersion;
lib/Apache/Solr.pm view on Meta::CPAN
$self->_add($docs, \%attrs, \%params);
}
sub commit(%)
{ my ($self, %args) = @_;
my $sv = $self->serverVersion;
my %attrs;
if(exists $args{waitFlush})
lib/Apache/Solr.pm view on Meta::CPAN
else { $attrs{expungeDeletes} = _to_bool delete $args{expungeDeletes} }
}
$self->_commit(\%attrs);
}
sub _commit($) {panic "not implemented"}
sub optimize(%)
{ my ($self, %args) = @_;
my $sv = $self->serverVersion;
my %attrs;
if(exists $args{waitFlush})
lib/Apache/Solr.pm view on Meta::CPAN
else { $attrs{maxSegments} = delete $args{maxSegments} }
}
$self->_optimize(\%attrs);
}
sub _optimize($) {panic "not implemented"}
sub delete(%)
{ my ($self, %args) = @_;
my %attrs;
$attrs{commit} = _to_bool(exists $args{commit} ? $args{commit} : $self->autocommit);
lib/Apache/Solr.pm view on Meta::CPAN
{ # old servers accept only one id or query per delete
$result = $self->_delete(\%attrs, [splice @which, 0, 2]) while @which;
}
$result;
}
sub _delete(@) {panic "not implemented"}
sub rollback()
{ my $self = shift;
$self->serverVersion ge '1.4'
or error __x"Rollback not supported by solr server";
$self->_rollback;
}
sub extractDocument(@)
{ my $self = shift;
$self->serverVersion ge '1.4'
or error __x"extractDocument() requires Solr v1.4 or higher";
lib/Apache/Solr.pm view on Meta::CPAN
}
$self->_extract([%p], $data, $ct);
}
sub _extract($) { panic "not implemented" }
#-------------------------
sub _core_admin($@)
{ my ($self, $action, $params) = @_;
$params->{core} ||= $self->core;
my $endpoint = $self->endpoint('cores', core => 'admin', params => $params);
my @params = %$params;
lib/Apache/Solr.pm view on Meta::CPAN
$self->request($endpoint, $result);
$result;
}
sub coreStatus(%)
{ my ($self, %args) = @_;
$self->_core_admin('STATUS', \%args);
}
sub coreReload(%)
{ my ($self, %args) = @_;
$self->_core_admin('RELOAD', \%args);
}
sub coreUnload($%)
{ my ($self, %args) = @_;
$self->_core_admin('UNLOAD', \%args);
}
#--------------------------
sub _calling_sub()
{ for(my $i=0;$i <10; $i++)
{ my $sub = (caller $i)[3];
return $sub if !$sub || index($sub, 'Apache::Solr::') < 0;
}
}
sub _simpleExpand($$$)
{ my ($self, $p, $prefix) = @_;
my @p = ref $p eq 'HASH' ? %$p : @$p;
my $sv = $self->serverVersion;
my @t;
lib/Apache/Solr.pm view on Meta::CPAN
}
@t;
}
sub expandTerms(@)
{ my $self = shift;
my $p = @_==1 ? shift : [@_];
my @t = $self->_simpleExpand($p, 'terms.');
wantarray ? @t : \@t;
}
sub _expand_flatten($$)
{ my ($self, $v, $prefix) = @_;
my @l = ref $v eq 'HASH' ? %$v : @$v;
my @s;
push @s, $prefix.(shift @l) => (shift @l) while @l;
@s;
}
sub expandExtract(@)
{ my $self = shift;
my @p = @_==1 ? @{(shift)} : @_;
my @s;
while(@p)
{ my ($k, $v) = (shift @p, shift @p);
lib/Apache/Solr.pm view on Meta::CPAN
, stats => [0]
, suggest => [0]
, group => [0]
);
sub expandSelect(@)
{ my $self = shift;
my @s;
my (@flat, %seen_set);
while(@_)
{ my ($k, $v) = (shift, shift);
lib/Apache/Solr.pm view on Meta::CPAN
unshift @s, $self->_simpleExpand(\@flat);
wantarray ? @s : \@s;
}
sub deprecated($)
{ my ($self, $msg) = @_;
return if $self->{AS_depr_msg}{$msg}++; # report only once
warning __x"Deprecated solr {message}", message => $msg;
}
sub ignored($)
{ my ($self, $msg) = @_;
return if $self->{AS_ign_msg}{$msg}++; # report only once
warning __x"Ignored solr {message}", message => $msg;
}
sub removed($)
{ my ($self, $msg) = @_;
return if $self->{AS_rem_msg}{$msg}++; # report only once
warning __x"Removed solr {message}", message => $msg;
}
#------------------------
sub endpoint($@)
{ my ($self, $action, %args) = @_;
my $core = $args{core} || $self->core;
my $take = $self->server->clone; # URI
$take->path($take->path . (defined $core ? "/$core" : '') . "/$action");
lib/Apache/Solr.pm view on Meta::CPAN
$take->query_form(@params) if @params;
$take;
}
sub request($$;$$)
{ my ($self, $url, $result, $body, $body_ct) = @_;
my $req;
if($body)
{ # request with 'form' payload
lib/Apache/Solr.pm view on Meta::CPAN
}
$resp;
}
sub decodeResponse($) { undef }
#----------------------------------
1;
Apache-Template
view release on metacpan or search on metacpan
lib/Apache/Template.pm view on Meta::CPAN
#------------------------------------------------------------------------
# TT2Tags html # specify TAG_STYLE
# TT2Tags [* *] # specify START_TAG and END_TAG
#------------------------------------------------------------------------
sub TT2Tags($$$$) {
my ($cfg, $parms, $start, $end) = @_;
if (defined $end and length $end) {
$cfg->{ START_TAG } = quotemeta($start);
$cfg->{ END_TAG } = quotemeta($end);
}
lib/Apache/Template.pm view on Meta::CPAN
#------------------------------------------------------------------------
# TT2PreChomp On # enable PRE_CHOMP
#------------------------------------------------------------------------
sub TT2PreChomp($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ PRE_CHOMP } = $on;
}
#------------------------------------------------------------------------
# TT2PostChomp On # enable POST_CHOMP
#------------------------------------------------------------------------
sub TT2PostChomp($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ POST_CHOMP } = $on;
}
#------------------------------------------------------------------------
# TT2Trim On # enable TRIM
#------------------------------------------------------------------------
sub TT2Trim($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ TRIM } = $on;
}
#------------------------------------------------------------------------
# TT2AnyCase On # enable ANYCASE
#------------------------------------------------------------------------
sub TT2AnyCase($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ ANYCASE } = $on;
}
#------------------------------------------------------------------------
# TT2Interpolate On # enable INTERPOLATE
#------------------------------------------------------------------------
sub TT2Interpolate($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ INTERPOLATE } = $on;
}
#------------------------------------------------------------------------
# TT2Tolerant On # enable TOLERANT
#------------------------------------------------------------------------
sub TT2Tolerant($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ TOLERANT } = $on;
}
#------------------------------------------------------------------------
# TT2IncludePath /here /there # define INCLUDE_PATH directories
# TT2IncludePath /elsewhere # additional INCLUDE_PATH directories
#------------------------------------------------------------------------
sub TT2IncludePath($$@) {
my ($cfg, $parms, $path) = @_;
my $incpath = $cfg->{ INCLUDE_PATH } ||= [ ];
push(@$incpath, $path);
}
#------------------------------------------------------------------------
# TT2Absolute On # enable ABSOLUTE file paths
#------------------------------------------------------------------------
sub TT2Absolute($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ ABSOLUTE } = $on;
}
#------------------------------------------------------------------------
# TT2Relative On # enable RELATIVE file paths
#------------------------------------------------------------------------
sub TT2Relative($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ RELATIVE } = $on;
}
#------------------------------------------------------------------------
# TT2Delimiter , # set alternate directory delimiter
#------------------------------------------------------------------------
sub TT2Delimiter($$$) {
my ($cfg, $parms, $delim) = @_;
$cfg->{ DELIMITER } = $delim;
}
#------------------------------------------------------------------------
# TT2PreProcess config header # define PRE_PROCESS templates
# TT2PreProcess menu # additional PRE_PROCESS templates
#------------------------------------------------------------------------
sub TT2PreProcess($$@) {
my ($cfg, $parms, $file) = @_;
my $preproc = $cfg->{ PRE_PROCESS } ||= [ ];
push(@$preproc, $file);
}
#------------------------------------------------------------------------
# TT2Process main1 main2 # define PROCESS templates
# TT2Process main3 # additional PROCESS template
#------------------------------------------------------------------------
sub TT2Process($$@) {
my ($cfg, $parms, $file) = @_;
my $process = $cfg->{ PROCESS } ||= [ ];
push(@$process, $file);
}
#------------------------------------------------------------------------
# TT2Wrapper main1 main2 # define WRAPPER templates
# TT2Wrapper main3 # additional WRAPPER template
#------------------------------------------------------------------------
sub TT2Wrapper($$@) {
my ($cfg, $parms, $file) = @_;
my $wrapper = $cfg->{ WRAPPER } ||= [ ];
push(@$wrapper, $file);
}
#------------------------------------------------------------------------
# TT2PostProcess menu copyright # define POST_PROCESS templates
# TT2PostProcess footer # additional POST_PROCESS templates
#------------------------------------------------------------------------
sub TT2PostProcess($$@) {
my ($cfg, $parms, $file) = @_;
my $postproc = $cfg->{ POST_PROCESS } ||= [ ];
push(@$postproc, $file);
}
#------------------------------------------------------------------------
# TT2Default notfound # define DEFAULT template
#------------------------------------------------------------------------
sub TT2Default($$$) {
my ($cfg, $parms, $file) = @_;
$cfg->{ DEFAULT } = $file;
}
#------------------------------------------------------------------------
# TT2Error error # define ERROR template
#------------------------------------------------------------------------
sub TT2Error($$$) {
my ($cfg, $parms, $file) = @_;
$cfg->{ ERROR } = $file;
}
#------------------------------------------------------------------------
# TT2EvalPerl On # enable EVAL_PERL
#------------------------------------------------------------------------
sub TT2EvalPerl($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ EVAL_PERL } = $on;
}
#------------------------------------------------------------------------
# TT2LoadPerl On # enable LOAD_PERL
#------------------------------------------------------------------------
sub TT2LoadPerl($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ LOAD_PERL } = $on;
}
#------------------------------------------------------------------------
# TT2Recursion On # enable RECURSION
#------------------------------------------------------------------------
sub TT2Recursion($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ RECURSION } = $on;
}
#------------------------------------------------------------------------
# TT2PluginBase My::Plugins # define PLUGIN_BASE package(s)
# TT2PluginBase Your::Plugin # additional PLUGIN_BASE package(s)
#------------------------------------------------------------------------
sub TT2PluginBase($$@) {
my ($cfg, $parms, $base) = @_;
my $pbases = $cfg->{ PLUGIN_BASE } ||= [ ];
push(@$pbases, $base);
}
#------------------------------------------------------------------------
# TT2AutoReset Off # disable AUTO_RESET
#------------------------------------------------------------------------
sub TT2AutoReset($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ AUTO_RESET } = $on;
}
#------------------------------------------------------------------------
# TT2CacheSize 128 # define CACHE_SIZE
#------------------------------------------------------------------------
sub TT2CacheSize($$$) {
my ($cfg, $parms, $size) = @_;
$cfg->{ CACHE_SIZE } = $size;
}
#------------------------------------------------------------------------
# TT2CompileExt .tt2 # define COMPILE_EXT
#------------------------------------------------------------------------
sub TT2CompileExt($$$) {
my ($cfg, $parms, $ext) = @_;
$cfg->{ COMPILE_EXT } = $ext;
}
#------------------------------------------------------------------------
# TT2CompileDir /var/tt2/cache # define COMPILE_DIR
#------------------------------------------------------------------------
sub TT2CompileDir($$$) {
my ($cfg, $parms, $dir) = @_;
$cfg->{ COMPILE_DIR } = $dir;
}
#------------------------------------------------------------------------
# TT2Debug On # enable DEBUG
#------------------------------------------------------------------------
sub TT2Debug($$$) {
my ($cfg, $parms, $on) = @_;
$cfg->{ DEBUG } = $DEBUG = $on;
}
#------------------------------------------------------------------------
# TT2Headers length etag # add certain HTTP headers
#------------------------------------------------------------------------
sub TT2Headers($$@) {
my ($cfg, $parms, $item) = @_;
my $headers = $cfg->{ SERVICE_HEADERS } ||= [ ];
push(@$headers, $item);
}
#------------------------------------------------------------------------
# TT2Params uri env pnotes uploads request # add template vars
#------------------------------------------------------------------------
sub TT2Params($$@) {
my ($cfg, $parms, $item) = @_;
my $params = $cfg->{ SERVICE_PARAMS } ||= [ ];
push(@$params, $item);
}
#------------------------------------------------------------------------
# TT2ContentType text/xml # custom content type
#------------------------------------------------------------------------
sub TT2ContentType($$$) {
my ($cfg, $parms, $type) = @_;
$cfg->{ CONTENT_TYPE } = $type;
}
#------------------------------------------------------------------------
# TT2ServiceModule My::Service::Class # custom service module
#------------------------------------------------------------------------
sub TT2ServiceModule($$$) {
my ($cfg, $parms, $module) = @_;
$Template::Config::SERVICE = $module;
}
#------------------------------------------------------------------------
# TT2Variable name value # define template variable
#------------------------------------------------------------------------
sub TT2Variable($$$$) {
my ($cfg, $parms, $name, $value) = @_;
$cfg->{ VARIABLES }->{ $name } = $value;
}
#------------------------------------------------------------------------
# TT2Constant foo bar
#------------------------------------------------------------------------
sub TT2Constant($$@@) {
my ($cfg, $parms, $name, $value) = @_;
my $constants = $cfg->{ CONSTANTS } ||= { };
$constants->{ $name } = $value;
}
#------------------------------------------------------------------------
# TT2ConstantsNamespace const
#------------------------------------------------------------------------
sub TT2ConstantsNamespace($$$) {
my ($cfg, $parms, $namespace) = @_;
$cfg->{ CONSTANTS_NAMESPACE } = $namespace;
}
Apache-Tika-Async
view release on metacpan or search on metacpan
lib/Apache/Tika/Connection/Future.pm view on Meta::CPAN
default => sub {
return Future::HTTP->new()
},
);
sub request( $self, $method, $url, $content, @headers ) {
# Should initialize
$method = uc $method;
my $content_size = length $content;
Apache-UploadMeter
view release on metacpan or search on metacpan
lib/Apache/UploadMeter.pm view on Meta::CPAN
sub __add_version_string {
my $r = shift;
$r->err_headers_out->add("X-Powered-By" => "Apache-UploadMeter/$VERSION");
}
sub upload_jit_handler($)
{
my $r=shift;
my $config = __lookup_config($r, "UploadHandler");
unless ($config) {
$r->log->warn("[Apache::UploadMeter] Couldn't find configuration data for url " . $r->uri);
lib/Apache/UploadMeter.pm view on Meta::CPAN
#$r->push_handlers("PerlHandler",\&r_handler);
#$r->handler("perl-script");
return u_handler($r);
}
sub meter_jit_handler($)
{
my $r=shift;
__add_version_string($r);
my $config = __lookup_config($r, "UploadMeter");
unless ($config) {
lib/Apache/UploadMeter.pm view on Meta::CPAN
$r->handler("perl-script");
$r->push_handlers("PerlHandler",\&um_handler);
return Apache2::Const::DECLINED;
}
sub form_jit_handler($)
{
my $r=shift;
__add_version_string($r);
my $config = __lookup_config($r, "UploadForm");
unless ($config) {
Apache-Voodoo
view release on metacpan or search on metacpan
lib/Apache/Voodoo/Debug/FirePHP.pm view on Meta::CPAN
#$self->setHeader('X-Wf-1-Index',$self->{'messageIndex'}-1);
return 1;
}
sub setHeader() {
my $self = shift;
my $name = shift;
my $value = shift;
$self->{mp}->header_out($name,$value);
Apache-Wyrd
view release on metacpan or search on metacpan
Wyrd/Input/Complex.pm view on Meta::CPAN
implemented only to return undef to any attempt to set a sub-Input's
value by default.
=cut
sub _get_value() {
return;
}
=item
Apache-iNcom
view release on metacpan or search on metacpan
lib/DBIx/UserDB.pm view on Meta::CPAN
by giving the method a new value. If scramble password is true, user's
password will be uuencoded before being stored in the database.
=cut
sub scramble_password($;$) {
$_[0]->{scramble} = $_[1] if @_ == 2;
$_[0]->{scramble};
}
Apache2-ASP
view release on metacpan or search on metacpan
lib/Apache2/ASP/ConfigPostProcessor.pm view on Meta::CPAN
return bless \%args, $class;
}# end new()
#==============================================================================
sub post_process($$);
1;# return true:
=pod
Apache2-AuthCAS
view release on metacpan or search on metacpan
lib/Apache2/AuthCAS.pm view on Meta::CPAN
);
# default to 0
$SESSION_CLEANUP_COUNTER = 0 if (!defined($SESSION_CLEANUP_COUNTER));
sub dbConnect($)
{
my($self) = @_;
my $dbh = DBI->connect(
"dbi:" . $self->casConfig("DbDriver")
lib/Apache2/AuthCAS.pm view on Meta::CPAN
}
return $dbh;
}
sub getApacheConfig($)
{
my($self) = @_;
$self->{'casConfig'} = Apache2::Module::get_config('Apache2::AuthCAS::Configuration'
, $self->{'request'}->server
, $self->{'request'}->per_dir_config);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
my $val = $self->casConfig($key) || 'undef';
$self->logMsg(" $key => $val", $LOG_DEBUG);
}
}
sub casConfig($$)
{
my($self, $var) = @_;
return $self->{'casConfig'}->{$var};
}
sub logMsg($$;$)
{
my($self, $msg, $logLevel) = @_;
$logLevel = $LOG_ERROR if (!$logLevel);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
$self->{'request'}->log->alert("CAS($$): $1: $msg");
}
}
# used for underlying services that need proxy tickets (PTs)
sub authenticate($$)
{
my($class, $r) = @_;
# Only authenticate the first internal request
return (Apache2::Const::OK) unless $r->is_initial_req;
lib/Apache2/AuthCAS.pm view on Meta::CPAN
# No valid session, no ticket. Redirect to CAS login
return $self->redirect_login();
}
sub check_session($$$)
{
my($self, $sid) = @_;
# we set up our own session here, so that we don't have to continually
# go through this whole process! we associate a session id with a PGTIOU
lib/Apache2/AuthCAS.pm view on Meta::CPAN
}
return undef;
}
sub cleanup()
{
my($self) = @_;
$SESSION_CLEANUP_COUNTER++;
$self->logMsg("counter=$SESSION_CLEANUP_COUNTER", $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
# reset counter if we have reached our threshold
$SESSION_CLEANUP_COUNTER = 0
if ($SESSION_CLEANUP_COUNTER >= $self->casConfig("SessionCleanupThreshold"));
}
sub add_basic_auth($$)
{
my($self, $user) = @_;
if ($self->casConfig("PretendBasicAuth"))
{
lib/Apache2/AuthCAS.pm view on Meta::CPAN
$self->{'request'}->ap_auth_type("Basic");
$self->{'request'}->user($user);
}
}
sub redirect_without_ticket($)
{
my($self) = @_;
$self->logMsg("redirecting to remove service ticket from service string", $LOG_INFO);
$self->setHeader(0, 'Location', $self->this_url());
return (Apache2::Const::HTTP_MOVED_TEMPORARILY);
}
sub redirect_login($)
{
my($self) = @_;
$self->logMsg("start", $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
. $self->casConfig("Host") . ":" . $self->casConfig("Port")
. $self->casConfig("LoginUri") . "?service=$service");
return (Apache2::Const::HTTP_MOVED_TEMPORARILY);
}
sub redirect($;$$)
{
my($self, $url, $errcode) = @_;
if ($url)
{
lib/Apache2/AuthCAS.pm view on Meta::CPAN
# apache request object
# ticket to be validated
# returns a hash with keys on success
# 'user', 'pgtiou'
# NULL on failure
sub validate_service_ticket($$$)
{
my($self, $ticket) = @_;
my $proxy = $self->casConfig("ProxyService") ? "1" : "0";
lib/Apache2/AuthCAS.pm view on Meta::CPAN
}
return ($errorMsg, $user, $pgtiou);
}
sub proxy_receptor($$$)
{
my($self, $pgtiou, $pgt) = @_;
# This is the proxy receptor.
# We should only enter here when CAS sends us the PGTIOU and the PGT
lib/Apache2/AuthCAS.pm view on Meta::CPAN
, $LOG_DEBUG);
return $self->redirect($self->casConfig("ErrorUrl") , $ERROR_CODES{"PGT_RECEPTOR"});
}
}
sub send_proxysuccess($$)
{
my($self) = @_;
$self->logMsg("sending proxy success for CAS callback", $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
$self->{'request'}->print("<casClient:proxySuccess xmlns:casClient=\"http://www.yale.edu/tp/casClient\"/>\n");
$self->{'request'}->rflush();
return (Apache2::Const::OK);
}
sub get_proxy_tickets($$;$$)
{
my($self, $pgt, $target, $numTickets) = @_;
return () if (!$target or !$numTickets);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
return @tickets;
}
# place data in the session
sub create_session($$$$)
{
my($self, $uid, $pgtiou, $ticket) = @_;
$self->logMsg("creating session for uid='$uid'"
. ($pgtiou ? ", pgtiou='$pgtiou'" : ""), $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
return $sid;
}
# "touch" the session
sub touch_session($$)
{
my($self, $sid) = @_;
$self->logMsg("touching session '$sid'", $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
return $rc;
}
# takes a session id and returns an array
sub get_session_data($$)
{
my($self, $sid) = @_;
$self->logMsg("retrieving session data for sid='$sid'", $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
$self->logMsg("couldn't get session data for sid='$sid'", $LOG_DEBUG);
return ();
}
# delete session
sub delete_session_data($$)
{
my($self, $sid) = @_;
$self->logMsg("deleting session mapping for sid='$sid'", $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
return $rc;
}
# delete expired sessions
sub delete_expired_sessions($)
{
my($self) = @_;
my $oldestValidTime = time() - $self->casConfig("SessionTimeout");
$self->logMsg("deleting sessions older than '$oldestValidTime'", $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
return $rc;
}
# place the pgt mapping in the database
sub set_pgt($$$)
{
my($self, $pgtiou, $pgt) = @_;
$self->logMsg("adding map for pgtiou='$pgtiou' pgt='$pgt'", $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
$dbh->disconnect();
return $rc;
}
sub do_proxy($$$$$$)
{
my($self, $sid, $pgt, $user, $removeTicket) = @_;
$self->logMsg("proxying request, sid='$sid'", $LOG_DEBUG);
$self->logMsg("pgt='$pgt'", $LOG_DEBUG) if ($pgt);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
return $self->redirect($self->casConfig("ErrorUrl")
, $ERROR_CODES{"INVALID_PGT"});
}
}
sub setHeader($$$$)
{
my($self, $in, $header, $value) = @_;
$self->logMsg("Setting header: $header = $value", $LOG_DEBUG);
lib/Apache2/AuthCAS.pm view on Meta::CPAN
$self->{'request'}->headers_out->{$header} = $value;
}
}
# strips the ticket from the query and returns the full service URL
sub this_url($$;$)
{
my($self, $serviceOverride) = @_;
if ($serviceOverride and my $service = $self->casConfig("Service"))
{
lib/Apache2/AuthCAS.pm view on Meta::CPAN
}
return $url;
}
sub parse_query_parameters($$)
{
my($self, $query) = @_;
return () if (!$query);
Apache2-AuthCookieDBImg
view release on metacpan or search on metacpan
lib/Apache2/AuthCookieDBImg.pm view on Meta::CPAN
#===============================================================================
# F U N C T I O N D E C L A R A T I O N S
#===============================================================================
sub _log_not_set($$);
sub _dir_config_var($$);
sub _dbi_config_vars($);
sub _now_year_month_day_hour_minute_second();
sub _percent_encode($);
sub _percent_decode($);
sub extra_session_info($$\@);
sub authen_cred($$\@);
sub authen_ses_key($$$);
sub group($$\@);
#===============================================================================
# P A C K A G E G L O B A L S
#===============================================================================
lib/Apache2/AuthCookieDBImg.pm view on Meta::CPAN
#===============================================================================
#-------------------------------------------------------------------------------
# _log_not_set -- Log that a particular authentication variable was not set.
sub _log_not_set($$) {
my( $r, $variable ) = @_;
my $auth_name = $r->auth_name;
$r->log_error( "Apache2::AuthCookieDBImg: $variable not set for auth realm $auth_name", $r->uri );
}
#-------------------------------------------------------------------------------
# _dir_config_var -- Get a particular authentication variable.
sub _dir_config_var($$) {
my( $r, $variable ) = @_;
my $auth_name = $r->auth_name;
return $r->dir_config( "$auth_name$variable" );
}
lib/Apache2/AuthCookieDBImg.pm view on Meta::CPAN
This is not required and defaults to 0 (Expire X minutes after initial logon).
=cut
sub _dbi_config_vars($) {
my( $r ) = @_;
my %c; # config variables hash
unless ( $c{ DBI_DSN } = _dir_config_var $r, 'DBI_DSN' ) {
_log_not_set $r, 'DBI_DSN';
lib/Apache2/AuthCookieDBImg.pm view on Meta::CPAN
#-------------------------------------------------------------------------------
# _now_year_month_day_hour_minute_second -- Return a string with the time in
# this order separated by dashes.
sub _now_year_month_day_hour_minute_second()
{
return sprintf '%04d-%02d-%02d-%02d-%02d-%02d', Today_and_Now;
}
#-------------------------------------------------------------------------------
# _percent_encode -- Percent-encode (like URI encoding) any non-alphanumberics
# in the supplied string.
sub _percent_encode($)
{
my( $str ) = @_;
$str =~ s/([^\w])/ uc sprintf '%%%02x', ord $1 /eg;
return $str;
}
#-------------------------------------------------------------------------------
# _percent_decode -- Percent-decode (like URI decoding) any %XX sequences in
# the supplied string.
sub _percent_decode($)
{
my( $str ) = @_;
$str =~ s/%([0-9a-fA-F]{2})/ pack( "c",hex( $1 ) ) /ge;
return $str;
}
lib/Apache2/AuthCookieDBImg.pm view on Meta::CPAN
#-------------------------------------------------------------------------------
# Take the credentials for a user and check that they match; if so, return
# a new session key for this user that can be stored in the cookie.
# If there is a problem, return a bogus session key.
sub authen_cred($$\@)
{
my( $self, $r, @credentials ) = @_;
my $auth_name = $r->auth_name;
lib/Apache2/AuthCookieDBImg.pm view on Meta::CPAN
}
#-------------------------------------------------------------------------------
# Take a session key and check that it is still valid; if so, return the user.
sub authen_ses_key($$$)
{
my( $self, $r, $encrypted_session_key ) = @_;
my $auth_name = $r->auth_name;
lib/Apache2/AuthCookieDBImg.pm view on Meta::CPAN
#-------------------------------------------------------------------------------
#
# Separated gen_key from authen_cred
#
sub gen_key($$$)
{
my( $self, $r, $user, $refExtraData ) = @_;
my %c = _dbi_config_vars $r;
my $auth_name = $r->auth_name;
lib/Apache2/AuthCookieDBImg.pm view on Meta::CPAN
#-------------------------------------------------------------------------------
# Take a list of groups and make sure that the current remote user is a member
# of one of them.
sub group($$\@)
{
my( $self, $r, $groups ) = @_;
my @groups = split(/\s+/o, $groups);
my $auth_name = $r->auth_name;
Apache2-AuthZSympa
view release on metacpan or search on metacpan
lib/Apache2/AuthZSympa.pm view on Meta::CPAN
$type = "ERROR";
};
return ($type, $detail);
}
sub casGetMail(){
my ($r) = @_;
my $error="";
use Net::LDAP;
my $user = $r->user;
my $ldap_host = $r->dir_config('LDAPHost');
Apache2-Dummy-RequestRec
view release on metacpan or search on metacpan
RequestRec.pm view on Meta::CPAN
return $self->headers_out->{'Content-Type'};
}
sub err_headers_out()
{
return shift->headers_out;
}
sub handler
RequestRec.pm view on Meta::CPAN
return $handler // 'perl-script';
}
sub header_only()
{
return 0;
}
sub hostname()
{
return "localhost";
}
sub method_number
( run in 0.619 second using v1.01-cache-2.11-cpan-65fba6d93b7 )