view release on metacpan or  search on metacpan

OneTimeDownload.pm  view on Meta::CPAN

$VERSION = '1.01';

sub handler {

    my $r = shift;

  # Read in the key we're using
    my ($key) = $r->unparsed_uri =~ /([a-f0-9]{32})/ or return Apache2::Const::NOT_FOUND; 
        

  # Load our database

    my $db_name = $r->dir_config("OneTimeDb")
      or die "Database not specified in OneTimeDb!";

    my %db; tie %db, "MLDBM", $db_name
      or die "Couldn't open database $db_name: $!";

  # Does the key exist?
		
    return Apache2::Const::FORBIDDEN if !exists $db{$key};

    my $file = $db{$key};

  # Has the object expired?

    my $time_until_expiry = $file->{expires} - time();

    unless ($time_until_expiry > 0) {

        return Apache2::Const::FORBIDDEN;

    }

  # Does the object need it's expiry date shortened?

    my $window = $r->dir_config("OneTimeWindow") || 3600;

    if ( $time_until_expiry > $window ) {

      $file->{downloaded} = 1;
      $file->{count} = $file->{count} + 1;
      $file->{expires} = ( time() + ( $window - 1 ) );
      $db{$key} = $file;

    }

    my $file_path = $r->dir_config("OneTimeDownloadDirectory") . $file->{file};

    untie %db;

    # Return the file
    my $filesize= -s $file_path;
    my $subr = $r->lookup_file( $file_path  );
    return Apache2::Const::NOT_FOUND unless (defined($subr));

    $subr->headers_in->set( 'Range' => $r->headers_in->get('Range') ) if (defined($r->headers_in->get('Range')));

    $r->headers_out->set("Accept-Ranges" => "bytes");
    $r->headers_out->set("Content-Length" => $filesize);
    $r->headers_out->set("Content-Disposition" => "attachment; filename=".$file->{file});

    return $subr->run();

}


sub authorize {

  my ($db_name, $comments, $file, $expiry) = @_;

  my $key = md5_hex(time().{}.rand().$$);

  my %db; tie %db, "MLDBM", $db_name or die "Couldn't open database: $!";

  $db{$key} = {

    comments   => $comments,
    expires    => $expiry || ( time() + 604800 ),
    file       => $file,
    downloaded => 0,
    count      => 0

  };

  untie %db;
  return $key;

}



1;