Apache2-UploadProgress

 view release on metacpan or  search on metacpan

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

use APR::Const           -compile => qw( SUCCESS );
use APR::Brigade         qw[];
use APR::Bucket          qw[];
use APR::Table           qw[];
use Cache::FastMmap      qw[];
use File::Spec           qw[];
use HTTP::Headers::Util  qw[split_header_words];
use Time::HiRes          qw[sleep];

our $VERSION = 0.2;

our $CACHE = Cache::FastMmap->new(
    share_file => $ENV{UPLOADPROGRESS_SHARE_FILE} || File::Spec->catfile( File::Spec->tmpdir, 'Apache2-UploadProgress' ),
    init_file  => 1,
    raw_values => 1,
    page_size  => $ENV{UPLOADPROGRESS_PAGE_SIZE} || '64k',
    num_pages  => $ENV{UPLOADPROGRESS_NUM_PAGES} || '89',
) or die qq/Failed to create a new instance of Cache::FastMmap. Reason: '$!'/;

our $DIRECTIVES = [
    {
        name         => 'UploadProgressBaseURI',
        req_override => Apache2::Const::RSRC_CONF,
        args_how     => Apache2::Const::TAKE1,
        errmsg       => 'Absolute or relative URI to extras without trailing forward slash',
    }
];

our ( $TEMPLATES, $MIMES, $HAS_BASEURI );

if ( $ENV{MOD_PERL} ) {

    Apache2::Module::add( __PACKAGE__, $DIRECTIVES );

    if (    Apache2::ServerUtil::restart_count() > 1
         && Apache2::Module::loaded('mod_alias.c')
         && Apache2::Module::loaded('mod_mime.c') ) {

        my $config = [
            sprintf( 'Alias /UploadProgress %s/extra', substr( __FILE__, 0, -3 ) ),
            '<Location /UploadProgress>',
            'SetHandler default-handler',
            Apache2::Module::loaded('mod_expires.c')
              ? ( 'ExpiresActive On', 'ExpiresDefault "access plus 1 day"')
              : (),
            '</Location>',
            '<Location /UpdateProgress>',
            'SetHandler modperl',
            'PerlResponseHandler Apache2::UploadProgress->progress',
            '</Location>'
        ];

        Apache2::ServerUtil->server->add_config($config);

        $HAS_BASEURI = 1;
    }
}

$TEMPLATES->{html} = <<'EOF';
<!DOCTYPE html
    PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
<head>
  <title>UploadProgress</title>
  <link rel="stylesheet" type="text/css" href="/UploadProgress/progress.css" />
  <script src="/UploadProgress/progress.js" type="text/javascript"></script>
  <script src="/UploadProgress/progress.jmpl.js" type="text/javascript"></script>
</head>
<body onLoad="updateHTMLProgressBar({ size : '%d', received : '%d' })">
  <h3>Upload Progress</h3>
  <div id="progress"></div>
</body>
</html>
EOF

$TEMPLATES->{json} = <<'EOF';
{"size":%d,"received":%d}
EOF

$TEMPLATES->{text} = <<'EOF';
size: %d
received: %d
EOF

$TEMPLATES->{yaml} = <<'EOF';
---
size: %d
received: %d
EOF

$TEMPLATES->{xml} = <<'EOF';
<?xml version="1.0" encoding="UTF-8"?>
%s<upload%s>
    <size>%d</size>
    <received>%d</received>
</upload>
EOF

$MIMES = {
    'application/x-json'    => sub { sprintf( $TEMPLATES->{json}, @_ ) },
    'application/x-yaml'    => sub { sprintf( $TEMPLATES->{yaml}, @_ ) },
    'application/xhtml+xml' => sub { sprintf( $TEMPLATES->{html}, @_ ) },
    'application/xml'       => \&xml_template,
    'text/html'             => sub { sprintf( $TEMPLATES->{html}, @_ ) },
    'text/plain'            => sub { sprintf( $TEMPLATES->{text}, @_ ) },
    'text/x-json'           => sub { sprintf( $TEMPLATES->{json}, @_ ) },
    'text/x-yaml'           => sub { sprintf( $TEMPLATES->{yaml}, @_ ) },
    'text/xml'              => \&xml_template,
};

sub xml_template {
    my ($size, $received, $r) = @_;
    my $xsl = '';
    my $xsd = '';
    if ( my $uri = Apache2::UploadProgress->base_uri($r) ) {
        $xsl = "<?xml-stylesheet type=\"text/xsl\" href=\"${uri}/progress.xsl\"?>\n";
        $xsd = ' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:noNamespaceSchemaLocation="${uri}/progress.xsd"';
    }
    return sprintf( $TEMPLATES->{xml}, $xsl, $xsd, $size, $received);
}



( run in 0.858 second using v1.01-cache-2.11-cpan-39bf76dae61 )