[p5sagit/p5-mst-13.2.git] / cpan / CPANPLUS / t / 03_CPANPLUS-Internals-Source.t

### make sure we can find our conf.pl file
BEGIN { 
    use FindBin; 
    require "$FindBin::Bin/inc/conf.pl";
}

use strict;

use Module::Load;
use Test::More eval { 
            load $ENV{CPANPLUS_SOURCE_ENGINE} if $ENV{CPANPLUS_SOURCE_ENGINE}; 1 
        } ? 'no_plan'
          : (skip_all => "SQLite engine not available");

use CPANPLUS::Error;
use CPANPLUS::Backend;
use CPANPLUS::Internals::Constants;

use Data::Dumper;
use File::Basename qw[dirname];

my $conf = gimme_conf();
my $cb   = CPANPLUS::Backend->new( $conf );

### XXX temp
# $conf->set_conf( verbose => 1 );

isa_ok($cb, "CPANPLUS::Internals" );

my $modname = TEST_CONF_MODULE;

### test lookups
{   my $mt      = $cb->_module_tree;
    my $at      = $cb->_author_tree;

    ### source files should be copied from the 'server' now
    for my $name (qw[auth mod dslip] ) {
        my $file = File::Spec->catfile( 
                            $conf->get_conf('base'),
                            $conf->_get_source($name)
                    );            
        ok( (-e $file && -f _ && -s _), "$file exists" );
    }    

    ok( $at,                    "Authortree loaded successfully" );
    ok( scalar keys %$at,       "   Authortree has items in it" );
    ok( $mt,                    "Moduletree loaded successfully" );
    ok( scalar keys %$mt,       "   Moduletree has items in it" );

    my $auth    = $at->{'EUNOXS'};
    my $mod     = $mt->{$modname};

    isa_ok( $auth,              'CPANPLUS::Module::Author' );
    isa_ok( $mod,               'CPANPLUS::Module' );
}

### save state tests
SKIP: {   
    skip "Save state tests for custom engine $ENV{CPANPLUS_SOURCE_ENGINE}", 7
        if $ENV{CPANPLUS_SOURCE_ENGINE};

    ok( 1,                      "Testing save state functionality" );


    ### check we dont have a status set yet
    {   my $mod     = $cb->_module_tree->{$modname};
        ok( !$mod->_status,     "   No status set yet in module object" );
        ok( $mod->status,       "       Status now set" );
    }

    ### now save this to disk
    {   CPANPLUS::Error->flush;

        my $rv = $cb->save_state;
        ok( $rv,                "   State information saved" );
        
        like( CPANPLUS::Error->stack_as_string, qr/Writing compiled source/,    
                                "       Diagnostics confirmed" );
    }
    
    ### now we rebuild the trees from disk and
    ### check if the module object has a status saved with it
    {   CPANPLUS::Error->flush;
        ok( $cb->_build_trees( uptodate => 1, use_stored => 1),
                                "   Trees are rebuilt" );

        like( CPANPLUS::Error->stack_as_string, qr/Retrieving/,    
                                "       Diagnostics confirmed" );

    
        my $mod     = $cb->_module_tree->{$modname};
        ok( $mod->status,       "       Status now set in module object" );
    }  
}

