Apache2-ASP

 view release on metacpan or  search on metacpan

lib/Apache2/ASP/ASPDOM/Document.pm  view on Meta::CPAN

use strict;
use warnings 'all';
use base 'Apache2::ASP::ASPDOM::Node';


#==============================================================================
sub new
{
  my ($class) = shift;
  
  my $s = $class->SUPER::new( @_ );
  
  return $s;
}# end new()

1;# return true:

lib/Apache2/ASP/ASPPage.pm  view on Meta::CPAN

  # Preamble:
  my $code = <<"CODE";
package @{[ $s->package_name ]};

use strict;
use warnings 'all';
no warnings 'redefine';
our \$TIMESTAMP = @{[ time() ]};

sub _initialize_page {
  eval { \$_[0]->SUPER::_initialize_page };
  \$_[0]->init_asp_objects( \$_[0]->context );
  \$_[0] = $dump;
  \$_[0]->{masterpage} = \$_[0]->{masterpage}->new( virtual_path => '$virtual_path' ) if \$_[0]->{masterpage};
  \$_[0];
}

CODE
  
  # Things work differently if we have/don't have a master page:
  if( $s->masterpage )

lib/Apache2/ASP/Config.pm  view on Meta::CPAN

use warnings 'all';
use Carp 'confess';
use base 'Apache2::ASP::ConfigNode';


