view release on metacpan or  search on metacpan

lib/HTTP/DownloadLimit.pm  view on Meta::CPAN

our $VERSION = '0.1.0';

use strict;
use warnings;

use Fcntl qw/:DEFAULT :flock/;
use CGI::Carp qw/fatalsToBrowser/;

$| = 1;

#--------------------------------------------------#
# ëÏÎÓÔÒÕËÔÏÒ
sub new
{
    my( $class, %opt ) = @_;
    my $self =
    {
	REMOVE_FILE => $opt{'REMOVE_FILE'} || 1,
	TYPE_ALLOW => $opt{'TYPE_ALLOW'} || ['avi','mov','mpeg','mkv','mp4','mpg','vob'],
	FILE_NAME => $opt{'FILE_NAME'},
	BUFFER => $opt{'BUFFER'} || 262144,
	DEBUG => $opt{'DEBUG'} || 1, # *Options*
	MULTI => $opt{'MULTI'} || 0, # *Options*
	PATH => $opt{'PATH'} || '.',
	LOG => $opt{'LOG'} || '/var/log/HTTP::DownloadLimit.log', # *Options* if DEBUG=true
		
	FILE_SIZE => 0,
	HTTP_RANGE => 0,
    };

    # ÏÂÒÁÂÏÔÁÔØ ÉÍÑ ÆÁÊÌÁ ÅÓÌÉ ÏÎ ÓÏÄÅÒÖÉÔ /
    my @tmp = split( /\//, $$self{'FILE_NAME'} );
    $$self{'FILE_NAME'} = $tmp[$#tmp];
    $$self{'PATH'} .= "/" . join '/', @tmp[0..$#tmp-1];

    bless $self, $class;
	
    return $self;
}
#--------------------------------------------------#
# óËÁÞËÁ ÆÁÊÌÁ Ó ×ÓÅ×ÏÚÍÏÖÎÙÍÉ ÐÒÏ×ÅÒËÁÍÉ
sub Download
{
    my $self = shift;
	
    ## ÐÒÏ×ÅÒÉÔØ ÎÁÌÉÞÉÅ ÚÁÐÒÁÛÉ×ÁÅÍÏÇÏ ÆÁÊÌÁ
    if( -f "$$self{'PATH'}/$$self{'FILE_NAME'}" )
    {
	## ÐÏÌÕÞÉÔØ ÒÁÚÍÅÒ ÚÁÐÒÁÛÉ×ÁÅÍÏÇÏ ÆÁÊÌÁ
	$$self{'FILE_SIZE'} = -s "$$self{'PATH'}/$$self{'FILE_NAME'}";
	
	## ìÏÇÉÒÏ×ÁÎÉÅ *Options
	$self->_logwrite("Connected") if $$self{'DEBUG'};
	
	# ÏÐÒÅÄÅÌÉÔØ ÄÏÓÔÕÐ Ë ÆÁÊÌÕ ÄÌÑ ÏÄÎÁÇÏ ÉÌÉ ÎÅÓËÏÌØËÉÈ ËÌÉÅÎÔÏ× ( *Option )
	if( $self->_check_pid && ! $$self{'MULTI'} )
	{
	    print $self->_http_status_403;
	    
	    $self->_logwrite("403 file is busy $$self{'FILE_NAME'}") if $$self{'DEBUG'};
	}
	else
	{
	    ## ÐÒÏ×ÅÒÉÔØ ÓÏÏÔ×ÅÃÔ×ÉÅ ÚÁÐÒÁÛÉ×ÁÅÍÏÇÏ ÆÁÊÌÁ ÄÏÐÕÓÔÉÍÙÍ ÆÏÒÍÁÔÁÍ
	    unless( $self->_permission )
	    {
		print $self->_http_status_403;
		
		$self->_logwrite("403 type file $$self{'FILE_NAME'}") if $$self{'DEBUG'};
	    }
	    else
	    {
		$self->_logwrite("GET $$self{'FILE_NAME'}") if $$self{'DEBUG'};
	    
		# ÏÔËÒÙÔØ ÆÁÊÌ ÎÁ ÞÔÅÎÉÅ
		open( FH, '<', "$$self{'PATH'}/$$self{'FILE_NAME'}" )
		    or die $self->_logwrite("Permission denied $$self{'FILE_NAME'}") if $$self{'DEBUG'};
		## ÄÅÌÁÅÔ ÌÉ ËÌÉÅÎÔ ÄÏËÁÞËÕ?
		if( exists $ENV{'HTTP_RANGE'} )
		{
		    $$self{'HTTP_RANGE'} = ( $ENV{'HTTP_RANGE'} =~ /bytes=(\d*)-/ )[0];
		    ## ÕÓÔÁÎÏ×ÉÔØ ÕËÁÚÁÔÅÌØ ÄÅÓËÒÉÐÔÏÒÁ ÆÁÊÌÁ ÄÌÑ ÐÒÏÄÏÌÖÅÎÉÑ ÓËÁÞËÉ
		    seek FH, $$self{'HTTP_RANGE'}, 0;
		    # ×Ù×ÅÓÔÉ ÚÏÇÏÌÏ×ÏË ÓÏÏÔ×ÅÃÔ×ÕÀÝÉÊ ÄÌÑ ÐÒÏÄÏÌÖÅÎÉÑ ÓËÁÞËÉ ÆÁÊÌÁ
		    print $self->_http_status_206;
		}
		else
		{
		    # ×Ù×ÅÓÔÉ ÚÁÇÏÌÏ×ÏË ÄÌÑ ÓËÁÞËÉ ÆÁÊÌÁ Ó 0-ÌÑ
		    print $self->_http_status_200;
		}
		
		# ÕÓÔÁÎÏ×ÉÔØ ÂÉÎÁÒÎÙÊ ÒÅÖÉÍ ÄÌÑ ÏÂÅÉÈ ÄÉÓËÒÉÐÔÏÒÏ×
		binmode FH; binmode STDOUT;
		
		## ÞÉÔÁÔØ ÉÚ ÄÉÓËÒÉÐÔÏÒÁ ÄÁÎÎÙÅ × ÂÉÎÁÒÎÏÍ ×ÉÄÅ É ×ÙÄÏ×ÁÔØ ÉÈ ËÌÉÅÎÔÕ	
		while( read FH, my $buf, $$self{'BUFFER'} )
		{
		    print $buf;
		    last if tell( FH ) == $$self{'FILE_SIZE'};
		}
				
		close FH && $self->_logwrite("Download $$self{'FILE_NAME'} complit") if $$self{'DEBUG'};
		
		## ÕÄÁÌÉÔØ ÆÁÊÌ É PID ÆÁÊÌÁ ÐÏÓÌÅ ÐÏÌÎÏÊ ÓËÁÞËÉ
		## ÕÄÁÌÉÔØ ÄÉÒÅËÔÏÒÉÀ ÇÄÅ ÌÅÖÁÌÉ ÆÁÊÌÙ ÎÁÚ×ÁÎÎÙÅ ×ÙÛÅ
		if( $$self{'REMOVE_FILE'} )
		{
		    if( unlink("$$self{'PATH'}/$$self{'FILE_NAME'}") && unlink("$$self{'PATH'}/$$self{'FILE_NAME'}.pid") )
		    {
		        $self->_logwrite("delete $$self{'PATH'}/$$self{'FILE_NAME'} and $$self{'PATH'}/$$self{'FILE_NAME'}.pid") if $$self{'DEBUG'};
		    }
		    else
		    {
			$self->_logwrite("not delete $$self{'PATH'}/$$self{'FILE_NAME'} and $$self{'PATH'}/$$self{'FILE_NAME'}.pid") if $$self{'DEBUG'};
		    }

		    if( rmdir("$$self{'PATH'}") )
		    {
			$self->_logwrite("delete $$self{'PATH'}") if $$self{'DEBUG'};