Apache2-ASP

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN


2.42    2009-11-11
  - You can now test multiple websites at the same time (eg: Public and Admin websites)
    from within the same test script.  Example given in POD for Apache2::ASP::API

2.41    2009-10-14
  - Bugfix: Errors will now appear on-screen, rather than the default Apache error.

2.40    2009-10-14
  - Enhancement: multipart/form-data posts to MediaManagers no longer require
    actual files to be uploaded.  Useful for forms that have an optional file upload field.

2.39    2009-08-23
  - Bugfix:  Deeply-nexted MasterPage setups sometimes did not initialize the
    intrinsic ASP objects in the root-most MasterPage ($Response, $Session, etc).

2.38    2009-08-09
  - Bugfix: $Response->Redirect in a handler after $Response->TrapInclude gave
    errors "Response.Status cannot be changed after headers have been sent" (this
    is now fixed).

2.37    2009-06-10
  - API change: Upload hooks are deprecated and all but disabled.
  - Bugfix: The upload_start event was not getting called for UploadHandler or its subclasses.

2.37_03 2009-05-19
  - Bugfix: On Apache2 under Gentoo (perhaps others as well) HTTPContext->send_headers
    was not always called before content was written to the client.  This caused
    cookies and other headers to not get written to the client.

2.37_02 2009-05-14
  - Uploads' filehandle was not closed, causing problems where the last few bytes
    were not flushed to disk.

Changes  view on Meta::CPAN


2.26  2009-02-09
  - Forgot the *::NonPersisted state managers in the MANIFEST

2.25  2009-02-09
  - Added <disable_persistence> element to the XML config. Disabling persistence
    for high-traffic pages is sometimes necessary and/or desirable.

2.24  2009-02-03
  - Narrowed the search for leaked open filehandles to Apache2::ASP::SimpleCGI
    when handling a file upload in test/API mode.  Added DESTROY handler to close
    any remaining filehandles when the object goes out of scope.

2.23  2009-02-01
  - "Too many open filehandles" error was popping up.  Attempting to use IO::File
    to solve this problem.
  - Added IO::File as a prerequisite file.

2.22  2009-01-31
  - Apache2::ASP::MediaManager was misbehaving when attempting to delete a file
    no longer on disk.

Changes  view on Meta::CPAN

    gets called at the end of each request - not when the pool object goes out
    of scope (which caused some unwanted behavior).

2.17  2009-01-28
  - More tweaking.  Please upgrade to this version.

2.16  2009-01-28
  - Apache2::ASP::Mock::RequestRec sometimes confess()ed if Response->Include was called.

2.15  2009-01-28
  - Made some minor tweaks to the way uploads are handled internally.  No public changes.

2.14  2009-01-25
  - <asp:Content/> tags inside of pages that use MasterPages were not being passed 
    TrapInclude or Include arguments (i.e. $Response->Include("/page.asp", { arg1 => "foo" }) ).

2.13  2009-01-25
  - Apache2::ASP::MediaManager did not provide any content-type header for
    file types not listed in MIME::Types (eg: *.ogv).  Now "application/octet-stream"
    is returned when MIME::Types does not return anything.

Changes  view on Meta::CPAN

  - DTD for XML Config is now included.

2.00_14   2008-10-31
  - If querystring or form data contains multiple values for the same parameter,
    that parameter will become an arrayref of values.
  - Multiple config post-processors can be defined in the config XML file.  They
    will be executed in the order they are listed in the config XML file.
  - Nested master pages are now supported.

2.00_13   2008-10-30
  - Each upload form submission should now include a unique "uploadID=xxx" value.
  - Multiple concurrent uploads from the same user under the same session are
    now supported because of the uploadID=xxx logic.

2.00_12   2008-10-29
  - (handler)->init_asp_objects( $context ) was not getting called correctly.

2.00_11   2008-10-29
  - ASPPage updated so that pages containing "~" in their text will not cause
    syntax errors after being parsed.
  - File uploads are handled correctly by ModPerl, UploadHandler and MediaManager.

2.00_10   2008-10-26
  - Server.RegisterCleanup(\&subref, \@argref) now fires both from the command-line
    and within an actual mod_perl environment.

2.00_09   2008-10-24
  - Pages that use MasterPages are now executed with the correct @_.
  - Added Apache2::ASP::FormHandler again.

2.00_08   2008-10-23

Changes  view on Meta::CPAN

  - Code Coverage: 70.50% (average:stmt+bran+cond+sub)
  - Bugfix: Application->save was getting called at the beginning and end of 
    *every* request.  This behavior has been fixed.
  - Various minor tweaks, removing "vestigial" code chunks.
  - Subclassing Apache2::ASP::HTTPContext is now possible.
  - Syntax errors inside of includes are handled better.

2.00_04   2008-10-16
  - Added missing files to MANIFEST.
  - Added UploadHandler and MediaManager back to the distribution.
  - Added some upload tests.

2.00_03   2008-10-16
  - Added missing files to MANIFEST.

2.00_02   2008-10-15
  - Partial page caching has been realized.

2.00_01   2008-10-15
  - Complete rewrite.
  !!!! BREAKING CHANGES !!!!

Changes  view on Meta::CPAN

    This problem would only come up when multiple Apache2::ASP web applications
    using different session data sources were running under the same Apache
    instance.
  - Ditto for Apache2::ASP::ApplicationStateManager.

1.54 2008-07-05
  - Adjusted Apache2::ASP::MediaManager so that it will not unlink the /MEDIA
    directory if someone attempts to delete a file and neglects to specify
    which file should be deleted.
  - Also updated Apache2::ASP::MediaManager to more gracefully handle missing
    uploaded files.

1.53 2008-07-05
  - Fixed a bug that caused Apache2::ASP::Config to die if no request filters
    were specified within the <request_filters> element in the config file.

1.52 2008-06-18
  - While using Apache2::ASP::Test::Base, $ENV{APACHE2_ASP_APPLICATION_ROOT} 
    is now persisted between requests.  This means that if (somewhere else)
    you set $ENV{APACHE2_ASP_APPLICATION_ROOT} in your code, it will persist
    between requests.

MANIFEST  view on Meta::CPAN