#==============================================================================
sub new
{
  my ($class, $ref, $root) = @_;
  
  my $s = $class->SUPER::new( $ref );
  
  $s->init_server_root( $root );
  
  $s->_init_inc();
  
  foreach my $var ( $s->system->env_vars )
  {
    while( my ($key,$val) = each(%$var) )
    {
      $ENV{$key} = $val;

lib/Apache2/ASP/ConfigNode/System.pm  view on Meta::CPAN

use warnings 'all';
use base 'Apache2::ASP::ConfigNode';
use Apache2::ASP::ConfigNode::System::Settings;


#==============================================================================
sub new
{
  my $class = shift;
  
  my $s = $class->SUPER::new( @_ );
  $s->{settings} = Apache2::ASP::ConfigNode::System::Settings->new( $s->{settings} || { setting => [ ] } );
  
  return $s;
}# end new()


#==============================================================================
sub libs
{
  my $s = shift;

lib/Apache2/ASP/ConfigNode/System/Settings.pm  view on Meta::CPAN

use strict;
use warnings 'all';
use base 'Apache2::ASP::ConfigNode';


#==============================================================================
sub new
{
  my $class = shift;
  
  my $s = $class->SUPER::new( @_ );
  
  return $s;
}# end new()


#==============================================================================
sub AUTOLOAD
{
  my $s = shift;
  our $AUTOLOAD;

lib/Apache2/ASP/ConfigNode/Web.pm  view on Meta::CPAN

use strict;
use warnings 'all';
use base 'Apache2::ASP::ConfigNode';


#==============================================================================
sub new
{
  my $class = shift;
  
  my $s = $class->SUPER::new( @_ );
  $s->{handler_resolver}  ||= 'Apache2::ASP::HTTPContext::HandlerResolver';
  $s->{handler_runner}    ||= 'Apache2::ASP::HTTPContext::HandlerRunner';
  $s->{filter_resolver}   ||= 'Apache2::ASP::HTTPContext::FilterResolver';
  
  map {
    $_->{uri_match} = undef unless defined($_->{uri_match});
    $_->{uri_equals} = undef unless defined($_->{uri_equals});
    $_ = $class->SUPER::new( $_ );
  } $s->request_filters;
  map {
    $_->{uri_match} = undef unless defined($_->{uri_match});
    $_->{uri_equals} = undef unless defined($_->{uri_equals});
    $_->{disable_session} ||= 0;
    $_->{disable_application} ||= 0;
    $_ = $class->SUPER::new( $_ );
  } $s->disable_persistence;
  return $s;
}# end new()


#==============================================================================
sub request_filters
{
  my $s = shift;
  

lib/Apache2/ASP/Manual/BestPractices.pod  view on Meta::CPAN

Inside C</t> create C</t/00-basic.t> which contains:

  #!/usr/bin/env perl -w
  
  use strict;
  use warnings 'all';
  use Test::More 'no_plan';
  use base 'Apache2::ASP::Test::Base';
  
  # Create our base test object:
  my $s = __PACKAGE__->SUPER::new();
  
  # Make a request:
  my $res = $s->ua->get("/index.asp");
  
  # $res is a normal HTTP::Response object:
  ok( $res->is_success => "Got /index.asp" );
  like $res->content, qr/Hello, World/, "Contents look right";
  is( $res->header('content-type') => 'text/html' );

Run your tests with:

lib/Apache2/ASP/MediaManager.pm  view on Meta::CPAN

  return $context->config->web->media_manager_upload_root . "/$filename";
}# end compose_upload_file_path()


#==============================================================================
sub upload_start
{
  my ($s, $context, $Upload) = @_;
  
  shift(@_);
  $s->SUPER::upload_start( $context, $Upload );

  my $filename = $s->compose_upload_file_name( @_ );
  
  # Make sure we can open the file for writing:
  my $target_file = $s->compose_upload_file_path( $context, $Upload, $filename);
  
  # Open the file for writing:
  my $ofh = $s->open_file_for_writing($context, $target_file);
  print $ofh delete($Upload->{data});
  

lib/Apache2/ASP/MediaManager.pm  view on Meta::CPAN

  }# end if()
}# end upload_start()


#==============================================================================
sub upload_hook
{
  my ($s, $context, $Upload) = @_;
  
  shift(@_);
  $s->SUPER::upload_hook( @_ );
  
  my $filename = eval {
    my $name = $ENV{filename}; # $context->r->pnotes( 'filename' );
    $name;
  } or return;
  
  my $ofh = $s->open_file_for_appending($context, $filename);
  no warnings 'uninitialized';
  print $ofh delete($Upload->{data});
  $ofh->close;
}# end upload_hook()


#==============================================================================
sub upload_end
{
  my ($s, $context, $Upload) = @_;
  
  shift(@_);
  $s->SUPER::upload_end( @_ );
  
  # Return information about what we just did:
  my $info = {
    new_file      => $ENV{filename},
    filename_only => $ENV{download_file},
    link_to_file  => "/media/" . $ENV{download_file},
  };
  $Upload->{$_} = $info->{$_} foreach keys(%$info);
  
  # Depending on the 'mode' parameter, we do different things:

lib/Apache2/ASP/ModPerl2CGI.pm  view on Meta::CPAN

use base 'CGI::Apache2::Wrapper';
use Apache2::ASP::SimpleCGI;
use Carp 'confess';


#==============================================================================
sub new
{
  my ($class, $r, $upload_hook) = @_;

  my $s = $class->SUPER::new( $r );
  $s->{r} = $r;
  if( ref($upload_hook) eq 'CODE' )
  {
    my $req = Apache2::Request->new(
      $r,
      UPLOAD_HOOK => $upload_hook,
    );
    $s->req(
      $req
    );

lib/Apache2/ASP/TransHandler.pm  view on Meta::CPAN

  package My::TransHandler;
  
  use strict;
  use warnings 'all';
  use base 'Apache2::ASP::TransHandler';
  use Apache2::ASP::ConfigLoader;
  
  sub handler : method {
    my ($class, $r) = @_;
    
    my $super_response = $class->SUPER::handler( $r );
    
    my $config = Apache2::ASP::ConfigLoader->load();
    
    # Do stuff...
    calculate_pi_to_the_billionth_decimal_place();
    
    # Finally...
    return $super_response;
  }
  

sbin/asphelper  view on Meta::CPAN

print $t_ofh <<'TEST';
#!/usr/bin/perl -w

use strict;
use warnings 'all';
use Test::More 'no_plan';
use base 'Apache2::ASP::Test::Base';
use HTML::Form;
use Data::Properties::YAML;

ok( my $s = __PACKAGE__->SUPER::new() );

# Get our contact_form testing data:
my %data = $s->data->contact_form->as_hash;
my $props = Data::Properties::YAML->new(
  properties_file => $s->ua->context->config->web->application_root . '/etc/properties.yaml',
)->contact_form;

# Will it load?:
{
  my $res = $s->ua->get("/examples/contact.asp");

sbin/runasp  view on Meta::CPAN

use strict;
use warnings 'all';
use base 'Apache2::ASP::Test::Base';
use Data::Dumper;

my $url = shift(@ARGV) or die <<"USAGE";
  Usage:  $0 "<url>"
USAGE

my $s = __PACKAGE__->SUPER::new();

my $res = $s->ua->get( $url );
if( $res->is_success )
{
  print $res->as_string;
}
else
{
  warn "ERROR - Response As Follows:\n" . ("="x80) . "\n\n" . $res->as_string;
}# end if()

t/900-old-tests/01.00-a-memory-leak.t  view on Meta::CPAN

#!/usr/bin/env perl -w

use strict;
use warnings 'all';
use base 'Apache2::ASP::Test::Base';
use Test::More 'no_plan';
use Test::Memory::Cycle;

ok( 1 );

my $s = __PACKAGE__->SUPER::new();

$s->ua->get("/hello-world.asp");
$s->ua->get("/index.asp");

__END__

for( 1...100 )
{
  $s->ua->get("/hello-world.asp");
  

t/900-old-tests/01.01-master-recursive.t  view on Meta::CPAN

#!/usr/bin/env perl -w

use strict;
use warnings 'all';
use base 'Apache2::ASP::Test::Base';
use Test::More 'no_plan';

my $s = __PACKAGE__->SUPER::new();

my $res = $s->ua->get("/masters/main.asp");
ok( $res->is_success );


$res = $s->ua->get("/index.asp");
ok( $res->is_success );

t/900-old-tests/01.08-upload.t  view on Meta::CPAN

#!/usr/bin/env perl -w

use strict;
use warnings 'all';
use Test::More 'no_plan';
use base 'Apache2::ASP::Test::Base';

my $s = __PACKAGE__->SUPER::new();
ok( $s );

# Make the file to upload:
my $upload_filename = '/tmp/asp-upload-test.txt';
open my $ofh, '>', $upload_filename
  or die "Cannot open '$upload_filename' for writing: $!";
for( 1...10_000 )
{
  print $ofh "$_: This is a line of text\n";
}# end for()

t/900-old-tests/01.09-submit-form.t  view on Meta::CPAN

#!/usr/bin/env perl -w

use strict;
use warnings 'all';
use base 'Apache2::ASP::Test::Base';
use Test::More 'no_plan';
use HTML::Form;

my $s = __PACKAGE__->SUPER::new();

my $res = $s->ua->get("/simple-form.asp");
my $form = HTML::Form->parse( $res->content, '/' );
$form->find_input('color')->value('Red');
$res = $s->ua->submit_form( $form );

like
  $res->content,
  qr/Your color is "Red"/
;

t/900-old-tests/04.00-nested-master.t  view on Meta::CPAN

#!/usr/bin/env perl -w

use strict;
use warnings 'all';
use Test::More 'no_plan';
use base 'Apache2::ASP::Test::Base';

my $s = __PACKAGE__->SUPER::new();

my $res = $s->ua->get('/page-using-nested-masterpage.asp');
ok( $res->is_success );

unlike $res->content, qr/<asp:(PlaceHolder|PlaceHolderContent)/;

like $res->content, qr/\<h1\>\s+This is inside the nested placeholder\!\s+\<\/h1\>/s;

t/900-old-tests/04.01-syntax-errors.t  view on Meta::CPAN

#!/usr/bin/env perl -w

use strict;
use warnings 'all';
use base 'Apache2::ASP::Test::Base';
#use Test::More 'no_plan';
use Test::More;
plan skip_all => 'Test irrelevant for now';


my $s = __PACKAGE__->SUPER::new();

# Syntax error in the requested page:
{
  local $SIG{__WARN__} = sub { 0 };
  my $res = eval { $s->ua->get("/coverage/syntax-error.asp") };

  ok( ! $res->is_success, "unsuccessful" );
  ok( $res->status_line =~ m/500\s+/, "status code of 500: '" . $res->status_line . "'" );

  ok(

t/900-old-tests/04.02-include-at-end.t  view on Meta::CPAN

#!/usr/bin/env perl -w

use strict;
use warnings 'all';
use Test::More 'no_plan';
use base 'Apache2::ASP::Test::Base';

my $s = __PACKAGE__->SUPER::new();

my $res = $s->ua->get("/include-at-end.asp");

like $res->content, qr/Main page content/;

t/900-old-tests/04.03-unhandled-tag.t  view on Meta::CPAN

#!/usr/bin/env perl -w

use strict;
use warnings 'all';
use Test::More 'no_plan';
use base 'Apache2::ASP::Test::Base';

ok( my $s = __PACKAGE__->SUPER::new() );

my $res = eval {
  $s->ua->get("/coverage/unhandled-tag.asp");
};


#{
#  $^W = 0;
#  like $res->content, qr@Unhandled tag 'unknown\:tag' in '/coverage/unhandled-tag.asp'@;
#}

t/900-old-tests/05.00-folder-uri.t  view on Meta::CPAN

#!/usr/bin/env perl -w

use strict;
use warnings 'all';
use Test::More 'no_plan';
use base 'Apache2::ASP::Test::Base';

ok( my $s = __PACKAGE__->SUPER::new() );

my $res1 = eval { $s->ua->get("/") };
my $res2 = $s->ua->get("/index.asp");

is( $res1->content => $res2->content );

my $res3 = $s->ua->get("/cleanup-register.asp");
is( $ENV{CALLED_REGISTER_CLEANUP} => 1 );

t/lib/My/ErrorHandler.pm  view on Meta::CPAN

#==============================================================================
sub run
{
  my ($s, $context) = @_;
  
  $Response->Write( $Stash->{error}->{stacktrace} );
  
  eval {
    $s->SUPER::run( $context );
  };
}# end run()

1;# return true: