File Coverage

blib/lib/jQuery/File/Upload/Imager.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package jQuery::File::Upload::Imager;

use 5.008008;
use strict;
use warnings;

use CGI;
use JSON::XS;
use Net::SSH2;
use Net::SSH2::SFTP;
use Imager;
use Cwd 'abs_path';
use Digest::MD5 qw(md5_hex);
use URI;

#use LWP::UserAgent;
#use LWP::Protocol::https;

our $VERSION = '1.01';

my %errors =  (
	'_validate_max_file_size' => 'File is too big',
	'_validate_min_file_size' => 'File is too small',
	'_validate_accept_file_types' => 'Filetype not allowed',
	'_validate_max_number_of_files' => 'Maximum number of files exceeded',
	'_validate_max_width' => 'Image exceeds maximum width',
	'_validate_min_width' => 'Image requires a minimum width',
	'_validate_max_height' => 'Image exceeds maximum height',
	'_validate_min_height' => 'Image requires a minimum height'
);

#GETTERS/SETTERS
sub new {
    my $invocant = shift;
    my $class   = ref($invocant) || $invocant;
    my $self = {
		field_name => 'files[]',
		ctx => undef,
		cgi	=> undef,
		thumbnail_width => 80,
		thumbnail_height => 80,
		thumbnail_quality => 70,
		thumbnail_format => 'jpg',
		thumbnail_density => undef,
		format => 'jpg',
		quality => 70,

		thumbnail_filename => undef,
		thumbnail_prefix => 'thumb_',
		thumbnail_postfix => '',
		filename => undef,
		client_filename => undef,
		show_client_filename => 1,
		use_client_filename => undef,
		filename_salt => '',
		script_url => undef,
		tmp_dir => '/tmp',
		should_delete => 1,

		absolute_filename => undef,
		absolute_thumbnail_filename => undef,

		delete_params => [],

		upload_dir => undef,
		thumbnail_upload_dir => undef,
		upload_url_base => undef,
		thumbnail_url_base => undef,
		relative_url_path => '/files',
		thumbnail_relative_url_path => undef,
		relative_to_host => undef,
		delete_url => undef,

		data => {},

		#callbacks
		post_delete => sub {},
		post_post => sub {},
		post_get => sub {},

		#pre calls
		pre_delete => sub {},
		pre_post => sub {},
		pre_get => sub {},

		#scp/rcp login info
		scp => [],

		#user validation specifications
		max_file_size => undef,
		min_file_size => 1,
		accept_file_types => [],
		require_image => undef,
		max_width => undef,
		max_height => undef,
		min_width => 1,
		min_height => 1,
		max_number_of_files => undef,

		#not to be used by users
		output => undef,
		handle => undef,
		tmp_filename => undef,
		fh => undef,
		error => undef,
		upload => undef,
		file_type => undef,
		is_image => undef,
		imager => undef,
		width => undef,
		height => undef,
		num_files_in_dir => undef,
        @_,                 # Override previous attributes
    };
    return bless $self, $class;
}

sub upload_dir {
	my $self = shift;

  if (@_) {
 		$self->{upload_dir} = shift;
  }

	#set upload_dir to directory of this script if not provided
	if(!(defined $self->{upload_dir})) {
		$self->{upload_dir} = abs_path($0);
		$self->{upload_dir} =~ s/(.*)\/.*/$1/;
		$self->{upload_dir} .= '/files';
	}

	return $self->{upload_dir};
}

sub thumbnail_upload_dir {
	my $self = shift;

  if (@_) {
	  $self->{thumbnail_upload_dir} = shift;
  }

	#set upload_dir to directory of this script if not provided
	if(!(defined $self->{thumbnail_upload_dir})) {
			$self->{thumbnail_upload_dir} = $self->upload_dir;
	}

	return $self->{thumbnail_upload_dir};
}

sub upload_url_base {
	my $self = shift;

  if (@_) {
  	$self->{upload_url_base} = shift;
  }

	if(!(defined $self->{upload_url_base})) {
		$self->{upload_url_base} = $self->_url_base . $self->relative_url_path;
	}

	return $self->{upload_url_base};
}

sub _url_base {
	my $self = shift;
	my $url;

	if($self->relative_to_host) {
		$url = $self->{uri}->scheme . '://' . $self->{uri}->host;
	}
	else {
		$url = $self->script_url;
		$url =~ s/(.*)\/.*/$1/;
	}

	return $url;
}

sub thumbnail_url_base {
	my $self = shift;

	if (@_) {
 	 $self->{thumbnail_url_base} = shift;
  }

	if(!(defined $self->{thumbnail_url_base})) {
		if(defined $self->thumbnail_relative_url_path) {
			$self->{thumbnail_url_base} = $self->_url_base . $self->thumbnail_relative_url_path;
		}
		else {
			$self->{thumbnail_url_base} = $self->upload_url_base;
		}
	}

	return $self->{thumbnail_url_base};
}