t/900-old-tests/00.01-subcontext.t
t/900-old-tests/01.00-a-memory-leak.t
t/900-old-tests/01.01-load.t
t/900-old-tests/01.01-master-recursive.t
t/900-old-tests/01.02-findconfig.t
t/900-old-tests/01.03-configloader.t
t/900-old-tests/01.04-test-useragent.t
t/900-old-tests/01.05-memcycle.t
t/900-old-tests/01.06-cookies.t
t/900-old-tests/01.07-post.t
t/900-old-tests/01.08-upload.t
t/900-old-tests/01.09-submit-form.t
t/900-old-tests/02.01-benchmark.t
t/900-old-tests/03.08-aspdom-node.t
t/900-old-tests/04.00-nested-master.t
t/900-old-tests/04.01-syntax-errors.t
t/900-old-tests/04.02-include-at-end.t
t/900-old-tests/04.03-unhandled-tag.t
t/900-old-tests/05.00-folder-uri.t
t/999-cleanup/99.99-cleanup.t
t/MEDIA/asp-upload-test.txt
t/conf/apache2-asp-config.xml
t/conf/configuration.dtd
t/conf/httpd.conf
t/htdocs/simple-form.asp
t/htdocs/index.asp
t/htdocs/coverage/page-using-syntax-error-masterpage.asp
t/htdocs/coverage/includes-syntax-error.asp
t/htdocs/coverage/syntax-error.asp
t/htdocs/coverage/syntax-error-master.asp
t/htdocs/upload.asp
t/htdocs/nostate/index.asp
t/htdocs/page-using-nested-masterpage.asp
t/htdocs/inc.asp
t/htdocs/masters/main.asp
t/htdocs/masters/root.asp
t/htdocs/masters/nested-master.asp
t/htdocs/subcontext/inc1-1.asp
t/htdocs/subcontext/inc1.asp
t/htdocs/subcontext/trapinclude.asp
t/htdocs/subcontext/normal.asp
t/htdocs/subcontext/inc2b.asp
t/htdocs/subcontext/trapped.asp
t/htdocs/subcontext/include-2-levels-deep.asp
t/htdocs/subcontext/include-1-level-deep.asp
t/htdocs/subcontext/inc2a.asp
t/htdocs/include-at-end.asp
t/htdocs/cleanup-register.asp
t/handlers/upload01.pm
t/handlers/simple.pm
t/handlers/redirect_after_trapinclude.pm
t/lib/My/ErrorHandler.pm
t/lib/My/MemberFilter.pm
t/lib/My/MemberFilter2.pm
t/lib/My/FailFilter.pm
t/lib/My/BadHandlerResolver.pm
t/lib/My/ConfigPostProcessor.pm
t/PAGE_CACHE/DefaultApp/.ok
t/MEDIA/.ok

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

one that you could subclass and add your own features to?

That's what Apache2::ASP::API is all about.

Apache2::ASP::API provides a programatic interface to your Apache2::ASP web 
applications, allowing you to execute requests against ASP scripts and handlers
just as you would from a browser, but without the use of an HTTP server.

=head2 Why do I need this?

Consider the case where you want to upload hundreds of files into your website,
but you don't want to do it one-at-a-time.

The following snippet of code would do the trick:

  #!/usr/bin/perl -w
  
  use strict;
  use warnings 'all';
  use Apache2::ASP::API;
  
  my $api = Apache2::ASP::API->new();
  
  my @files = @ARGV or die "Usage: $0 <filename(s)>\n";
  
  foreach my $file ( @files )
  {
    # Assuming /handlers/MM is a subclass of Apache2::ASP::MediaManager:
    my $id = rand();
    my $res = $api->upload("/handlers/MM?mode=create&uploadID=$id", [
      filename => [ $file ]
    ]);
    
    die "Error on '$file': " . $res->as_string
      unless $res->is_success;
    
    print "'$file' uploaded successfully\n";
  }# end foreach()

If only logged-in users may upload files, simply log in before uploading anything:

  my $api = Apache2::ASP::API->new();
  
  my $res = $api->ua->post("/handlers/user.login", {
    user_email    => $email,
    user_password => $password,
  });
  
  # Assuming $Session->{user} is set upon successful login:
  unless( $api->session->{user} )
  {
    die "Invalid credentials";
  }# end unless()
  
  ... continue uploading files ...

Or...you could even subclass the API with your own:

  package MyApp::API;
  
  use strict;
  use warnings 'all';
  use base 'Apache2::ASP::API';
  
  sub login

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

    unless( $api->session->{user} )
    {
      die "Invalid credentials";
    }# end unless()
    
    return 1;
  }# end login()
  
  1;# return true:

Then your uploader script could just do this:

  #!/usr/bin/perl -w
  
  use strict;
  use warnings 'all';
  use MyApp::API;
  
  my $api = MyApp::API->new();
  $api->login( 'test@test.com', 's3cr3t!' );
  
  # Upload all the files:
  $api->ua->upload("/handlers/MM?mode=create&uploadID=" . rand(), [
    filename => [ $_ ]
  ]) foreach @ARGV;

=head1 INTEGRATION TESTING

I often develop websites that have both "public" and an "administrative" interfaces
that are completely different websites.

For instances in which users of the public website are allowed to submit records
that an administrator would manage through the administrative interface, this presents

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

  foreach( @{ $s->{system}->{libs}->{lib} } )
  {
    $_ =~ s/\@ServerRoot\@/$root/;
  }# end foreach()
  
  foreach( @{ $s->{system}->{settings}->{setting} } )
  {
    $_->{value} =~ s/\@ServerRoot\@/$root/;
  }# end foreach()
  
  foreach my $key (qw/ application handler media_manager_upload www page_cache /)
  {
    $s->{web}->{"$key\_root"} =~ s/\@ServerRoot\@/$root/;
  }# end foreach()
}# end init_server_root()


