view release on metacpan or  search on metacpan

lib/Apache/ASP/Server.pm  view on Meta::CPAN

    my $asp = $self->{asp};

    # dynamically load OLE at request time, especially since
    # at server startup, this seems to fail with "start_mutex" error
    #
    # no reason to preload this unix style when module loads
    # because in win32, threaded model does not need this prefork 
    # parent httpd compilation
    #
    unless(defined $OLESupport) {
	eval 'use Win32::OLE';
	if($@) {
	    $OLESupport = 0;
	} else {
	    $OLESupport = 1;
	}
    }

    unless($OLESupport) {
	die "OLE-active objects not supported for this platform, ".
	    "try installing Win32::OLE";
    }

    unless($name) {
	die "no object to create";
    }

    Win32::OLE->new($name);
}

sub Execute {
    my $self = shift;
    $self->{asp}{Response}->Include(@_);
}

sub File {
    shift->{asp}{filename};
}

sub Transfer {
    my $self = shift;

    my $file = shift;
    
    # find the file we are about to execute, and alias $0 to it
    my $file_found;
    if(ref($file)) {
	if($file->{File}) {
	    $file_found = $self->{asp}->SearchDirs($file->{File});
	}
    } else {
	$file_found = $self->{asp}->SearchDirs($file);
    }
    my $file_final = defined($file_found) ? $file_found : $0;
    
    local *0 = \$file_final;
    $self->{asp}{Response}->Include($file, @_);
    $self->{asp}{Response}->End;
}

# shamelessly ripped off from CGI.pm, by Lincoln D. Stein.
sub URLEncode {
    my $toencode = $_[1];
    $toencode =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/esg;
    $toencode;
}

sub HTMLDecode {
    my($self, $decode) = @_;
    
    $decode=~s/>/>/sg;
    $decode=~s/&lt;/</sg;
    $decode=~s/&#39;/'/sg;
    $decode=~s/&quot;/\"/sg;
    $decode=~s/&amp;/\&/sg;
    
    $decode;
}

sub HTMLEncode {
    my($self, $toencode) = @_;
    return '' unless defined $toencode;

    my $data_ref;
    if(ref $toencode) {
	$data_ref = $toencode;
    } else {
	$data_ref = \$toencode;
    }

    $$data_ref =~ s/&/&amp;/sg;
    $$data_ref =~ s/\"/&quot;/sg;
    $$data_ref =~ s/\'/&#39;/sg;
    $$data_ref =~ s/>/&gt;/sg;
    $$data_ref =~ s/</&lt;/sg;

    ref($toencode) ? $data_ref : $$data_ref;
}

sub HTMLEncodeByValue {
    my($self, $toencode) = @_;
    return '' unless defined $toencode;

    $toencode =~ s/&/&amp;/sg;
    $toencode =~ s/\"/&quot;/sg;
    $toencode =~ s/\'/&#39;/sg;
    $toencode =~ s/>/&gt;/sg;
    $toencode =~ s/</&lt;/sg;

    return $toencode;
}

sub RegisterCleanup {
    my($self, $code) = @_;
    if(ref($code) =~ /^CODE/) {
	$self->{asp}{dbg} && $self->{asp}->Debug("RegisterCleanup() called", caller());
	push(@{$self->{asp}{cleanup}}, $code);
    } else {
	$self->{asp}->Error("$code need to be a perl sub reference, see README");
    }
}