sub relative_url_path {
	my $self = shift;

	if(@_) {
		$self->{relative_url_path} = shift;
	}

	return $self->{relative_url_path};
}

sub thumbnail_relative_url_path {
	my $self = shift;

	if(@_) {
		$self->{thumbnail_relative_url_path} = shift;
	}

	return $self->{thumbnail_relative_url_path};
}

sub relative_to_host {
	my $self = shift;

	if(@_) {
		$self->{relative_to_host} = shift;
	}

	return $self->{relative_to_host};
}



sub field_name {
	my $self = shift;

    if (@_) {
        $self->{field_name} = shift;
    }

	return $self->{field_name};
}

sub ctx {
	my $self = shift;

    if (@_) {
        $self->{ctx} = shift;
    }

	return $self->{ctx};
}

sub cgi {
	my $self = shift;

    if (@_) {
	    $self->{cgi} = shift;
    }
	$self->{cgi} = CGI->new unless defined $self->{cgi};

	return $self->{cgi};
}

sub should_delete {
	my $self = shift;

    if (@_) {
        $self->{should_delete} = shift;
    }

	return $self->{should_delete};
}

sub scp {
	my $self = shift;

    if (@_) {
        $self->{scp} = shift;
    }

	return $self->{scp};
}

sub max_file_size {
	my $self = shift;

    if (@_) {
        $self->{max_file_size} = shift;
    }

	return $self->{max_file_size};
}

sub min_file_size {
	my $self = shift;

    if (@_) {
        $self->{min_file_size} = shift;
    }

	return $self->{min_file_size};
}

sub accept_file_types {
	my $self = shift;

  if (@_) {
		my $a_ref = shift;
		die "accept_file_types must be an array ref" unless UNIVERSAL::isa($a_ref,'ARRAY');
   	$self->{accept_file_types} = $a_ref;
  }

	if(scalar(@{$self->{accept_file_types}}) == 0 and $self->require_image) {
		$self->{accept_file_types} = ['image/jpeg','image/jpg','image/png','image/gif'];
	}

	return $self->{accept_file_types};
}

sub require_image {
	my $self = shift;

  if (@_) {
   	$self->{require_image} = shift;
  }

	return $self->{require_image};
}

sub delete_params {
	my $self = shift;

    if (@_) {
		my $a_ref = shift;
		die "delete_params must be an array ref" unless UNIVERSAL::isa($a_ref,'ARRAY');
        $self->{delete_params} = $a_ref;
    }

	return $self->{delete_params};
}

sub delete_url {
	my $self = shift;

	if(@_) {
		$self->{delete_url} = shift;
	}

	return $self->{delete_url};
}

sub thumbnail_width {
	my $self = shift;

    if (@_) {
        $self->{thumbnail_width} = shift;
    }

	return $self->{thumbnail_width};
}

sub thumbnail_height {
	my $self = shift;

    if (@_) {
        $self->{thumbnail_height} = shift;
    }

	return $self->{thumbnail_height};
}

sub thumbnail_quality {
	my $self = shift;

    if (@_) {
        $self->{thumbnail_quality} = shift;
    }

	return $self->{thumbnail_quality};
}

sub thumbnail_format {
	my $self = shift;

    if (@_) {
        $self->{thumbnail_format} = shift;
    }

	return $self->{thumbnail_format};
}

sub thumbnail_density {
	my $self = shift;

    if (@_) {
        $self->{thumbnail_density} = shift;
    }

	return $self->{thumbnail_density};
}

sub thumbnail_prefix {
	my $self = shift;

    if (@_) {
        $self->{thumbnail_prefix} = shift;
    }

	return $self->{thumbnail_prefix};
}

sub thumbnail_postfix {
	my $self = shift;

    if (@_) {
        $self->{thumbnail_postfix} = shift;
    }

	return $self->{thumbnail_postfix};
}

sub thumbnail_final_width {
	my $self = shift;

	if(@_) {
		$self->{thumbnail_final_width} = shift;
	}

	return $self->{thumbnail_final_width};
}

sub thumbnail_final_height {
	my $self = shift;

	if(@_) {
		$self->{thumbnail_final_height} = shift;
	}

	return $self->{thumbnail_final_height};
}

sub quality {
	my $self = shift;

    if (@_) {
        $self->{quality} = shift;
    }

	return $self->{quality};
}

sub format {
	my $self = shift;

    if (@_) {
        $self->{format} = shift;
    }

	return $self->{format};
}

sub final_width {
	my $self = shift;

	if(@_) {
		$self->{final_width} = shift;
	}

	return $self->{final_width};
}

sub final_height {
	my $self = shift;

	if(@_) {
		$self->{final_height} = shift;
	}

	return $self->{final_height};
}

sub max_width {
	my $self = shift;

    if (@_) {
        $self->{max_width} = shift;
    }

	return $self->{max_width};
}

sub max_height {
	my $self = shift;

    if (@_) {
        $self->{max_height} = shift;
    }

	return $self->{max_height};
}

sub min_width {
	my $self = shift;

    if (@_) {
        $self->{min_width} = shift;
    }

	return $self->{min_width};
}

sub min_height {
	my $self = shift;

    if (@_) {
        $self->{min_height} = shift;
    }

	return $self->{min_height};
}

sub max_number_of_files {
	my $self = shift;

    if (@_) {
        $self->{max_number_of_files} = shift;
    }

	return $self->{max_number_of_files};
}

sub filename {
	my $self = shift;

    if (@_) {
        $self->{filename} = shift;
    }

	return $self->{filename};
}

sub absolute_filename {
	my $self = shift;

    if (@_) {
        $self->{absolute_filename} = shift;
    }

	return $self->{absolute_filename};
}

sub thumbnail_filename {
	my $self = shift;

    if (@_) {
        $self->{thumbnail_filename} = shift;
    }

	return $self->{thumbnail_filename};
}

sub absolute_thumbnail_filename {
	my $self = shift;

    if (@_) {
        $self->{absolute_thumbnail_filename} = shift;
    }

	return $self->{absolute_thumbnail_filename};
}

sub client_filename {
	my $self = shift;

    if (@_) {
        $self->{client_filename} = shift;
    }

	return $self->{client_filename};
}

sub show_client_filename {
	my $self = shift;

    if (@_) {
        $self->{show_client_filename} = shift;
    }

	return $self->{show_client_filename};
}

sub use_client_filename {
	my $self = shift;

    if (@_) {
        $self->{use_client_filename} = shift;
    }

	return $self->{use_client_filename};
}

sub filename_salt {
	my $self = shift;

    if (@_) {
        $self->{filename_salt} = shift;
    }

	return $self->{filename_salt};
}

sub tmp_dir {
	my $self = shift;

    if (@_) {
        $self->{tmp_dir} = shift;
    }

	return $self->{tmp_dir};
}

sub script_url {
	my $self = shift;

    if (@_) {
        $self->{script_url} = shift;
    }

	if(!(defined $self->{script_url})) {
		if(defined $self->ctx) {
			$self->{script_url} = $self->ctx->request->uri;
		}
		else {
			$self->{script_url} = $ENV{SCRIPT_URI};
		}
	}

	return $self->{script_url};
}

sub data {
	my $self = shift;

	if(@_) {
		$self->{data} = shift;
	}

	return $self->{data};
}

#GETTERS
sub output { shift->{output} }
sub url { shift->{url} }
sub thumbnail_url { shift->{thumbnail_url} }
sub is_image { shift->{is_image} }

#OTHER METHODS
sub print_response {
	my $self = shift;

	my $content_type = 'text/plain';
	if(defined $self->ctx) {

		#thanks to Lukas Rampa for this suggestion
  		if ($self->ctx->req->headers->header('Accept') =~ qr(application/json) ) {
	  		$content_type = 'application/json';
  		}

		$self->ctx->stash->{current_view} = '';
		$self->ctx->res->content_type("$content_type; charset=utf-8");
		$self->ctx->res->body($self->output . ""); #concatenate "" for when there is no output
	}
	else {
		print "Content-type: $content_type\n\n";
		print $self->output;
	}
}

sub handle_request {
	my $self = shift;
	my ($print) = @_;
	my $method = $self->_get_request_method;

	if($method eq 'GET') {
		&{$self->pre_get}($self);
		&{$self->post_get}($self);
	}
	elsif($method eq 'PATCH' or $method eq 'POST' or $method eq 'PUT') {
		&{$self->pre_post}($self);
		$self->_post;
		&{$self->post_post}($self);
	}
	elsif($method eq 'DELETE') {
		&{$self->pre_delete}($self); #even though we may not delete, we should give user option to still run code
		if($self->should_delete) {
			$self->_delete;
			&{$self->post_delete}($self);
		}
	}
	else {
		$self->_set_status(405);
	}

	$self->print_response if $print;
	$self->_clear;
}