#==============================================================================
sub load_class
{
  my ($s, $class) = @_;

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

  $Config->errors->error_handler;
  $Config->errors->mail_errors_to;
  $Config->errors->mail_errors_from;
  $Config->errors->smtp_server;
  
  # Web:
  $Config->web->application_name;
  $Config->web->application_root;
  $Config->web->www_root;
  $Config->web->handler_root;
  $Config->web->media_manager_upload_root;
  $Config->web->page_cache_root;
  
  # Data Connections:
  foreach my $conn ( map { $Config->data_connections->$_ } qw/ session application main / )
  {
    my $dbh = DBI->connect(
      $conn->dsn,
      $conn->username,
      $conn->password
    );

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

      <mail_errors_to>jdrago_999@yahoo.com</mail_errors_to>
      
      <mail_errors_from>root@localhost</mail_errors_from>
      <smtp_server>localhost</smtp_server>
    </errors>
    
    <web>
      <application_name>DefaultApp</application_name>
      <application_root>@ServerRoot@</application_root>
      <handler_root>@ServerRoot@/handlers</handler_root>
      <media_manager_upload_root>@ServerRoot@/MEDIA</media_manager_upload_root>
      <www_root>@ServerRoot@/htdocs</www_root>
      <page_cache_root>@ServerRoot@/PAGE_CACHE</page_cache_root>
      <request_filters>
  <!--
        <filter>
          <uri_match>/.*</uri_match>
          <class>My::MemberFilter</class>
        </filter>
        <filter>
          <uri_equals>/index.asp</uri_equals>

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


Given the following configuration...

  <?xml version="1.0"?>
  <config>
    ...
    <web>
      <application_name>MyApp</application_name>
      <application_root>@ServerRoot@</application_root>
      <handler_root>@ServerRoot@/handlers</handler_root>
      <media_manager_upload_root>@ServerRoot@/MEDIA</media_manager_upload_root>
      <www_root>@ServerRoot@/htdocs</www_root>
      <page_cache_root>/tmp/PAGE_CACHE</page_cache_root>
      <request_filters>
        <filter>
          <uri_match>/members/.*</uri_match>
          <class>My::MemberFilter</class>
        </filter>
        <filter>
          <uri_match>/checkout/.*</uri_match>
          <class>My::HasOrderFilter</class>

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

      </request_filters>
    </web>
    ...
  </config>

You would access it like this:

  $Config->web->application_name;           # 'MyApp'
  $Config->web->application_root;           # '/usr/local/projects/mysite.com'
  $Config->web->handler_root;               # '/usr/local/projects/mysite.com/handlers'
  $Config->web->media_manager_upload_root;  # '/usr/local/projects/mysite.com/MEDIA'
  $Config->web->www_root;                   # '/usr/local/projects/mysite.com/htdocs'
  $Config->web->page_cache_root;            # '/tmp/PAGE_CACHE'
  
  You will never need to do this:
  foreach my $filter ( $Config->web->request_filters )
  {
    my $regexp  = $filter->uri_match;
    my $class   = $filter->class;
  }# end foreach()

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

Returns the name of the application.

=head2 application_root

Returns the absolute path to the root of the application, i.e. C</usr/local/projects/mysite.com>

=head2 handler_root

Returns the absolute path to where the 'handlers' are installed, i.e. C</usr/local/projects/mysite.com/handlers>

=head2 media_manager_upload_root

Returns the absolute path to where uploaded files will be stored, i.e. C</usr/local/projects/mysite.com/MEDIA>

=head2 www_root

Returns the absolute path to where the normal website files (ASP, images, css, javascripts, etc) are located, 
i.e. C</usr/local/projects/mysite.com/htdocs>

=head2 page_cache_root

Returns the absolute path to where 'compiled' ASP scripts are stored, i.e. C</tmp/PAGE_CACHE>

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

in which the included ASP scripts are executed.  MasterPages do not require this
extra work.

=head1 HANDLERS

Generally speaking, all forms should submit to handlers, rather than other ASP
scripts.  This results in a predictable MVC setup.

Of course, Apache2::ASP doesn't B<force> you to do this.  You can do whatever you want.

However, if you upload a file, you must upload it to a subclass of L<Apache2::ASP::UploadHandler>.
Generally you would inherit from L<Apache2::ASP::MediaManager> though, if you plan on
doing much with uploaded files.

=head2 Namespaces

Because of the way namespaces work in Perl, web servers with multiple VirtualHosts
should keep all handlers in their own namespaces.

For example:

B<Site 1>:

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

    <error_handler>...</error_handler>
    <mail_errors_to>...</mail_errors_to>
    <mail_errors_from>...</mail_errors_from>
    <smtp_server>...</smtp_server>
  </errors>

Make changes as necessary.

=head1 FILE UPLOADS

Almost any time you need to process a file upload, your best bet is to subclass
L<Apache2::ASP::MediaManager>.

See L<Apache2::ASP::MediaManager> for details.

If you really need to do something special, either subclass L<Apache2::ASP::UploadHandler>
or write your own C<mod_perl> handler and submit to it.

=head1 SECURITY

=head2 Restricting Access

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


=head1 DESCRIPTION

This is a brief overview of L<Apache2::ASP> and how to use it.

=head1 Apache2::ASP OBJECTS

=head2 $Request

An instance of L<Apache2::ASP::Request>.  It provides an object-oriented 
interface to the incoming request, including file uploads.

=head2 $Response

An instance of L<Apache2::ASP::Response>.  It provides an object-oriented
interface to the outgoing server response.

=head2 $Form

A simple hashref of both querystring and form variables, it is a shortcut to 
$Request->Form.

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

}# end open_file_for_appending()


#==============================================================================
sub compose_download_file_path
{
  my ($s, $context) = @_;
  
  # Compose the local filename:
  my $file = $context->request->Form->{file};
  my $filename = $context->config->web->media_manager_upload_root . '/' . $file;
  
  return $filename;
}# end compose_file_path()


#==============================================================================
sub compose_download_file_name
{
  my ($s, $context) = @_;
  
  # Compose the local filename:
  my $file = $context->request->Form->{file};
  
  return $file;
}# end compose_file_name()


#==============================================================================
sub compose_upload_file_name
{
  my ($s, $context, $Upload) = @_;
  
#  my $filename = $Upload;
  my ($filename) = $Upload->{upload}->{upload_filename} =~ m/.*[\\\/]([^\/\\]+)$/;
  if( ! $filename )
  {
    $filename = $Upload->{upload}->{upload_filename};
  }# end if()
  
  return $filename;
}# end compose_upload_file_name()


#==============================================================================
sub compose_upload_file_path
{
  my ($s, $context, $Upload, $filename) = @_;
  
  unless( defined($filename) && length($filename) )
  {
    die "\$filename not provided";
  }# end unless()
  
  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});
  
  # Done with the filehandle:
  $ofh->close;
  
  # Store some information for later:
  $ENV{filename} ||= $target_file;

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

    $s->before_create($context, $Upload);
  }
  elsif( /^edit$/ )
  {
    $s->before_update($context, $Upload);
  }
  else
  {
    die "Unknown mode: '$_'";
  }# 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/MediaManager.pm  view on Meta::CPAN

    $s->after_create($context, $Upload);
  }
  elsif(  $form->{mode} =~ /^edit$/ )
  {
    $s->after_update($context, $Upload);
  }
  else
  {
    die "Unknown mode: '$_'";
  }# end if()
}# end upload_end()


#==============================================================================
sub before_download
{
  my ($s, $context) = @_;
  
}# end before_download()


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

  1;# return true:

Then create a file in your C</htdocs> folder named C<mm-test.asp>:

  <html>
    <body>
      <h1>File Upload Test</h1>
      <form
          method="post"
          enctype="multipart/form-data"
          action="/handlers/MM?mode=create&uploadID=2kj4hkj234h">
        <input type="file" name="filename" >
        <input type="submit" value="Upload File Now">
      </form>
      
      <h2>Existing Files (if any)</h2>
      <p>
  <%
    opendir my $dir, $Config->web->media_manager_upload_root;
    while( my $file = readdir($dir) )
    {
      next unless -f $Config->web->media_manager_upload_root . '/' . $file;
  %>
        <a href="/handlers/MM?file=<%= $file %>"><%= $file %></a><br>
  <%
    }# end while()
  %>
      </o>
    </body>
  </html>

B<REALLY IMPORTANT!>: Notice the C<?mode=create&uploadID=2kj4hkj234h> in the C<action>
attribute of the C<form> tag.  The C<mode> tells the MediaManager that we are B<creating>
a file, and the C<uploadID> will allow us to track the progress of the upload.

B<IMPORTANT>: Check your configuration, where you see:

  <config>
    ...
    <web>
      ...
      <media_manager_upload_root>@ServerRoot@/MEDIA</media_manager_upload_root>
      ...
    </web>
    ...
  </config>

Make B<*sure*> that your webserver has ownership or read/write access to that folder
and all of its contents.

When you access http://yoursite.com/mm-test.asp in your browser and submit the form,
C<Apache2::ASP::MediaManager> will save it under your C<media_manager_upload_root>
folder for you.

=head1 DESCRIPTION

Handling file uploads can be a real pain.  Restricting file uploads and downloads
to a select group of users is also problematic.

B<And Then...>

And then there was C<Apache2::ASP::MediaManager>.  Now you can have fully-functional
file uploads in seconds.  

=head1 UPLOAD PROGRESS INDICATORS

C<Apache2::ASP::MediaManager> makes it easy to provide upload progress indicators.

Remember that C<uploadID> parameter in the C<action> attribute of your form? While 
the upload is taking place, the C<$Session> object is getting updated with the
status of the upload.  If you were to make another handler - C</handlers/UploadProgress.pm> -
and insert the following code:

  package UploadProgress;

  use strict;
  use base 'Apache2::ASP::FormHandler';
  use vars __PACKAGE__->VARS;

  sub run {
    my ($s, $context) = @_;
    
    my $uploadID = $Form->{uploadID};
    
    $Session->{"upload$uploadID" . "percent_complete"} ||= 0;
    
    $Response->Expires( -30 );
    $Response->Write( $Session->{"upload$uploadID" . "percent_complete"} );
  }# end run()

  1;# return true:

And add call out to it via AJAX - you can get real-time upload progress information
about the current upload.

Example:

  window.setInterval(function() {
    httpOb.open("GET", "/handlers/UploadProgress?uploadID=2kj4hkj234h", true);
    httpOb.onreadystatechange = function() {
      if( httpOb.readyState == 4 ) {
        document.getElementById("percent_complete").innerHTML = httpOb.responseText + '%';
      }// end if()
    };
  }, 1000);

You should also add an element with an id of "percent_complete" to he form:

  <div id="percent_complete">0%</div>

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

Called before allowing a file to be downloaded from the server.

B<NOTE>: This method must return true, or the file will not be downloaded.

=head2 after_download( $self, $context )

Called after allowing a file to be downloaded from the server.

=head2 before_create( $self, $context, $Upload )

Called before allowing a new file to be uploaded to the server.

B<NOTE>: This method must return true, or the file will not be created.

=head2 after_create( $self, $context, $Upload )

Called after allowing a new file to be uploaded to the server.

=head2 before_update( $self, $context, $Upload )

Called before allowing a new file to be uploaded to replace an existing file.

B<NOTE>: This method must return true, or the file will not be updated.

=head2 after_update( $self, $context, $Upload )

Called after a new file has been uploaded to replace an existing file.

=head2 before_delete( $self, $context, $filename )

Called before deleting a file.

B<NOTE>: This method must return true, or the file will not be deleted.

=head2 after_delete( $self, $context, $filename )

Called after deleting a file.

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

=pod

=head1 NAME

Apache2::ASP::ModPerl - mod_perl2 PerlResponseHandler for Apache2::ASP

=head1 SYNOPSIS

In your httpd.conf
  
  # Needed for file uploads to work properly:
  LoadModule apreq_module    modules/mod_apreq2.so

  # Load up some important modules:
  PerlModule DBI
  PerlModule DBD::mysql
  PerlModule Apache2::ASP::ModPerl

  # Admin website:
  <VirtualHost *:80>

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

use strict;
use warnings;
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
    );
  }
  else
  {
    $s->req( Apache2::Request->new( $r ) );
  }# end if()
  

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

__END__

=pod

=head1 NAME

Apache2::ASP::ModPerl2CGI - A wrapper for CGI utility functions.

=head1 DESCRIPTION

Uses L<CGI::Apache2::Wrapper> behind the scenes.  Handles file uploads and parsing form data.

Generally only used within C<Apache2::ASP> classes, so casual users don't have to worry about
this module too much.

=head1 METHODS

=head2 new( $r [, \&upload_hook] )

Returns a new C<Apache2::ASP::ModPerl2CGI> object - with or without an upload hook specified.

=head1 BUGS

It's possible that some bugs have found their way into this release.

Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Apache2-ASP> to submit bug reports.

=head1 HOMEPAGE

Please visit the Apache2::ASP homepage at L<http://www.devstack.com/> to see examples

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

