view release on metacpan or  search on metacpan

t/cgi-simple.t  view on Meta::CPAN

#########################
# This test is basically a copy of t/basic.t
# with CGI::Simple substituted for CGI.pm

use Test::More;
Test::More->builder->no_ending(1);
use Carp::Assert;
use Config;
use Data::Dumper;
use DBI;
use Test::DatabaseRow;
use HTTP::Request::Common;
use lib 't/lib';
use CGI::Uploader::Test; # provides setup() read_file(), etc
use strict;

$| = 1;

if (! $Config{d_fork} ) {
    plan skip_all => "fork not available on this platform";
}
else {
    eval {
           require CGI::Simple;
           import CGI::Simple qw(-upload);
    };
    if($@) {
        plan skip_all => 'CGI::Simple not available'
    }
    else {
        plan skip_all => 'CGI::Simple should work, but having these tests for it work is
            pending a bug fix: http://rt.cpan.org/NoAuth/Bug.html?id=14838';
        #plan tests => 23;
    }
}

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;

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

     my $q = new CGI::Simple;
	 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;
     use Data::Dumper;
     warn Dumper ($form_data);


 	 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');

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

    my $new_file_contents = read_file("t/uploads/$id_of_test_file_gen.asc");