view release on metacpan or  search on metacpan

t/test.pl  view on Meta::CPAN

		while(my $f=readdir($dd)) {
			next unless $f=~/\.xsd$/;
			my $fullname=catfile($testdir,$f);
			next if -l $fullname;
			next if -d $fullname;
			next unless -r $fullname;
			push @files,$f;
		}
		closedir $dd;
		return @files if scalar(@files) < 2;
		for my $f(@files) {
			my $fullname=catfile($testdir,$f);
			if (open(my $fd,'<',$fullname)) {
				$schemas{$f}=1 unless exists $schemas{$f};
				while(<$fd>) {
					if (/<!--\s+ROOT_SCHEMA\s+/) {
						close $fd;
						return ($f);
					}
					$schemas{$1}=0 if /include\s+schemaLocation="([^"]+)"/;
					$schemas{$1}=0 if /import\s+.*\s+schemaLocation="([^"]+)"/;
				}
				close $fd;
			}
			else {
				print STDERR "$fullname: $!\n";
			}
		}
	}
	else {
		print STDERR "$testdir: $!\n"; 
	}
	grep($schemas{$_},keys %schemas);
}

###### main ####

unless (getopts ('hac:df:int:sv:xDFLTV',\%Opt)) {
	 print STDERR "invalid option or option not set\n";
	 exit 1;
}

if ($Opt{h}) {
	print STDOUT basename($0).
q{  [<options>] [<args>].. 
    exec battery test 
<options>: 
    -h  - this help
    -a - display the know namespaces and exit  
    -c <connstr> - connect string to database - the default is the value of the env var DB_CONNECT_STRING
        otherwise is an error
        the form is  [<output_namespace>::]<dbtype>:<user>/<password>@<dbname>[:hostname[:port]][;<attribute>[,<attribute>...]]
        <output_namespace>::<dbtype> - see the output with 'a' option set 
            the default for <output_namespace> is 'sql'
        <dbname> - database name 
        <hostname> - remote host name or ip address 
        <port> - remote host port
        <attribute> - extra attribute
        Examples: 
            sql::pg:user/pwd@mydb:127.0.0.1;RaiseError => 1,AutoCommit => 0,pg_enable_utf8 => 1
            sql::mysql:user/pwd@mydb:127.0.0.1;RaiseError => 1,AutoCommit => 0,mysql_enable_utf8 => 1
            sql::oracle:user/pwd@orcl:neutrino:1522;RaiseError => 1,AutoCommit => 0
            sql::DBM:dbm_mldbm=Storable;RaiseError => 1,f_dir=> q(/tmp) 
    -d  - debug mode
    -f   <filename>[,<filename>...] - include in test only file match <filename>
    -i  - incremental test
    -n  - continue after xml difference
    -t  <c|r|C|R> - transaction database mode ((c)ommit for single test, (r)ollback for single test,(C)ommit global,(R)ollback global) - default c
    -s  - stop on first error
    -v  <command> - use <command> for xml validation
            use %f for xml file tag and %s for schema (xsd) file tag
            the default is 'xmllint -schema %s %f'
    -x  - use xml_repo.pl for test
    -F  - do not drop the repository on the end of tests
    -L  - do not load from repository the schema
    -T  - clean temporary files in test + step files and not execute the test
    -V  - not test the views
    -D  - do not delete rows after write xml
arguments>:
    <testnumber>|<testnumber>-<testnumber>...
    if <testnumber> is not spec all tests can be executed
    if the test is OK the database is cleaned (see option -F)
}; 
    exit 0;
}

if (-t *STDERR) { ## no critic
	eval { require  Term::ANSIColor;Term::ANSIColor->import };

}

sub my_color {
	color @_;
}


if ($Opt{a}) {
	for my $k(qw(c f i n t s v x L F T V D)) {
		print STDERR  "(W) Option '$k' is ignored is active option 'a'\n" if delete $Opt{$k};
	}
	for my $s(blx::xsdsql::schema_repository::get_namespaces) {
			print $s,"\n";
	}
	exit 0;
}

if ($Opt{T}) {
	for my $k(qw(c f i n t s v x L V D)) {
		print STDERR  "(W) Option '$k' is ignored is active option 'T'\n" if delete $Opt{$k};
	}
	$Opt{F}=1;
}

if ($Opt{x}) {
	for my $k(qw(L t)) {
		print STDERR "(W) Option '$k' is ignored is active option 'x'\n" if delete $Opt{$k};
	}
}


$Opt{t}='c' unless defined $Opt{t};