view release on metacpan or  search on metacpan

ASP.pm  view on Meta::CPAN

	    my $tied = $cache;
	    if($tied->{writes} && $tied->Size > $self->{cache_size}) {
		$self->{dbg} && $self->Debug("deleting cache $cache, size: ".$tied->Size);
		$tied->Delete;
	    } else {
		$self->{dbg} && $self->Debug("cache $cache OK size, size: ".$tied->Size);
	    }
	    $tied->DESTROY();
	}
    }

    #    $self->{'dbg'} && $self->Debug("END ASP DESTROY");
    $self->{Request} && &Apache::ASP::Request::DESTROY($self->{Request});
    $self->{Server} && ( %{$self->{Server}} = () );
    $self->{Response} && ( %{$self->{Response}} = () );
    %$self = ();

    1;
}

sub RegisterCleanup {
    my $self = shift;

    if($ModPerl2) {
	$self->{r}->pool->cleanup_register(@_);
    } else {
	$self->{r}->register_cleanup(@_);
    }
}

sub InitPaths {

    # we load this module just to detect where the shared directory really is
    use Apache::ASP::Share::CORE;

    # major problem with %INC if we cannot get this information
    my $share_path = $INC{'Apache/ASP/Share/CORE.pm'} 
      || die(q(can't find path for $INC{'Apache/ASP/Share/CORE.pm'}));

    $share_path =~ s/CORE\.pm$//s;
    unless($share_path =~ /$AbsoluteFileMatch/) {
	# this %ENV manipulation is just to allow cwd() to run in taint check mode
	local %ENV = %ENV;
	$ENV{PATH} = '/bin:/usr/bin:/usr/sbin';
	delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
	my $currdir = cwd();
	$share_path = "$currdir/$share_path";
    }

    # not finding the ShareDir creates a hard error, because the Apache/ASP/Share
    # directory will become one of the fundamental underpinings of the project
    # People will need to rely on being able to load shared includes, and not have
    # to discover the lack of loading Share:: at runtime, rather this is a compile
    # time error.
    -d $share_path || die("Apache::ASP::Share directory not found.  ".
			  "Please make sure to install all the modules that make up the Apache::ASP installation."
			 );
    $ShareDir = $share_path;

    # once we find the $ShareDir, we can truncate the library path
    # and push it onto @INC with use lib... this is to help with loading
    # future Apache::ASP::* modules when the lib path it was found at is 
    # relative to some directory.  This was needed to have the "make test"
    # test suite to work which loads libraries from "blib/lib", but Apache::ASP
    # will chdir() into the script directory so that can ruin this
    # library lookup.
    #
    my $lib_path = $share_path;
    $lib_path =~ s/Apache.ASP.Share.?$//s;
    -d $lib_path || die("\%INC library path $lib_path not found.");
    $INCDir = $lib_path;
    
    # clear taint, for some reason, tr/// or s/^(.*)$/ did not work on perl 5.6.1
    $INCDir =~ /^(.*)$/s;
    $INCDir = $1;

    # make sure this gets on @INC at startup, can't hurt
    eval "use lib qw($INCDir);";

    1;
}

sub FileId {
    my($self, $file, $abs_file, $no_compile_checksum) = @_;
    $file || die("no file passed to FileId()");
    my $id;

    # calculate compile checksum for file id
    unless($self->{compile_checksum}) {
	my $r = $self->{r};
	my $checksum = md5_hex(join('&-+', 
				    $VERSION,
				    map { &config($self, $_) || '' }
				    @CompileChecksumKeys
				   )
			      );
	#    $self->{dbg} && $self->Debug("compile checksum $checksum");
	$self->{compile_checksum} = $checksum;
    }

    my $compile_checksum = $no_compile_checksum ? '' : $self->{compile_checksum};

    my @inode_stat = ();
    if($self->{inode_names}) {
	@inode_stat = stat($file);
	# one or the other device or file ids must be not 0
	unless($inode_stat[0] || $inode_stat[1]) {
	    @inode_stat = ();
	}
    }

    if(@inode_stat) {
	$id = sprintf("____DEV%X_INODE%X",@inode_stat[0,1]);
	$id .= 'x'.$compile_checksum;
    } else {
	if($abs_file) {
	    $file = $abs_file;
	}
	$file =~ s|/+|/|sg;
	$file =~ s/[\Wx]/_/sg;
	my $file_name_length = length($file);
	if($file_name_length >= 35) {
	    $id = substr($file, $file_name_length - 35, 36);
	    # only do the hex of the original file to create a unique identifier for the long id
	    $id .= 'x'.&md5_hex($file.$compile_checksum);
	} else {
	    $id = $file.'x'.$compile_checksum;
	}
    }

    $id = '__ASP_'.$id;
}

# defaults to parsing the script's file, or data from a file handle 
# in the case of filtering, but we can also pass in text to parse,
# which is useful for doing includes separately for compiling
sub Parse {
    my($self, $file) = @_;

ASP.pm  view on Meta::CPAN

http://perl.apache.org/src/apache-modlist.html

To gain access to the ASP objects like $Session outside
in a non-PerlHandler mod_perl handler, you may use this API:
  
  my $ASP = Apache::ASP->new($r); # $r is Apache->request object

as in this possible Authen handler:

  <Perl>
    use Apache::ASP;
    sub My::Auth::handler {
      my $r = shift;
      my $ASP = Apache::ASP->new($r) 
      my $Session = $ASP->Session;
    }
  </Perl>

Here are some examples of do-it-yourself mod_perl
handler programming...

 === Forbid Bad HSlide User Agent ===

 # httpd.conf
 PerlAccessHandler My::Access
 <Perl>
   sub My::Access::handler {
     my $r = shift;
     if($r->headers_in->{'USER_AGENT'} =~ /HSlide/) {
	 403;
     } else {
	 200;
     }
   }
 </Perl>

 === Runtime Path Parsing ===

This example shows how one might take an arbitrary
URL path /$path/$file.asp, and turn that into a runtime 
config for your site, so your scripts get executed
always in your sites DocumentRoot.

 INPUT URL /SomeCategory/
 OUTPUT
  Script: index.asp
  $Server->Config('PATH') eq '/SomeCategory'

 INPUT URL /SomeCategory/index.asp
 OUTPUT
  Script: index.asp
  $Server->Config('PATH') eq '/SomeCategory'

 INPUT URI /index.asp
 OUTPUT
  Script: index.asp
  $Server->Config('PATH') eq ''

 # httpd.conf
 PerlTransHandler My::Init
 use lib qw( $custom_perllib );

 # $custom_perllib/My/Init.pm
 package My::Init;
 use strict;
 use Apache::Constants qw(:common);
 sub handler {
    my $r = shift;

    my $uri = $r->uri || '/';
    unless($uri =~ m|^(.*)(/([^/.]+\.[\w]+)?)$|i) {
	warn("can't parse uri $uri");
	return DECLINED;
    }
    $uri = $2;
    my $PATH = $1 || '';
    $r->dir_config('PATH', $PATH);

    if($uri eq '/') {
	$uri = '/index.asp';
    }

    $r->uri($uri);
    $r->filename($r->document_root.$uri);

    DECLINED;
 }

 1;

=head1 OBJECTS

The beauty of the ASP Object Model is that it takes the
burden of CGI and Session Management off the developer, 
and puts them in objects accessible from any
ASP script & include.  For the perl programmer, treat these objects
as globals accessible from anywhere in your ASP application.

The Apache::ASP object model supports the following:

  Object         Function
  ------         --------
  $Session      - user session state
  $Response     - output to browser
  $Request      - input from browser
  $Application  - application state
  $Server       - general methods

These objects, and their methods are further defined in the 
following sections.

If you would like to define your own global objects for use 
in your scripts and includes, you can initialize them in 
the global.asa Script_OnStart like:

 use vars qw( $Form $Site ); # declare globals
 sub Script_OnStart {
     $Site = My::Site->new;  # init $Site object
     $Form = $Request->Form; # alias form data
     $Server->RegisterCleanup(sub { # garbage collection
				  $Site->DESTROY;