# $Id: UploadHook.pm,v 1.1 2006/07/31 23:07:40 altblue Exp $
package Apache::UploadHook;
use strict;
use warnings;
our $VERSION = sprintf '0.%d.%d', '\$Revision: 1.1 $' =~ /(\d+)\.(\d+)/xm;
use English qw( -no_match_vars );
use Cache::FastMmap ();
use File::Spec      ();
use POSIX           ();
use Data::Dumper;

our $CACHE;

sub init {
    my ( $class, %opt ) = @_;
    $opt{share_file}
        ||= File::Spec->catfile( File::Spec->tmpdir, 'apache-uploadhook' );
    if ( -f $opt{share_file} ) {
        unlink $opt{share_file}
            or die "Cannot remove $opt{share_file}: $OS_ERROR";
    }
    $CACHE = Cache::FastMmap->new(
        init_file   => 1,
        raw_values  => 1,
        expire_time => '1h',
        page_size   => '64k',
        num_pages   => '89',
        %opt,
        )
        or die
        "Failed to create a new instance of Cache::FastMmap: $OS_ERROR";
    return $CACHE;
}

sub new {
    my ( $class, %opt ) = @_;
    my $self = bless \%opt, $class;
    $self->{cookie_name} ||= 'SESSIONID';
    $self->{upload_hook} ||= \&_upload_hook;
    return $self;
}

sub cookie_name {
    my $self = shift;
    if (@_) {
        $self->{cookie_name} = shift;
    }
    return $self->{cookie_name};
}

sub upload_hook {
    my $self = shift;
    if (@_) {
        $self->{upload_hook} = shift;
    }
    return $self->{upload_hook};
}

sub _upload_hook {
    my ( $upload, $buf, $len, $self ) = @_;
    my $pid      = $self->upload_id( $upload->name );
    my $progress = $self->fetch_progress($pid);

    # There is NO WAY to get the _exact_ size without parsing the POST :(
    $progress->[0] ||= $ENV{CONTENT_LENGTH} || $upload->size || $len;
    $progress->[1] += $len;
    $progress->[2] =
        $progress->[0]
        ? POSIX::ceil( 100 * $progress->[1] / $progress->[0] )
        : 0;

    $self->store_progress( $pid, $progress );
    return;
}

# progress should contain: [ size, read_bytes, int_percent ]
sub store_progress {
    my ( $class, $pid, $progress ) = @_;
    return $CACHE->set( $pid => join "\t", @{$progress} );
}

sub fetch_progress {
    my ( $class, $pid ) = @_;
    my $progress = $CACHE->get($pid);
    return $progress ? [ split /\s+/xm, $progress ] : [ 0, 0, 0 ];
}

sub upload_id {
    my ( $self, $name, $uuid ) = @_;
    $name ||= 'file';
    if ( !$uuid && $ENV{QUERY_STRING}
        && $ENV{QUERY_STRING} =~ /uploadID=([a-zA-Z0-9]+)/xm )
    {
        $uuid = $1;
    }
    return join q{ }, $uuid, $name, $self->_get_session_id;
}

sub _get_session_id {
    my $self    = shift;
    my $raw     = $ENV{HTTP_COOKIE} || return q{};
    my %cookies = ();                                # lazy cookie parser
    foreach my $cookie ( split m{;\ *}xm, $raw ) {
        $cookie =~ s/ ^\s+ //xms;
        $cookie =~ s/ \s+$ //xms;
        if ( $cookie =~ /^ ([^=]+) = (.*) $/xm ) {
            $cookies{$1} = $2;
        }
        else {
            $cookies{$cookie} = q{};
        }
    }
    return $cookies{ $self->cookie_name };
}

1;