The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#########################
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;

    my $new_file_contents; 
    eval { $new_file_contents = read_file($test_file_gen); };
    # Maybe the file was detected as *.asc instead, so try that. 

    is($@, '', 'survived eval') || diag `ls -l t/uploads/`;
    like($new_file_contents,qr/gen/, "generated file is as expected");

	$Test::DatabaseRow::dbh = $DBH;
	row_ok( sql   => "SELECT * FROM uploads ORDER BY upload_id LIMIT 1",
                tests => {
					'eq' => {
						mime_type => 'text/plain',
						extension => '.txt',
					},
					'=~' => {
						upload_id => qr/^\d+/,
					},
				} ,
                label => "reality checking a database row");

	my $row_cnt = $DBH->selectrow_array("SELECT count(*) FROM uploads ");
	is($row_cnt,2, 'number of rows in database');


# test fk_meta()
{
    # mysql has a funny way of quoting
    # my $qt = ($drv eq 'mysql') ? '`' : '"'; 
    ok($DBH->do(qq!INSERT INTO cgi_uploader_test (item_id,test_file_id,test_file_gen_id) 
        VALUES (1, $id_of_test_file_parent,
                 $id_of_test_file_gen)!), 'test data insert');

 	my $tmpl_vars_ref = $u->fk_meta(
         table   => 'cgi_uploader_test',
         where   => {item_id => 1},
         prefixes => [qw/test_file test_file_gen/]);
 
 	ok (eq_set(
 			[qw/
                test_file_url 
                test_file_id
 
                test_file_gen_url 
                test_file_gen_id
 			/],
 			[keys %$tmpl_vars_ref],
 		), 'fk_meta keys returned') || diag Dumper($tmpl_vars_ref);
 
     row_ok( sql   => "SELECT * FROM uploads  WHERE upload_id= $id_of_test_file_gen",
                 tests => [ 
 					mime_type        => 'text/plain',
 					extension        => '.txt',
 				    width	         => undef,		
 					height	         => undef,
 					gen_from_id      => $id_of_test_file_parent,
 					],
                 label => "upload for thumb of generated test file is all good");

}

    my $LoH = $DBH->selectall_arrayref("SELECt * FROM uploads",{Slice=>{}});

# # Simulate another upload, 
{
              my %entity_upload_extra = $u->store_upload(
                  file_field    => 'test_file',
                  src_file      => 't/200x200.gif',
                  uploaded_mt   => 'image/gif',
                  file_name     => '200x200.gif',
                  id_to_update  => $id_of_test_file_parent,
              );
 
          row_ok( sql   => "SELECT * FROM uploads  WHERE upload_id= $id_of_test_file_parent",
              tests => [ 
              mime_type       => 'image/gif',
              extension       => '.gif',
              width	          => 200,		
              height	      => 200,
              gen_from_id     => undef,
              ],
              label =>
              "image that had the ID of the test file should house a 200x200 image");
}

{
 	ok((!-e 't/uploads/1.txt'), 'after replacing a file, the extension changes') || diag read_file('t/uploads/1.txt');
}

{
 	my $found_old_thumbs = $DBH->selectcol_arrayref("
 			SELECT upload_id FROM uploads WHERE upload_id IN ($id_of_test_file_gen)");
 	is(scalar @$found_old_thumbs,0, 
 	  'The original generated files of the test file should be deleted');
}
 
{
   my $how_many_thumbs = $DBH->selectrow_array("SELECT 
 		count(upload_id) FROM uploads WHERE gen_from_id = $id_of_test_file_parent");
 	is($how_many_thumbs,1,	
 		'1 new thumbnail for this image should have been generated');
}


{

 	 $q->param('test_file_delete',1);
 	 $q->param('test_file_id',$id_of_test_file_parent);
 	 my @deleted_field_ids = $u->delete_checked_uploads;

    my @cmp_array = (\@deleted_field_ids,['test_file_id', 'test_file_gen_id']);
 	 ok(eq_set(@cmp_array), 
         'delete_checked_uploads returned field ids') || diag Dumper (@cmp_array);

 	 @files = <t/uploads/*>;	
 
 	ok(scalar @files == 0, 'expected number of files removed') || diag Dumper (\@files);
 	$row_cnt = $DBH->selectrow_array("SELECT count(*) FROM uploads ");
 	ok($row_cnt == 0, "Expected number of rows remaining:  ($row_cnt)");
}