sub generate_output {
	my $self = shift;
	my ($arr_ref) = @_;

	#necessary if we are going to use _url_base via thumbnail_url_base and upload_url_base
	$self->_set_uri;

	my @arr;
	for(@$arr_ref) {
		my %h;
		die "Must provide a filename in generate_output" unless exists $_->{filename};
		die "Must provide a size in generate_output" unless exists $_->{size};
		$self->{is_image} = $_->{image} eq 'y' ? 1 : 0;
		$h{size} = $_->{size};
		$h{error} = $_->{error};

		if(exists $_->{'name'}) {
			$h{name} = $_->{name}
		}
		else {
			$h{name} = $_->{filename};
		}

		if(exists $_->{thumbnail_filename}) {
			$self->thumbnail_filename($_->{thumbnail_filename});
		}
		else {
			my $no_ext = $self->_no_ext;
			$self->thumbnail_filename($self->thumbnail_prefix . $no_ext . $self->thumbnail_postfix . '.' . $self->thumbnail_format);
		}

		$self->_set_urls;
		$h{url} = $_->{url} eq '' ? $self->url : $_->{url};
		$h{thumbnail_url} = $_->{thumbnail_url} eq '' ? $self->thumbnail_url : $_->{thumbnail_url};

		$h{delete_url} = $_->{'delete_url'} eq '' ? $self->_delete_url($_->{delete_params}) : $_->{'delete_url'};
		$h{delete_type} = 'DELETE';
		push @arr, \%h;

		#reset for the next time around
		$self->delete_url('');
	}

	#they should provide image=y or image=n if image
	my $json = JSON::XS->new->ascii->pretty->allow_nonref;
	$self->{output} = $json->encode({files => \@arr});
}

sub _no_ext {
	my $self = shift;
	$self->filename($_->{filename});
	my ($no_ext) = $self->filename =~ /(.*)\.(.*)/;
	return $no_ext;
}

#PRE/POST METHODS
sub pre_delete {
	my $self = shift;

    if (@_) {
        $self->{pre_delete} = shift;
    }

	return $self->{pre_delete};
}

sub post_delete {
	my $self = shift;

    if (@_) {
        $self->{post_delete} = shift;
    }

	return $self->{post_delete};
}

sub pre_post {
	my $self = shift;

    if (@_) {
        $self->{pre_post} = shift;
    }

	return $self->{pre_post};
}

sub post_post {
	my $self = shift;

    if (@_) {
        $self->{post_post} = shift;
    }

	return $self->{post_post};
}

sub pre_get {
	my $self = shift;

    if (@_) {
        $self->{pre_get} = shift;
    }

	return $self->{pre_get};
}

sub post_get {
	my $self = shift;

    if (@_) {
        $self->{post_get} = shift;
    }

	return $self->{post_get};
}

sub _clear {
	my $self = shift;

	#clear cgi object so we get a new one for new request
	$self->{cgi} = undef;
	$self->{handle} = undef;
	$self->{tmp_filename} = undef;
	$self->{upload} = undef;
	$self->{fh} = undef;
	$self->{file_size} = undef;
	$self->{error} = undef;
	$self->{file_type} = undef;
	$self->{is_image} = 0;
	$self->{width} = undef;
	$self->{height} = undef;
	$self->{num_files_in_dir} = undef;
	$self->{output} = undef;
	$self->{client_filename} = undef;
	$self->{tmp_thumb_path} = undef;
	$self->{tmp_file_path} = undef;
}

sub _post {
	my $self = shift;

	if($self->_prepare_file_attrs and $self->_validate_file) {
		if($self->is_image) {
			$self->_create_thumbnail;
			$self->_create_tmp_image
		}
		$self->_save;
	}

	#delete temporary files
	if($self->is_image) {
		unlink ($self->{tmp_thumb_path}, $self->{tmp_file_path});
	}

	#generate json output
	$self->_generate_output;
}

sub _generate_output {
	my $self = shift;

  my %hash;
	$hash{'name'} = $self->show_client_filename ? $self->client_filename . "" : $self->filename;
  $hash{'size'} = $self->{file_size};
  $hash{'url'} = $self->url;
  $hash{'thumbnail_url'} = $self->thumbnail_url;
  $hash{'delete_url'} = $self->_delete_url;
  $hash{'delete_type'} = 'DELETE';

	$hash{'error'} = $self->_generate_error;

	my $json = JSON::XS->new->ascii->pretty->allow_nonref;
	$self->{output} = $json->encode({files => [\%hash]});
}

sub _delete {
	my $self = shift;

	my $filename = $self->_get_param('filename');
	my $thumbnail_filename = $self->_get_param('thumbnail_filename');
	my $image_yn = $self->_get_param('image');

	if(@{$self->scp}) {
		for(@{$self->scp}) {

			my $ssh2 = $self->_auth_user($_);
			$_->{thumbnail_upload_dir} = $_->{upload_dir} if $_->{thumbnail_upload_dir} eq '';

			my $sftp = $ssh2->sftp;
			$sftp->unlink($_->{upload_dir} . '/' . $filename);
			$sftp->unlink($_->{thumbnail_upload_dir} . '/' . $thumbnail_filename) if $image_yn eq 'y';
		}
	}
	else {
		my $no_ext = $self->_no_ext;
		unlink $self->upload_dir . '/' . $filename;
		unlink($self->thumbnail_upload_dir . '/' . $thumbnail_filename) if $image_yn eq 'y';
	}
}

sub _get_param {
	my $self = shift;
	my ($param) = @_;

	if(defined $self->ctx) {
		return $self->ctx->req->params->{$param};
	}
	else {
		return $self->cgi->param($param);
	}
}

sub _delete_url {
	my $self = shift;
	return if $self->delete_url ne '';
	my ($delete_params) = @_;

	my $url = $self->script_url;
	my $uri = $self->{uri}->clone;

	my $image_yn = $self->is_image ? 'y' : 'n';

	unless(defined $delete_params and scalar(@$delete_params)) {
		$delete_params = [];
	}

	push @$delete_params, @{$self->delete_params} if @{$self->delete_params};
	push @$delete_params, ('filename',$self->filename,'image',$image_yn);
	push @$delete_params, ('thumbnail_filename',$self->thumbnail_filename) if $self->is_image;

	$uri->query_form($delete_params);

	$self->delete_url($uri->as_string);

	return $self->delete_url;
}

sub _script_url {
	my $self = shift;

	if(defined $self->ctx) {
		return $self->ctx->request->uri;
	}
	else {
		return $ENV{'SCRIPT_URI'};
	}
}

sub _prepare_file_attrs {
	my $self = shift;

	#ORDER MATTERS
	return undef unless $self->_set_upload_obj;
	$self->_set_fh;
	$self->_set_file_size;
	$self->_set_client_filename;
	$self->_set_tmp_filename;
	$self->_set_file_type;
	$self->_set_is_image;
	$self->_set_filename;
	$self->_set_absolute_filenames;
	$self->_set_imager;
	$self->_set_width;
	$self->_set_height;
	$self->_set_num_files_in_dir;
	$self->_set_uri;
	$self->_set_urls;

	return 1;
}

sub _set_urls {
	my $self = shift;

	if($self->is_image) {
		$self->{thumbnail_url} = $self->thumbnail_url_base . '/' . $self->thumbnail_filename;
	}
	$self->{url} = $self->upload_url_base . '/' . $self->filename;
}

sub _set_uri {
	my $self = shift;
	#if catalyst, use URI already made?
	if(defined $self->ctx) {
		$self->{uri} = $self->ctx->req->uri;
	}
	else {
		$self->{uri} = URI->new($self->script_url);
	}
}

sub _generate_error {
	my $self = shift;
	return undef unless defined $self->{error} and @{$self->{error}};

	my $restrictions = join ',', @{$self->{error}->[1]};
	return $errors{$self->{error}->[0]} . " Restriction: $restrictions Provided: " . $self->{error}->[2];
}

sub _validate_file {
	my $self = shift;
	return undef unless
	$self->_validate_max_file_size and
	$self->_validate_min_file_size and
	$self->_validate_accept_file_types and
	$self->_validate_max_width and
	$self->_validate_min_width and
	$self->_validate_max_height and
	$self->_validate_min_height and
	$self->_validate_max_number_of_files;

	return 1;
}

sub _save {
	my $self = shift;

	if(@{$self->scp}) {
		$self->_save_scp;
	}
	else {
		$self->_save_local;
	}
}

sub _save_scp {
	my $self = shift;

	for(@{$self->scp}) {
		die "Must provide a host to scp" if $_->{host} eq '';

		$_->{thumbnail_upload_dir} = $_->{upload_dir} if $_->{thumbnail_upload_dir} eq '';

		my $path = $_->{upload_dir} . '/' . $self->filename;
		my $thumb_path = $_->{thumbnail_upload_dir} . '/' . $self->thumbnail_filename;

		if(($_->{user} ne '' and $_->{public_key} ne '' and $_->{private_key} ne '') or ($_->{user} ne '' and $_->{password} ne '')) {
			my $ssh2 = $self->_auth_user($_);

			#if it is an image, scp both file and thumbnail
			if($self->is_image) {
				$ssh2->scp_put($self->{tmp_file_path}, $path);
				$ssh2->scp_put($self->{tmp_thumb_path}, $thumb_path);
			}
			else {
				$ssh2->scp_put($self->{tmp_filename}, $path);
			}

			$ssh2->disconnect;
		}
		else {
			die "Must provide a user and password or user and identity file for connecting to host";
		}

	}
}

sub _auth_user {
	my $self = shift;
	my ($auth) = @_;

	my $ssh2 = Net::SSH2->new;

	$ssh2->connect($auth->{host}) or die $!;

	#authenticate
	if($auth->{user} ne '' and $auth->{public_key} ne '' and $auth->{private_key} ne '') {
		$ssh2->auth_publickey($auth->{user},$auth->{public_key},$auth->{private_key});
	}
	else {
		$ssh2->auth_password($auth->{user},$auth->{password});
	}

	unless($ssh2->auth_ok) {
		die "error authenticating with remote server";
	}

	die "upload directory must be provided with scp hash" if $auth->{upload_dir} eq '';

	return $ssh2;
}

sub _save_local {
	my $self = shift;

	#if image
	if($self->is_image) {
		rename $self->{tmp_file_path}, $self->absolute_filename;
		rename $self->{tmp_thumb_path}, $self->absolute_thumbnail_filename;
	}
	#if non-image with catalyst
	elsif(defined $self->ctx) {
		$self->{upload}->link_to($self->absolute_filename);
	}
	#if non-image with regular CGI perl
	else {
		my $io_handle = $self->{fh}->handle;

		my $buffer;
		open (OUTFILE,'>', $self->absolute_filename);
		while (my $bytesread = $io_handle->read($buffer,1024)) {
			print OUTFILE $buffer;
		}
		close OUTFILE;
	}
}

sub _validate_max_file_size {
	my $self = shift;
	return 1 unless $self->max_file_size;

	if($self->{file_size} > $self->max_file_size) {
		$self->{error} = ['_validate_max_file_size',[$self->max_file_size],$self->{file_size}];
		return undef;
	}
	else {
		return 1;
	}
}

sub _validate_min_file_size {
	my $self = shift;
	return 1 unless $self->min_file_size;

	if($self->{file_size} < $self->min_file_size) {
		$self->{error} = ['_validate_min_file_size',[$self->min_file_size],$self->{file_size}];
		return undef;
	}
	else {
		return 1;
	}
}

sub _validate_accept_file_types {
	my $self = shift;

	#if accept_file_types is empty, we except all types
	#so return true
	return 1 unless @{$self->accept_file_types};

	if(grep { $_ eq $self->{file_type} } @{$self->{accept_file_types}}) {
		return 1;
	}
	else {
		my $types = join ",", @{$self->accept_file_types};
		$self->{error} = ['_validate_accept_file_types',[$types],$self->{file_type}];
		return undef;
	}
}

sub _validate_max_width {
	my $self = shift;
	return 1 unless $self->is_image;

	#if set to undef, there's no max_width
	return 1 unless $self->max_width;

	if($self->{width} > $self->max_width) {
		$self->{error} = ['_validate_max_width',[$self->max_width],$self->{width}];
		return undef;
	}
	else {
		return 1;
	}
}

sub _validate_min_width {
	my $self = shift;
	return 1 unless $self->is_image;

	#if set to undef, there's no min_width
	return 1 unless $self->min_width;

	if($self->{width} < $self->min_width) {
		$self->{error} = ['_validate_min_width',[$self->min_width],$self->{width}];
		return undef;
	}
	else {
		return 1;
	}
}

sub _validate_max_height {
	my $self = shift;
	return 1 unless $self->is_image;

	#if set to undef, there's no max_height
	return 1 unless $self->max_height;

	if($self->{height} > $self->max_height) {
		$self->{error} = ['_validate_max_height',[$self->max_height],$self->{height}];
		return undef;
	}
	else {
		return 1;
	}
}

sub _validate_min_height {
	my $self = shift;
	return 1 unless $self->is_image;

	#if set to undef, there's no max_height
	return 1 unless $self->min_height;

	if($self->{height} < $self->min_height) {
		$self->{error} = ['_validate_min_height',[$self->min_height],$self->{height}];
		return undef;
	}
	else {
		return 1;
	}
}

sub _validate_max_number_of_files {
	my $self = shift;
	return 1 unless $self->max_number_of_files;

	if($self->{num_files_in_dir} > $self->max_number_of_files) {
		$self->{error} = ['_validate_max_number_of_files',[$self->max_number_of_files],$self->{num_files_in_dir}];
		return undef;
	}
	else {
		return 1;
	}
}

sub _set_file_size {
	my $self = shift;

	if(defined $self->ctx) {
		$self->{file_size} = $self->{upload}->size;
	}
	else {
		$self->{file_size} = -s $self->{upload};
	}

	return $self->{file_size};
}

sub _set_client_filename {
	my $self = shift;
	return if defined $self->client_filename;

	if(defined $self->ctx) {
		$self->client_filename($self->{upload}->filename);
	}
	else {
		$self->client_filename($self->cgi->param($self->field_name));
	}

	return $self->client_filename;
}

sub _set_filename {
	my $self = shift;
	return if defined $self->filename;

	if($self->use_client_filename) {
		$self->filename($self->client_filename);
	}
	else {
		my $filename = md5_hex($self->client_filename . time() . int(rand(1000))) . time() . $self->filename_salt;
		$self->thumbnail_filename($self->thumbnail_prefix . $filename . $self->thumbnail_postfix . '.' . $self->thumbnail_format) unless $self->thumbnail_filename;

		if($self->is_image) {
			$filename .= '.' . $self->format;
		}
		else {
			#add extension if present
			if($self->client_filename =~ /.*\.(.*)/) {
				$filename .= '.' . $1;
			}
		}
		$self->filename($filename) unless $self->filename;
	}

	return $self->filename;
}

sub _set_absolute_filenames {
	my $self = shift;

	$self->absolute_filename($self->upload_dir . '/' . $self->filename) unless $self->absolute_filename;
	$self->absolute_thumbnail_filename($self->thumbnail_upload_dir . '/' . $self->thumbnail_filename) unless $self->absolute_thumbnail_filename;
}

sub _set_file_type {
	my $self = shift;

	if(defined $self->ctx) {
		$self->{file_type} = $self->{upload}->type;
	}
	else {
		$self->{file_type} = $self->cgi->uploadInfo($self->client_filename)->{'Content-Type'};
	}

	return $self->{file_type};
}

sub _set_is_image {
	my $self = shift;

	if($self->{file_type} eq 'image/jpeg' or $self->{file_type} eq 'image/jpg' or $self->{file_type} eq 'image/png' or $self->{file_type} eq 'image/gif') {
		$self->{is_image} = 1;
	}
	else {
		$self->{is_image} = 0;
	}

	return $self->is_image;
}

sub _set_imager {
	my $self = shift;
	return unless $self->is_image;

	#if used in persistent setting, don't recreate object
	$self->{imager} = Imager->new unless defined $self->{imager};

	$self->{imager}->read(fh => $self->{fh});

	return $self->{imager};
}

sub _set_width {
	my $self = shift;
	return unless $self->is_image;

	$self->{width} = $self->{imager}->getwidth;
}

sub _set_height {
	my $self = shift;
	return unless $self->is_image;

	$self->{height} = $self->{imager}->getheight;
}

sub _set_tmp_filename {
	my $self = shift;

	my $tmp_filename;
	if(defined $self->ctx) {
		$self->{tmp_filename} = $self->{upload}->tempname;
	}
	else {
		$self->{tmp_filename} = $self->cgi->tmpFileName($self->client_filename);
	}
}

sub _set_upload_obj {
	my $self = shift;

	if(defined $self->ctx) {
		$self->{upload} = $self->ctx->request->upload($self->field_name);
	}
	else {
		$self->{upload} = $self->cgi->upload($self->field_name);
	}

	return defined $self->{upload};
}

sub _set_fh {
	my $self = shift;

	if(defined $self->ctx) {
		$self->{fh} = $self->{upload}->fh;
	}
	else {
		$self->{fh} = $self->{upload};
	}

	return $self->{fh};
}

sub _set_num_files_in_dir {
	my $self = shift;
	return unless $self->max_number_of_files;

	#DO SCP VERSION
	if(@{$self->{scp}}) {
		my $max = 0;
		for(@{$self->{scp}}) {
			my $ssh2 = $self->_auth_user($_);
			my $chan = $ssh2->channel();
			$chan->exec('ls -rt ' . $_->{upload_dir} . ' | wc -l');
			my $buffer;
			$chan->read($buffer,1024);
			($self->{num_files_in_dir}) = $buffer =~ /(\d+)/;
			$max = $self->{num_files_in_dir} if $self->{num_files_in_dir} > $max;
		}

		#set to maximum of hosts because we know if one's over that's too many
		$self->{num_files_in_dir} = $max;
	}
	else {
		my $dir = $self->upload_dir;
		my @files = <$dir/*>;
	   	$self->{num_files_in_dir} = @files;
	}

	return $self->{num_files_in_dir};
}

sub _get_request_method {
	my $self = shift;

	my $method = '';
	if(defined $self->ctx) {
		$method = $self->ctx->req->method;
	}
	else {
		$method = $self->cgi->request_method;
	}

	return $method;
}

sub _set_status {
	my $self = shift;
	my ($response) = @_;

	if(defined $self->ctx) {
		$self->ctx->response->status($response);
	}
	else {
		print $self->cgi->header(-status=>$response);
	}
}

sub _set_header {
	my $self = shift;
	my ($key,$val) = @_;

	if(defined $self->ctx) {
		$self->ctx->response->header($key => $val);
	}
	else {
		print $self->cgi->header($key,$val);
	}
}

sub _create_thumbnail {
  my $self = shift;

  my $im = $self->{image}->copy;

	#thumb is added at beginning of tmp_thumb_path as to not clash with the original image file path
  my $output  = $self->{tmp_thumb_path} = $self->tmp_dir . '/thumb_' . $self->thumbnail_filename;
  my $width   = $self->thumbnail_width;
  my $height  = $self->thumbnail_height;

  my $density = $self->thumbnail_density || $width . "x" . $height;
  my $quality = $self->thumbnail_quality;
  my $format  = $self->thumbnail_format;

  # source image dimensions
  my ($o_width, $o_height) = ($im->getwidth,$im->getheight);

  # calculate image dimensions required to fit onto thumbnail
  my ($t_width, $t_height, $ratio);
  # wider than tall (seems to work...) needs testing
  if( $o_width > $o_height ){
    $ratio = $o_width / $o_height;
    $t_width = $width;
    $t_height = $width / $ratio;

    # still won't fit, find the smallest size.
    while($t_height > $height){
      $t_height -= $ratio;
      $t_width -= 1;
    }
  }
  # taller than wide
  elsif( $o_height > $o_width ){
    $ratio = $o_height / $o_width;
    $t_height = $height;
    $t_width = $height / $ratio;

    # still won't fit, find the smallest size.
    while($t_width > $width){
      $t_width -= $ratio;
      $t_height -= 1;
    }
  }
  # square (fixed suggested by Philip Munt [e-mail])
  elsif( $o_width == $o_height){
    $ratio = 1;
    $t_height = $width;
    $t_width  = $width;
     while (($t_width > $width) or ($t_height > $height)){
       $t_width -= 1;
       $t_height -= 1;
     }
  }

  # Create thumbnail
  if( defined $im ){
    $im->scale( xpixels => $t_width, ypixels => $t_height, type => 'nonprop' );
#    $im->Set( quality => $quality );

	my(@options) = (file => $output, type => $format);

	if ( ($format eq 'jpeg') && defined($quality) )
	{
		push @options, 'jpegquality', $quality;
	}

#    $im->Set( density => $density );

	my($x, $y) = split(/x/, $density);

	if (defined($x) && ($x > 0) && defined($y) && ($y > 0) )
	{
	    $im->scale( xpixels => $x, ypixels => $y, type => 'nonprop' );
	}

	$self->final_width($t_width);
	$self->final_height($t_height);

	$im->write(@options);
  }
}

sub _create_tmp_image {
  my $self = shift;
  my $im = $self->{image};

	#main_ is added as to not clash with thumbnail tmp path if thumbnail_prefix = '' and they have the same name
  my $output  = $self->{tmp_file_path} = $self->tmp_dir . '/main_' . $self->filename;
  my $quality = $self->thumbnail_quality;
  my $format  = $self->thumbnail_format;

  if( defined $im ){
#    $im->Set( quality => $quality );

	$im->write(file => $output, type => $format);

	$self->final_width($im->getwidth);
	$self->final_height($im->getheight);
  }
}

#sub _save_cloud {
#	my $self = shift;
#	my $io_handle = $self->{fh}->handle;
#
#	#IF IS IMAGE, MUST UPLOAD BOTH IMAGES
#
#  my $s_contents;
#	while (my $bytesread = $io_handle->read($buffer,1024)) {
#		print OUTFILE $buffer;
##	}
#
#
##   while()
#    {
#     $s_contents .= $_;
##    }
#
##   ### we will call this resource whatever comes after the last /
#    my $s_resourceName;
#
##    if($param->{'path'} =~ /^.*\/(.*)$/)
#    {
#     $s_resourceName = $1;
##    }
#    else
#    {
#     return('fail', "could not parse path: $param->{'path'}");
##    }
#
#    ### should we pass these vars ... or look them up?
#   my $s_user = '';
#    my $s_key = '';
##    my $s_cdn_uri ='';
#
#    my $ua = LWP::UserAgent->new;
#   my $req = HTTP::Request->new(GET => 'https://auth.api.rackspacecloud.com/v1.0');
##    $req->header('X-Auth-User' => $s_user);
#    $req->header('X-Auth-Key' => $s_key);
#
##    my $res = $ua->request($req);
#
#   if ($res->is_success)
##    {
#      my $s_url = $res->header('X-Storage-Url') . "/container/" . $s_resourceName;
#
##      my $reqPUT = HTTP::Request->new(PUT => $s_url);
#      $reqPUT->header('X-Auth-Token' => $res->header('X-Auth-Token'));
#
##      $reqPUT->content( $s_contents );
#
#     my $resPUT = $ua->request($reqPUT);
##
#      if($resPUT->is_success)
#     {
##        my $s_returnURI = $s_cdn_uri . "/" . $s_resourceName;
#        return('pass','passed afaict', $s_returnURI);
#     }
##      else
#      {
#       my $s_temp = $resPUT->as_string;
#        $s_temp =~ s/'/\\'/g;
##        return('fail',"PUT failed with response:$s_temp")
#      }
#   }
##    else
#    {
#     my $s_temp = $res->as_string;
##      $s_temp =~ s/'/\\'/g;
#      return('fail',"failed with response:$s_temp")
#   }
##  }
#  else
# {
##    return("fail","sorry no file found at $param->{'path'}");
#  }
#}
#
##sub _delete_cloud {
#	my $self    = shift;
#  my $request = HTTP::Request->new( 'DELETE', $self->_url,
#Q					        [ 'X-Auth-Token' => $self->cloudfiles->token ] );
#	my $response = $self->cloudfiles->_request($request);
#  confess 'Object ' . $self->name . ' not found' if $response->code == 404;
#  confess 'Unknown error' if $response->code != 204;
#}

# Preloaded methods go here.

1;
__END__