#==============================================================================
sub FileUpload
{
  my ($s, $field) = @_;
  
  confess "Request.FileUpload called without arguments"
    unless defined($field);
  
  my $cgi = $s->context->cgi;
  
  my $ifh = $cgi->upload($field);
  my %info = ();
  my $upInfo = { };
  
  if( $cgi->isa('Apache2::ASP::SimpleCGI') )
  {
    no warnings 'uninitialized';
    my $up = $cgi->upload_info( $field, 'mime' )
      or return;
    %info = (
      ContentType           => $up,
      FileHandle            => $ifh,
      FileName           => $s->Form->{ $field } . "",
      'ContentDisposition' => 'attachment',
# Mime-Header is deprecated as of v2.46
#      'Mime-Header'         => $cgi->upload_info( $field, 'mime' ),
    );
  }
  else
  {
    $upInfo = $cgi->uploadInfo( $ifh )
      or return;
    no warnings 'uninitialized';
    %info = (
      ContentType           => $upInfo->{'Content-Type'},
      FileHandle            => $ifh,
      FileName              => $s->Form->{ $field } . "",
      'ContentDisposition' => $upInfo->{'Content-Disposition'},
# Mime-Header is deprecated as of v2.46
#      'Mime-Header'         => $upInfo->{type},
    );

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

use warnings 'all';
use HTTP::Body;


#==============================================================================
sub new
{
  my ($s, %args) = @_;
  
  my %params = ();
  my %upload_data = ();
  no warnings 'uninitialized';
  if( length($args{querystring}) )
  {
    foreach my $part ( split /&/, $args{querystring} )
    {
      my ($k,$v) = map { $s->unescape($_) } split /\=/, $part;
      
      if( exists($params{$k}) )
      {
        if( ref($params{$k}) )

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

    # Parse form values:
    my $form_info = $body->param || { };
    if( keys(%$form_info) )
    {
      foreach( keys(%$form_info) )
      {
        $params{$_} = $form_info->{$_};
      }# end foreach()
    }# end if()
    
    # Parse uploaded data:
    if( my $uploads = $body->upload )
    {
      foreach my $name ( keys(%$uploads) )
      {
        open my $ifh, '<', $uploads->{$name}->{tempname}
          or die "Cannot open '$uploads->{$name}->{tempname}' for reading: $!";
        $upload_data{$name} = {
          %{$uploads->{$name}},
          'filehandle' => $ifh,
        };
      }# end foreach()
    }# end if()
  }# end if()
  
  return bless {
    params => \%params,
    uploads => \%upload_data,
    %args
  }, $s;
}# end new()


#==============================================================================
sub upload
{
  my ($s, $key) = @_;
  
  no warnings 'uninitialized';
  return exists( $s->{uploads}->{$key} ) ? $s->{uploads}->{$key}->{filehandle} : undef;
}# end upload()


#==============================================================================
sub upload_info
{
  my ($s, $key, $info) = @_;
  
  no warnings 'uninitialized';
  if( exists( $s->{uploads}->{$key} ) )
  {
    my $upload = $s->{uploads}->{$key};
    if( exists( $upload->{$info} ) )
    {
      return $upload->{$info};
    }
    else
    {
      return undef;
    }# end if()
  }
  else
  {
    return undef;
  }# end if()
}# end upload_info()


#==============================================================================
sub param
{
  my ($s, $key) = @_;
  
  if( defined($key) )
  {
    if( ref($s->{params}->{$key}) )

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

  defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
  return $todecode;
}# end unescape()


#==============================================================================
sub DESTROY
{
  my $s = shift;
  
  map { close($s->{uploads}->{$_}->{filehandle}) }
    keys(%{$s->{uploads}});
}# end DESTROY()


1;# return true:

=pod

=head1 NAME

Apache2::ASP::SimpleCGI - Basic CGI functionality

=head1 SYNOPSIS

  use Apache2::ASP::SimpleCGI;
  
  my $cgi = Apache2::ASP::SimpleCGI->new(
    content_type    => 'multipart/form-data',
    content_length  => 1200,
    querystring     => 'mode=create&uploadID=234234',
    body            => ...
  );
  
  my $val = $cgi->param('mode');
  foreach my $key ( $cgi->param )
  {
    print $key . ' --> ' . $cgi->param( $key ) . "\n";
  }# end foreach()
  
  my $escaped = $cgi->escape( 'Hello world' );
  my $unescaped = $cgi->unescape( 'Hello+world' );
  
  my $upload = $cgi->upload('filename');
  
  my $filehandle = $cgi->upload_info('filename', 'filehandle' );

=head1 DESCRIPTION

This package provides basic CGI functionality and is also used for testing and
in the API enironment.

C<Apache2::ASP::SimpleCGI> uses L<HTTP::Body> under the hood.

=head1 PUBLIC METHODS

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

If C<$key> is not given, returns a list of all parameter names.

=head2 escape( $str )

Returns a URL-encoded version of C<$str>.

=head2 unescape( $str )

Returns a URL-decoded version of C<$str>.

=head2 upload( $field_name )

Returns all of the information we have about a file upload named C<$field_name>.

=head2 upload_info( $field_name, $item_name )

Returns just that part of C<$field_name>'s upload info.

=head1 BUGS

It's possible that some bugs have found their way into this release.

Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Apache2-ASP> to submit bug reports.

=head1 HOMEPAGE

Please visit the Apache2::ASP homepage at L<http://www.devstack.com/> to see examples

lib/Apache2/ASP/Test/UserAgent.pm  view on Meta::CPAN

  $r->uri( $uri );
  $r->args( $cgi->{querystring} );
  $r->{headers_in}->{Cookie} = $ENV{HTTP_COOKIE};
  
  $s->context->setup_request( $r, $cgi );
  return $s->_setup_response( $s->context->execute() );
}# end post()


#==============================================================================
sub upload
{
  my ($s, $uri, $args) = @_;
  
  chdir( $s->{cwd} );
  no strict 'refs';
  undef(${"$ContextClass\::instance"});
  {
    no warnings 'uninitialized';
    %ENV = ( DOCUMENT_ROOT => $ENV{DOCUMENT_ROOT} );
  }

lib/Apache2/ASP/Test/UserAgent.pm  view on Meta::CPAN

  $s->context->setup_request( $r, $cgi );
  
  require Apache2::ASP::UploadHook;
  my $handler_resolver = $s->context->config->web->handler_resolver;
  $s->context->config->load_class( $handler_resolver );
  my $hook_obj = Apache2::ASP::UploadHook->new(
    handler_class => $handler_resolver->new()->resolve_request_handler( $uri ),
  );
  my $hook_ref = sub { $hook_obj->hook( @_ ) };
  
  # Now call the upload hook...
  require Apache2::ASP::Test::UploadObject;
  foreach my $uploaded_file ( keys( %{ $cgi->{uploads} } ) )
  {
    my $tmpfile = $cgi->upload_info($uploaded_file, 'tempname' );
    my $filename = $cgi->upload_info( $uploaded_file, 'filename' );
    my $ifh = IO::File->new;
    $ifh->open($tmpfile, '<')
      or die "Cannot open temp file '$tmpfile' for reading: $!";
    binmode($ifh);
    while( my $line = <$ifh> )
    {
      $hook_ref->(
        Apache2::ASP::Test::UploadObject->new(
          filename        => $filename,
          upload_filename => $filename
        ),
        $line
      );
    }# end while()
    close($ifh);
    
    # One more *without* any data (this will signify and EOF condition):
    $hook_ref->(
      Apache2::ASP::Test::UploadObject->new(
        filename        =>  $filename,
        upload_filename => $filename
      ),
      undef
    );
  }# end foreach()
  
  # NOW we can execute...
  return $s->_setup_response( $s->context->execute() );
}# end upload()


#==============================================================================
sub submit_form
{
  my ($s, $form) = @_;
  
  chdir( $s->{cwd} );
  no strict 'refs';
  undef(${"$ContextClass\::instance"});

lib/Apache2/ASP/Test/UserAgent.pm  view on Meta::CPAN

  
  # Do the same thing, but with HTML::Form:
  use HTML::Form;
  my $form = HTML::Form->parse( $asp->ua->get("/contact.asp")->content, '/' );
  $form->find_input('name')->value('Fred');
  $form->find_input('email')->value('fred@flintstone.org');
  $form->find_input('message')->value('This is a test email message');
  my $res = $asp->ua->submit_form( $form );
  
  # Upload:
  my $res = $asp->ua->upload("/handlers/MM?mode=create&uploadID=12334534", [
    filename => ['/path/to/file.txt'],
  ]);

=head1 PUBLIC PROPERTIES

=head2 context

Returns the current L<Apache2::ASP::HTTPContext> object.

=head1 PUBLIC METHODS

=head2 get( $url )

Makes a "GET" request to C<$url>

=head2 post( $url [,\@args] )

Makes a "POST" reqest to C<$url>, using C<@args> as the body.

=head2 upload( $url, \@args )

Makes a "POST" request with a C<multipart/form-data> type, using C<@args> as the body.

=head2 submit_form( HTML::Form $form )

Submits the form.

B<NOTE:> - this will not work for "upload" forms (yet).

=head1 BUGS

It's possible that some bugs have found their way into this release.

Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Apache2-ASP> to submit bug reports.

=head1 HOMEPAGE

Please visit the Apache2::ASP homepage at L<http://www.devstack.com/> to see examples

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


package Apache2::ASP::UploadHandler;

use strict;
use base 'Apache2::ASP::HTTPHandler';
our $LastUpdate;
our $LastPercent;


#==============================================================================
sub upload_start
{
  my ($s, $context, $Upload) = @_;
  
  return;
  return unless $Upload;
  # Store the upload information in the Session for external retrieval:
  $LastUpdate = time();
  $LastPercent = $Upload->{percent_complete} || 0;
  my $uploadID = $s->_args('uploadID');
  $context->session->{"upload$uploadID$_"} = $Upload->{$_}
    foreach grep { $_ !~ m/data/ } keys(%$Upload);
  $context->session->save;
}# end upload_start()


#==============================================================================
# The logic *we* need is already taken care of by the UploadHook's RegisterCleanup,
# so we can just leave this stub for subclassing:
sub upload_end
{
  my ($s, $context, $Upload) = @_;
  
  1;
}# end upload_end()


#==============================================================================
sub upload_hook
{
  my ($s, $context, $Upload) = @_;
  
  return;
  # Since this method may be called several times per second, we only
  # want to save the Session state once per second:
  my $Diff = time() - $LastUpdate;
  my $PercentDiff = $Upload->{percent_complete} - $LastPercent;
  
  if( $Diff >= 1 || $PercentDiff >= 5 )
  {
    my $uploadID = $s->_args('uploadID') || '';
    # Store everything in the session except for the data 
    # (since that could be too large to serialize quickly):
    $context->session->{"upload$uploadID$_"} = $Upload->{$_}
      foreach grep { $_ !~ m/data/ } keys(%$Upload);
    $context->session->save;
    $LastUpdate = time();
    $LastPercent = $Upload->{percent_complete};
  }# end if()
}# end upload_hook()


#==============================================================================
sub _args
{
  my ($s, $key) = @_;
  
  my %args = map {
    split /\=/, $_
  } split /&/, $ENV{QUERY_STRING};

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

}# end _args()

1;# return true:

__END__

=pod

=head1 NAME

Apache2::ASP::UploadHandler - Base class for Handlers that process file uploads

=head1 SYNOPSIS

Don't use this clas. Subclass L<Apache2::ASP::MediaManager> instead.

=head1 DESCRIPTION

This package provides the Apache2::ASP environment with the ability to process file uploads
B<while they are happening>.  Trigger points are exposed that are called at specific times 
during a file upload.

=head1 OVERRIDABLE METHODS

=head2 upload_start( $self, $context, $Upload )

The C<$Upload> argument is an L<Apache2::ASP::UploadHookArgs> object.

Called B<just> before C<upload_hook()> is called for the first time.  If you need to do
any kind of setup or double-checking, this is the time to do it.

=head2 upload_end( $self, $context, $Upload )

The C<$Upload> argument is an L<Apache2::ASP::UploadHookArgs> object.

Called B<just> after C<upload_hook()> is called for the B<last> time.  If you need to do
any kind of cleanup or redirect the user, this is the time to do it.

=head2 upload_hook( $self, $context, $Upload )

The C<$Upload> argument is an L<Apache2::ASP::UploadHookArgs> object.

Called each time Apache reads in a chunk of bytes from the client during the upload.

=head1 BUGS

It's possible that some bugs have found their way into this release.

Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Apache2-ASP> to submit bug reports.

=head1 HOMEPAGE

Please visit the Apache2::ASP homepage at L<http://www.devstack.com/> to see examples

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

#==============================================================================
sub context
{
  Apache2::ASP::HTTPContext->current;
}# end context()


#==============================================================================
sub hook
{
  my ($s, $upload, $data) = @_;
  
  my $length_received = defined($data) ? length($data) : 0;
  my $context = $s->context;
  my $CONTENT_LENGTH = $ENV{CONTENT_LENGTH} || $context->r->pnotes('content_length');
  my $total_loaded = ($context->r->pnotes('total_loaded') || 0) + $length_received;
  $context->r->pnotes( total_loaded => $total_loaded);
  my $percent_complete = sprintf("%.2f", $total_loaded / $CONTENT_LENGTH * 100 );
  
  # Mark our start time, so we can make our calculations:
  my $start_time = $context->r->pnotes('upload_start_time');
  if( ! $start_time )
  {
    $start_time = gettimeofday();
    $context->r->pnotes('upload_start_time' => $start_time);
  }# end if()
  
  # Calculate elapsed, total expected and remaining time, etc:
  my $elapsed_time        = gettimeofday() - $start_time;
  my $bytes_per_second    = $context->r->pnotes('total_loaded') / $elapsed_time;
  $bytes_per_second       ||= 1;
  my $total_expected_time = int( ($CONTENT_LENGTH - $length_received) / $bytes_per_second );
  my $time_remaining      = int( (100 - $percent_complete) * $total_expected_time / 100 );
  $time_remaining         = 0 if $time_remaining < 0;
  
  # Use an object, not just a hashref:
  my $Upload = Apache2::ASP::UploadHookArgs->new(
    upload              => $upload,
    percent_complete    => $percent_complete,
    elapsed_time        => $elapsed_time,
    total_expected_time => $total_expected_time,
    time_remaining      => $time_remaining,
    length_received     => $length_received,
    data                => defined($data) ? $data : undef,
  );
  
  # Init the upload:
  my $did_init = $ENV{did_init};
  if( ! $did_init )
  {
    $ENV{did_init} = 1;

    $s->{handler_class}->upload_start( $context, $Upload )
      or return;
    
    # End the upload if we are done:
    my $uploadID = $s->_args('uploadID');
    $context->r->push_handlers(PerlCleanupHandler => sub {
      delete($context->session->{"upload$uploadID$_"})
        foreach grep { $_ !~ m/data/i } keys(%$Upload);
      $context->session->save;
    });
  }# end if()
  
  if( $length_received <= 0 )
  {
    $s->{handler_class}->init_asp_objects( $context );
    $s->{handler_class}->upload_end( $context, $Upload );
  }
  else
  {
    # Call the hook:
    $s->{handler_class}->upload_hook( $context, $Upload );
  }# end if()
  
}# end hook()


#==============================================================================
sub _args
{
  my ($s, $key) = @_;
  

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

    split /\=/, $_
  } split /&/, $ENV{QUERY_STRING};
  
  return $args{$key};
}# end _args()

1;# return true:

=head1 NAME

Apache2::ASP::UploadHook - An upload hook for Apache2::Request

=head1 SYNOPSIS

Internal use only.

=head1 DESCRIPTION

This class handles interaction with L<Apache2::Request> during file uploads.

=head1 BUGS

It's possible that some bugs have found their way into this release.

Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Apache2-ASP> to submit bug reports.

=head1 HOMEPAGE

Please visit the Apache2::ASP homepage at L<http://www.devstack.com/> to see examples

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


use strict;
use warnings 'all';

#==============================================================================
sub new
{
  my ($s, %args) = @_;

  exists($args{$_}) or die "Required parameter '$_' was not provided" foreach qw(
    upload
    percent_complete
    elapsed_time
    total_expected_time
    time_remaining
    length_received
    data
  );
  $args{content_length} = $ENV{CONTENT_LENGTH};
  $args{new_file}       = undef;
  $args{filename_only}  = undef;

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


=pod

=head1 NAME

Apache2::ASP::UploadHookArgs - Argument for UploadHook instances

=head1 SYNOPSIS

  my $Upload = Apache2::ASP::UploadHookArgs->new(
    upload              => $upload, # An APR::Request::Param::Table object
    percent_complete    => $percent_complete,
    elapsed_time        => $elapsed_time,        # in seconds
    total_expected_time => $total_expected_time, # in seconds
    time_remaining      => $time_remaining,      # in seconds
    length_received     => $length_received,     # in bytes
    data                => defined($data) ? $data : undef,  # bytes received in this "chunk"
  );

=head1 DESCRIPTION

Rather than just passing a hashref as an argument, this class serves to enforce some structure
to the whole Apache2::ASP upload model.

=head1 METHODS

=head2 new( %args )

C<%args> should be as shown in the synopsis above.

=head2 upload( )

Returns an L<APR::Request::Param::Table> object.

=head2 percent_complete( )

Returns a float representing what percent of the upload has been received so far.

=head2 elapsed_time( )

Returns the number of seconds since the upload began.

=head2 total_expected_time( )

Returns the total number of seconds we expect the upload to last.

=head2 time_remaining( )

Returns the number of seconds the upload will continue after this point in time.

=head2 length_received( )

Returns the number of bytes we have received from the upload so far.

=head2 content_length( )

Returns the value of C<$ENV{CONTENT_LENGTH}> at this point, but may be updated later, based
on usage and requirements.

=head2 data( )

Returns the bytes received in this "chunk" of the upload.

=head1 AFTER THE UPLOAD HAS FINISHED

After the upload has finished, you can count on the following methods returning actual values:

=head2 new_file( )

Returns the filename of the new file, as it was in the upload form field.

Example: C<C:\Documents\MyFile.txt>

=head2 filename_only( )

Returns something like C<MyFile.txt>

=head2 link_to_file( )

Returns something like C</media/MyFile.txt>

sbin/asphelper  view on Meta::CPAN

    <error_handler>Apache2::ASP::ErrorHandler</error_handler>
    <mail_errors_to>@{[ $args->{mail_errors_to} ]}</mail_errors_to>
    <mail_errors_from>@{[ $args->{mail_errors_from} ]}</mail_errors_from>
    <smtp_server>@{[ $args->{smtp_server} ]}</smtp_server>
  </errors>

  <web>
    <application_name>@{[ $args->{application_name} ]}</application_name>
    <application_root>\@ServerRoot\@</application_root>
    <handler_root>\@ServerRoot\@/handlers</handler_root>
    <media_manager_upload_root>\@ServerRoot\@/MEDIA</media_manager_upload_root>
    <www_root>\@ServerRoot\@/htdocs</www_root>
    <page_cache_root>\@ServerRoot\@/PAGE_CACHE</page_cache_root>
    <request_filters>
<!--
      <filter>
        <uri_match>/.*</uri_match>
        <class>My::MemberFilter</class>
      </filter>
      <filter>
        <uri_equals>/index.asp</uri_equals>

t/010-coverage/050-mediamanager.t  view on Meta::CPAN


can_ok( $api, 'config' );
ok( $api, 'got an API object' );
isa_ok( $api, 'Apache2::ASP::API' );




# Try out our 'yay' handler:
{
  $api->ua->get('/handlers/upload01?mode=yay&file=sdf.txt');
}


# Make the file to upload:
my $upload_filename = '/tmp/asp-upload-test.txt';


# Upload a file and then download it:
{
  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()
  close($ofh);

  my $uploadID = int(rand() * 1000) . ':' . int(rand() * 1000);
  my $res = $api->ua->upload("/handlers/upload01?mode=create&uploadID=$uploadID", [
    uploaded_file => [ $upload_filename ]
  ]);


  my ($file) = 'asp-upload-test.txt';
  $res = $api->ua->get("/handlers/upload01?file=$file");
  is( length($res->content) => (stat($upload_filename))[7], "Uploaded/Downloaded filesizes match" );
}


# Now update that file:
{
  my $uploadID = int(rand() * 1000) . ':' . int(rand() * 1000);
  my $res = $api->ua->upload("/handlers/upload01?mode=edit&uploadID=$uploadID", [
    uploaded_file => [ $upload_filename ]
  ]);
}


# Try downloading, but fail:
{
  my $res = $api->ua->get('/handlers/upload01?file=sdf.txt&do_fail_before_download=1');
  is(
    length( $res->content ) => 0,
    'Fail before download causes zero length download'
  );
}


# Now update that file with one even larger > 1M:
{
  open my $ofh, '>', $upload_filename
    or die "Cannot open '$upload_filename' for writing: $!";
  for( 1...1025 )
  {
    print $ofh "."x1024, "\n";
  }# end for()
  close($ofh);
  my $uploadID = int(rand() * 1000) . ':' . int(rand() * 1000);
  my $res = $api->ua->upload("/handlers/upload01?mode=edit&uploadID=$uploadID", [
    uploaded_file => [ $upload_filename ]
  ]);
  
  my ($file) = 'asp-upload-test.txt';
  $res = $api->ua->get("/handlers/upload01?file=$file");
  is( length($res->content) => (stat($upload_filename))[7], "Uploaded/Downloaded filesizes match" );
}



# Try out a mode that doesn't exist:
{
  $api->ua->get('/handlers/upload01?mode=no-existo&file=sdf.txt');
}


# Now delete the file:
{
  my $res1 = $api->ua->get('/handlers/upload01?file=asp-upload-test.txt&mode=delete&do_fail_before_delete=1');
  
  my $res = $api->ua->get('/handlers/upload01?file=asp-upload-test.txt&mode=delete');
  is( $res->is_success => 1 );
}


# Now try downloading that file again...should fail:
{
  my $res = $api->ua->get('/handlers/upload01?file=asp-upload-test.txt');
  is( $res->status_line => '404 Not Found' );
}


# Upload a file and then download it:
{
  my $upload_filename = '/tmp/test-file.pdf';
  open my $ofh, '>', $upload_filename
    or die "Cannot open '$upload_filename' for writing: $!";
  for( 1...1000 )
  {
    print $ofh "$_: This is a line of text\n";
  }# end for()
  close($ofh);

  my $uploadID = int(rand() * 1000) . ':' . int(rand() * 1000);
  my $res = $api->ua->upload("/handlers/upload01?mode=create&uploadID=$uploadID", [
    uploaded_file => [ $upload_filename ]
  ]);


  my ($file) = 'test-file.pdf';
  $res = $api->ua->get("/handlers/upload01?file=$file");
  is( length($res->content) => (stat($upload_filename))[7], "Uploaded/Downloaded filesizes match" );
}



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()
close($ofh);

my $uploadID = int(rand() * 1000) . ':' . int(rand() * 1000);
my $res = $s->ua->upload("/handlers/upload01?mode=create&uploadID=$uploadID", [
  uploaded_file => [ $upload_filename ]
]);


my ($file) = 'asp-upload-test.txt';
$res = $s->ua->get("/handlers/upload01?file=$file");
is( length($res->content) => -s $upload_filename, "Uploaded/Downloaded filesizes match" );



t/conf/apache2-asp-config.xml  view on Meta::CPAN

    <error_handler>My::ErrorHandler</error_handler>
    <mail_errors_to>jdrago_999@yahoo.com</mail_errors_to>
    <mail_errors_from>root@localhost</mail_errors_from>
    <smtp_server>localhost</smtp_server>
  </errors>

  <web>
    <application_name>DefaultApp</application_name>
    <application_root>@ServerRoot@</application_root>
    <handler_root>@ServerRoot@/handlers</handler_root>
    <media_manager_upload_root>@ServerRoot@/MEDIA</media_manager_upload_root>
    <www_root>@ServerRoot@/htdocs</www_root>
    <page_cache_root>@ServerRoot@/PAGE_CACHE</page_cache_root>
    <handler_resolver>Apache2::ASP::HTTPContext::HandlerResolver</handler_resolver>
    <handler_runner>Apache2::ASP::HTTPContext::HandlerRunner</handler_runner>
    <filter_resolver>Apache2::ASP::HTTPContext::FilterResolver</filter_resolver>
    <request_filters>
      <filter>
        <uri_match>/.*</uri_match>
        <class>My::MemberFilter</class>
      </filter>

t/conf/configuration.dtd  view on Meta::CPAN

<!ELEMENT lib ( #PCDATA ) >

<!ELEMENT libs ( lib* ) >

<!ELEMENT load_modules ( module* ) >

<!ELEMENT main ( dsn, username, password ) >

<!ELEMENT manager ( #PCDATA ) >

<!ELEMENT media_manager_upload_root ( #PCDATA ) >

<!ELEMENT module ( #PCDATA ) >

<!ELEMENT name ( #PCDATA ) >

<!ELEMENT page_cache_root ( #PCDATA ) >

<!ELEMENT password ( #PCDATA ) >

<!ELEMENT post_processors ( class* ) >

t/conf/configuration.dtd  view on Meta::CPAN

<!ELEMENT uri_equals ( #PCDATA ) >

<!ELEMENT uri_match ( #PCDATA ) >

<!ELEMENT username ( #PCDATA ) >

<!ELEMENT value ( #PCDATA ) >

<!ELEMENT var ( name, value ) >

<!ELEMENT web ( application_name, application_root, handler_root, media_manager_upload_root, www_root, page_cache_root, request_filters ) >

<!ELEMENT www_root ( #PCDATA ) >

<!ELEMENT smtp_server ( #PCDATA ) >
<!ELEMENT mail_errors_to ( #PCDATA ) >
<!ELEMENT mail_errors_from ( #PCDATA ) >
<!ELEMENT error_handler ( #PCDATA ) >

<!ELEMENT errors ( error_handler, mail_errors_to, mail_errors_from, smtp_server ) >

t/handlers/upload01.pm  view on Meta::CPAN


package upload01;

use strict;
use warnings 'all';
use base 'Apache2::ASP::MediaManager';
use vars __PACKAGE__->VARS;


sub before_run
{
  my ($s, $context) = @_;

t/handlers/upload01.pm  view on Meta::CPAN


  return 0 if $Form->{do_fail_before_download};
  return 1;
}


sub before_create
{
  my ($s, $context, $Upload) = @_;
  
#  warn "UPLOADING: '" . $Upload->upload->filename . "'";
}# end before_create()


sub after_create
{
  my ($s, $context, $Upload) = @_;

#  warn "DONE!!!!: '" . $Upload->upload->filename . "'";
}# end after_create()

1;# return true:

t/htdocs/upload.asp  view on Meta::CPAN

HELLO WORLD!: UPLOAD!
<%
  use Data::Dumper;
  warn Dumper({ $Request->FileUpload('uploaded_file') });
%>



( run in 2.115 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )