view release on metacpan or  search on metacpan

t/basic.t  view on Meta::CPAN

#########################
use Test::More;
# This allows me to fork without the test system having a cow.
# I can't run any more tests in the parent after I do this. 
# See: http://perlmonks.org/?node_id=469077
# Thanks, Cees.
Test::More->builder->no_ending(1);
use Carp::Assert;
use Data::Dumper;
use DBI;
use CGI;
use Test::DatabaseRow;

use HTTP::Request::Common;
use lib 't/lib';
use CGI::Uploader::Test; # provides setup() and read_file()
use Config;

use strict;

$| = 1;

if (! $Config{d_fork} ) {
    plan skip_all => "fork not available on this platform";
}
else {
    plan tests => 24;

}

my ($DBH,$drv) = setup();

my $req = &HTTP::Request::Common::POST(
    '/dummy_location',
    Content_Type => 'form-data',
    Content      => [
        test_file => ["t/test_file.txt"],
    ]
);

# Useful in simulating an upload. 
$ENV{REQUEST_METHOD} = 'POST';
$ENV{CONTENT_TYPE}   = 'multipart/form-data';
$ENV{CONTENT_LENGTH} = $req->content_length;
if ( open( CHILD, "|-" ) ) {
    print CHILD $req->content;
    close CHILD;
    exit 0;
}


use CGI::Uploader;
use CGI;

	 my %imgs = (
		'test_file' => { 
            gen_files => {
                'test_file_gen' => \&test_gen_transform,
            },
        },
	 );

     my $q = new CGI;
	 my $u = 	CGI::Uploader->new(
		updir_path=>'t/uploads',
		updir_url=>'http://localhost/test',
		dbh => $DBH,
		query => $q,
		spec => \%imgs,
	 );
	 ok($u, 'Uploader object creation');

     my $form_data = $q->Vars;

 	 my ($entity);
	 eval { $entity = $u->store_uploads($form_data) };
	 is($@,'', 'calling store_uploads');


	ok(not(grep {m/^(test_file)$/} keys %$entity),
           'store_uploads entity removals work');

	my @files = <t/uploads/*>;	
	ok(scalar @files == 2, 'expected number of files created');

    # We jump through this hoop because the MIME type detector
    # may have chosen ".txt" or "*.asc" for the file extension.
    my ($test_file_parent) = grep { /1/ } @files;
    my ($test_file_gen )   = grep { /2/ } @files;

    my $id_of_test_file_parent = 1;
    my $id_of_test_file_gen    = 2;