### check custom sources
### XXX whitebox test
SKIP: {   
    ### first, find a file to serve as a source
    my $mod     = $cb->_module_tree->{$modname};
    my $package = File::Spec->rel2abs(
                        File::Spec->catfile( 
                            $FindBin::Bin,
                            TEST_CONF_CPAN_DIR,
                            $mod->path,
                            $mod->package,
                        )
                    );      
       
    ok( $package,               "Found file for custom source" );
    ok( -e $package,            "   File '$package' exists" );

    ### remote uri    
    my $uri      =  $cb->_host_to_uri(
                        scheme  => 'file',
                        host    => '',
                        path    => File::Spec->catfile( dirname($package) )
                    );

    my $expected_file = $cb->__custom_module_source_index_file( uri => $uri );
    
    ok( $expected_file,         "Sources should be written to '$uri'" );
    
    skip( "Index file size too long (>260 chars). Can't write to disk", 28 )
        if length $expected_file > 260 and ON_WIN32;
            

    ### local file 
    ### 2 tests
    my $src_file = $cb->_add_custom_module_source( uri => $uri );
    ok( $src_file,              "Sources written to '$src_file'" );                     
    ok( -e $src_file,           "   File exists" );                     
                     
    ### and write the file  
    ### 5 tests
    {   my $meth = '__write_custom_module_index';
        can_ok( $cb,    $meth );

        my $rv = $cb->$meth( 
                        path => dirname( $package ),
                        to   => $src_file
                    );

        ok( $rv,                "   Sources written" );
        is( $rv, $src_file,     "       Written to expected file" );
        ok( -e $src_file,       "       Source file exists" );
        ok( -s $src_file,       "       File has non-zero size" );
    }              
    
    ### let's see if we can find our custom files
    ### 3 tests
    {   my $meth = '__list_custom_module_sources';
        can_ok( $cb,    $meth );
        
        my %files = $cb->$meth;
        ok( scalar(keys(%files)),
                                "   Got list of sources" );
        
        ### on VMS, we can't predict the case unfortunately
        ### so grep for it instead;
        my $found = map { 
            my $src_re = quotemeta($src_file);
            $_ =~ /$src_re/i;
        } keys %files;

        ok( $found,             "   Found proper entry for $src_file" );
    }        

    ### now we can have it be loaded in
    ### 6 tests
    {   my $meth = '__create_custom_module_entries';
        can_ok( $cb,    $meth );

        ### now add our own sources
        ok( $cb->$meth,         "Sources file loaded" );

        my $add_name = TEST_CONF_INST_MODULE;
        my $add      = $cb->_module_tree->{$add_name};
        ok( $add,               "   Found added module" );

        ok( $add->status->_fetch_from,  
                                "       Full download path set" );
        is( $add->author->cpanid, CUSTOM_AUTHOR_ID,
                                "       Attributed to custom author" );

        ### since we replaced an existing module, there should be
        ### a message on the stack
        like( CPANPLUS::Error->stack_as_string, qr/overwrite module tree/i,
                                "   Addition message recorded" );
    }

    ### test updating custom sources
    ### 3 tests
    {   my $meth    = '__update_custom_module_sources';
        can_ok( $cb,    $meth );
        
        ### mark what time it is now, sleep 1 second for better measuring
        my $now     = time;        
        sleep 1;
        
        my $ok      = $cb->$meth;

        ok( $ok,                    "Custom sources updated" );
        cmp_ok( [stat $src_file]->[9], '>=', $now,
                                    "   Timestamp on sourcefile updated" );    
    }
    
    ### now update it individually
    ### 3 tests    
    {   my $meth    = '__update_custom_module_source';
        can_ok( $cb,    $meth );
        
        ### mark what time it is now, sleep 1 second for better measuring
        my $now     = time;        
        sleep 1;
        
        my $ok      = $cb->$meth( remote => $uri );

        ok( $ok,                    "Custom source for '$uri' updated" );
        cmp_ok( [stat $src_file]->[9], '>=', $now,
                                    "   Timestamp on sourcefile updated" );    
    }

    ### now update using the higher level API, see if it's part of the update
    ### 3 tests    
    {   CPANPLUS::Error->flush;

        ### mark what time it is now, sleep 1 second for better measuring
        my $now = time;        
        sleep 1;
        
        my $ok  = $cb->_build_trees(
                        uptodate    => 0,
                        use_stored  => 0,
                    );
    
        ok( $ok,                    "All sources updated" );
        cmp_ok( [stat $src_file]->[9], '>=', $now,
                                    "   Timestamp on sourcefile updated" );    

        like( CPANPLUS::Error->stack_as_string, qr/Updating sources from/,
                                    "   Update recorded in the log" );
    }
    
    ### now remove the index file;
    ### 3 tests    
    {   my $meth = '_remove_custom_module_source';
        can_ok( $cb,    $meth );
        
        my $file = $cb->$meth( uri => $uri );
        ok( $file,                  "Index file removed" );
        ok( ! -e $file,             "   File '$file' no longer on disk" );
    }
}

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
Commit	Line	Data
6aaee015	1	### make sure we can find our conf.pl file
	2	BEGIN {
	3	use FindBin;
	4	require "$FindBin::Bin/inc/conf.pl";
	5	}
	6
	7	use strict;
	8
4443dd53	9	use Module::Load;
	10	use Test::More eval {
	11	load $ENV{CPANPLUS_SOURCE_ENGINE} if $ENV{CPANPLUS_SOURCE_ENGINE}; 1
	12	} ? 'no_plan'
	13	: (skip_all => "SQLite engine not available");
	14
	15	use CPANPLUS::Error;
6aaee015	16	use CPANPLUS::Backend;
5bc5f6dc	17	use CPANPLUS::Internals::Constants;
6aaee015	18
6aaee015	19	use Data::Dumper;
5bc5f6dc	20	use File::Basename qw[dirname];
6aaee015	21
6aaee015	22	my $conf = gimme_conf();
5bc5f6dc	23	my $cb = CPANPLUS::Backend->new( $conf );
	24
	25	### XXX temp
	26	# $conf->set_conf( verbose => 1 );
6aaee015	27
6aaee015	28	isa_ok($cb, "CPANPLUS::Internals" );
6aaee015	29
6aaee015	30	my $modname = TEST_CONF_MODULE;
6aaee015	31
5bc5f6dc	32	### test lookups
4443dd53	33	{ my $mt = $cb->_module_tree;
	34	my $at = $cb->_author_tree;
	35
	36	### source files should be copied from the 'server' now
	37	for my $name (qw[auth mod dslip] ) {
	38	my $file = File::Spec->catfile(
	39	$conf->get_conf('base'),
	40	$conf->_get_source($name)
	41	);
	42	ok( (-e $file && -f _ && -s _), "$file exists" );
	43	}
	44
	45	ok( $at, "Authortree loaded successfully" );
	46	ok( scalar keys %$at, " Authortree has items in it" );
	47	ok( $mt, "Moduletree loaded successfully" );
	48	ok( scalar keys %$mt, " Moduletree has items in it" );
	49
	50	my $auth = $at->{'EUNOXS'};
5bc5f6dc	51	my $mod = $mt->{$modname};
	52
	53	isa_ok( $auth, 'CPANPLUS::Module::Author' );
	54	isa_ok( $mod, 'CPANPLUS::Module' );
	55	}
	56
4443dd53	57	### save state tests
	58	SKIP: {
	59	skip "Save state tests for custom engine $ENV{CPANPLUS_SOURCE_ENGINE}", 7
	60	if $ENV{CPANPLUS_SOURCE_ENGINE};
	61
	62	ok( 1, "Testing save state functionality" );
	63
	64
	65	### check we dont have a status set yet
	66	{ my $mod = $cb->_module_tree->{$modname};
	67	ok( !$mod->_status, " No status set yet in module object" );
	68	ok( $mod->status, " Status now set" );
	69	}
	70
	71	### now save this to disk
	72	{ CPANPLUS::Error->flush;
	73
	74	my $rv = $cb->save_state;
	75	ok( $rv, " State information saved" );
	76
	77	like( CPANPLUS::Error->stack_as_string, qr/Writing compiled source/,
	78	" Diagnostics confirmed" );
	79	}
	80
	81	### now we rebuild the trees from disk and
	82	### check if the module object has a status saved with it
	83	{ CPANPLUS::Error->flush;
	84	ok( $cb->_build_trees( uptodate => 1, use_stored => 1),
	85	" Trees are rebuilt" );
	86
	87	like( CPANPLUS::Error->stack_as_string, qr/Retrieving/,
	88	" Diagnostics confirmed" );
	89
	90
	91	my $mod = $cb->_module_tree->{$modname};
	92	ok( $mod->status, " Status now set in module object" );
	93	}
	94	}
	95
5bc5f6dc	96	### check custom sources
5bc5f6dc	97	### XXX whitebox test
0fe18d46	98	SKIP: {
0fe18d46	99	### first, find a file to serve as a source
4443dd53	100	my $mod = $cb->_module_tree->{$modname};
5bc5f6dc	101	my $package = File::Spec->rel2abs(
	102	File::Spec->catfile(
	103	$FindBin::Bin,
	104	TEST_CONF_CPAN_DIR,
	105	$mod->path,
	106	$mod->package,
	107	)
	108	);
	109
	110	ok( $package, "Found file for custom source" );
	111	ok( -e $package, " File '$package' exists" );
	112
	113	### remote uri
	114	my $uri = $cb->_host_to_uri(
	115	scheme => 'file',
	116	host => '',
	117	path => File::Spec->catfile( dirname($package) )
	118	);
	119
0fe18d46	120	my $expected_file = $cb->__custom_module_source_index_file( uri => $uri );
	121
	122	ok( $expected_file, "Sources should be written to '$uri'" );
	123
	124	skip( "Index file size too long (>260 chars). Can't write to disk", 28 )
	125	if length $expected_file > 260 and ON_WIN32;
	126
	127
	128	### local file
	129	### 2 tests
5bc5f6dc	130	my $src_file = $cb->_add_custom_module_source( uri => $uri );
	131	ok( $src_file, "Sources written to '$src_file'" );
	132	ok( -e $src_file, " File exists" );
	133
0fe18d46	134	### and write the file
0fe18d46	135	### 5 tests
5bc5f6dc	136	{ my $meth = '__write_custom_module_index';
	137	can_ok( $cb, $meth );
	138
	139	my $rv = $cb->$meth(
	140	path => dirname( $package ),
	141	to => $src_file
	142	);
	143
	144	ok( $rv, " Sources written" );
	145	is( $rv, $src_file, " Written to expected file" );
	146	ok( -e $src_file, " Source file exists" );
	147	ok( -s $src_file, " File has non-zero size" );
	148	}
	149
	150	### let's see if we can find our custom files
0fe18d46	151	### 3 tests
5bc5f6dc	152	{ my $meth = '__list_custom_module_sources';
	153	can_ok( $cb, $meth );
	154
	155	my %files = $cb->$meth;
	156	ok( scalar(keys(%files)),
	157	" Got list of sources" );
5879cbe1	158
	159	### on VMS, we can't predict the case unfortunately
	160	### so grep for it instead;
	161	my $found = map {
	162	my $src_re = quotemeta($src_file);
	163	$_ =~ /$src_re/i;
	164	} keys %files;
	165
	166	ok( $found, " Found proper entry for $src_file" );
5bc5f6dc	167	}
	168
	169	### now we can have it be loaded in
0fe18d46	170	### 6 tests
5bc5f6dc	171	{ my $meth = '__create_custom_module_entries';
5bc5f6dc	172	can_ok( $cb, $meth );
6aaee015	173
5bc5f6dc	174	### now add our own sources
5bc5f6dc	175	ok( $cb->$meth, "Sources file loaded" );
6aaee015	176
5bc5f6dc	177	my $add_name = TEST_CONF_INST_MODULE;
4443dd53	178	my $add = $cb->_module_tree->{$add_name};
5bc5f6dc	179	ok( $add, " Found added module" );
	180
	181	ok( $add->status->_fetch_from,
	182	" Full download path set" );
	183	is( $add->author->cpanid, CUSTOM_AUTHOR_ID,
	184	" Attributed to custom author" );
	185
	186	### since we replaced an existing module, there should be
	187	### a message on the stack
	188	like( CPANPLUS::Error->stack_as_string, qr/overwrite module tree/i,
	189	" Addition message recorded" );
	190	}
	191
	192	### test updating custom sources
0fe18d46	193	### 3 tests
5bc5f6dc	194	{ my $meth = '__update_custom_module_sources';
	195	can_ok( $cb, $meth );
	196
	197	### mark what time it is now, sleep 1 second for better measuring
	198	my $now = time;
	199	sleep 1;
	200
	201	my $ok = $cb->$meth;
	202
	203	ok( $ok, "Custom sources updated" );
	204	cmp_ok( [stat $src_file]->[9], '>=', $now,
	205	" Timestamp on sourcefile updated" );
	206	}
	207
	208	### now update it individually
0fe18d46	209	### 3 tests
5bc5f6dc	210	{ my $meth = '__update_custom_module_source';
	211	can_ok( $cb, $meth );
	212
	213	### mark what time it is now, sleep 1 second for better measuring
	214	my $now = time;
	215	sleep 1;
	216
	217	my $ok = $cb->$meth( remote => $uri );
	218
	219	ok( $ok, "Custom source for '$uri' updated" );
	220	cmp_ok( [stat $src_file]->[9], '>=', $now,
	221	" Timestamp on sourcefile updated" );
	222	}
	223
	224	### now update using the higher level API, see if it's part of the update
0fe18d46	225	### 3 tests
5bc5f6dc	226	{ CPANPLUS::Error->flush;
	227
	228	### mark what time it is now, sleep 1 second for better measuring
	229	my $now = time;
	230	sleep 1;
	231
	232	my $ok = $cb->_build_trees(
	233	uptodate => 0,
	234	use_stored => 0,
	235	);
	236
	237	ok( $ok, "All sources updated" );
	238	cmp_ok( [stat $src_file]->[9], '>=', $now,
	239	" Timestamp on sourcefile updated" );
	240
	241	like( CPANPLUS::Error->stack_as_string, qr/Updating sources from/,
	242	" Update recorded in the log" );
	243	}
	244
	245	### now remove the index file;
0fe18d46	246	### 3 tests
5bc5f6dc	247	{ my $meth = '_remove_custom_module_source';
	248	can_ok( $cb, $meth );
	249
	250	my $file = $cb->$meth( uri => $uri );
	251	ok( $file, "Index file removed" );
	252	ok( ! -e $file, " File '$file' no longer on disk" );
	253	}
	254	}
6aaee015	255
	256	# Local variables:
	257	# c-indentation-style: bsd
	258	# c-basic-offset: 4
	259	# indent-tabs-mode: nil
	260	# End:
	261	# vim: expandtab shiftwidth=4: