view release on metacpan or  search on metacpan

lib/Apache2/UploadProgress.pm  view on Meta::CPAN

    $class->progress_id($r)
      or return Apache2::Const::DECLINED;

    $r->add_input_filter( $class . '->track_progress' );

    return Apache2::Const::OK;
}

sub progress : method {
    my ( $class, $r ) = @_;

    my $progress_id = $class->progress_id($r)
      or return Apache2::Const::NOT_FOUND;
      
    my $progress = undef;
    my $tries    = 16; # wait a max of 4 seconds for the upload to start
    
    while ( $tries && !$progress ) {

        $progress = $class->fetch_progress($progress_id)
          or sleep(0.250);
        
        $tries--;
    }
    
    unless ( $progress ) {
        return Apache2::Const::NOT_FOUND;
    }

    my $content_type = 'text/xml';

    if ( my $accept_header = $r->headers_in->get('Accept') ) {

        my %accept  = ();
        my $counter = 0;

        foreach my $pair ( split_header_words($accept_header) ) {

            my ( $type, $qvalue ) = @{ $pair }[0,3];

            unless ( defined $qvalue ) {
                $qvalue = 1 - ( ++$counter / 1000 );
            }

            $accept{ $type } = sprintf( '%.3f', $qvalue );
        }

        foreach my $type ( sort { $accept{$b} <=> $accept{$a} } keys %accept ) {

            if ( exists $MIMES->{$type} ) {
                $content_type = $type;
                last;
            }
        }
    }

    $r->headers_out->set( 'Vary'          => 'Accept' );
    $r->headers_out->set( 'Pragma'        => 'no-cache' );
    $r->headers_out->set( 'Expires'       => 'Thu, 01 Jan 1970 00:00:00 GMT' );
    $r->headers_out->set( 'Cache-Control' => 'no-store, no-cache, must-revalidate, post-check=0, pre-check=0' );

    my $callback = $MIMES->{$content_type};
    my $content  = $callback->( @$progress, $r );

    $r->content_type($content_type);
    $r->set_content_length( length $content );
    $r->write($content);

    return Apache2::Const::OK;
}

1;

__END__

=head1 NAME

Apache2::UploadProgress - Track the progress and give realtime feedback of file uploads

=head1 SYNOPSIS

In Apache:

    PerlLoadModule             Apache2::UploadProgress
    PerlPostReadRequestHandler Apache2::UploadProgress

In your HTML form:

 <script src="/UploadProgress/progress.js"></script>
 <link type="text/css" href="/UploadProgress/progress.css"/>
 <form action="/cgi-bin/script.cgi"
       method="post"
       enctype="multipart/form-data"
       onsubmit="return startEmbeddedProgressBar(this)">
 <input type="file" name="file"/>
 <input type="submit" name=".submit"/>
 </form>
 <div id="progress"></div>


=head1 DESCRIPTION

This module allows you to track the progress of a file upload in order
to provide a user with realtime updates on the progress of their file
upload.

The information that is provided by this module is very basic.  It just
includes the total size of the upload, and the current number of bytes that
have been received.  However, this information is sufficient to display lots of
information about the upload to the user.  At it's simplest, you can trigger a
popup window that will automatically refresh until the upload completes.
However, popups can be a problem sometimes, so it is also possible to embed a
progress monitor directly into the page using some JavaScript and AJAX calls.
Examples using both techniques are discussed below in the EXAMPLES section.


=head1 EXAMPLES

=head2 Simple Popup Upload Monitor