view release on metacpan or  search on metacpan

lib/VSGDR/TestScriptGen.pm  view on Meta::CPAN

    
    my $testSet = undef;
    if ( defined $file ) {

        my %ValidParserMakeArgs = ( vb  => "NET::VB"
                                , cs  => "NET::CS"
                                , xls => "XLS"
                                , xml => "XML"
                                ) ;
        my %ValidParserMakeArgs2 = ( vb  => "NET2::VB"
                                , cs  => "NET2::CS"
                                ) ;                          
                                
        #my @validSuffixes       = keys %ValidParserMakeArgs ;
        my @validSuffixes       = map { '.'.$_ } keys %ValidParserMakeArgs ;
        
        my $infile = $file;
        
        my($infname, $directories, $insfx)      = fileparse($infile , @validSuffixes);
        croak 'Invalid input file'   unless defined $insfx ;
        $insfx        = lc $insfx ;
        $insfx        = substr $insfx,1;
        
        ### Validate parameters
        die 'Invalid input file'  unless exists $ValidParserMakeArgs{$insfx} ;
        
        ### Build parsers
        
        my %Parsers            = () ;
        $Parsers{${insfx}}     = VSGDR::UnitTest::TestSet::Representation->make( { TYPE => $ValidParserMakeArgs{${insfx}} } );
        # if input is in a .net language, add in a .net2 parser to the list
        if ( firstidx { $_ eq ${insfx} } ['cs','vb']  != -1 ) {
            $Parsers{"${insfx}2"}  = VSGDR::UnitTest::TestSet::Representation->make( { TYPE => $ValidParserMakeArgs2{${insfx}} } );
        }
        
        ### Deserialise tests 
        eval {
            $testSet         = $Parsers{$insfx}->deserialise($infile);
            } ;
        if ( not defined $testSet ) {
            if ( exists $Parsers{"${insfx}2"}) {
                eval {
                    $testSet     = $Parsers{"${insfx}2"}->deserialise($infile);
                    }
            }            
            else {
                croak 'Parsing failed.'; 
            }
        }
        
    }
    my @existingTests = () ;
    if (defined $testSet) {
        @existingTests = map {$_->testName()}  @{$testSet->tests()};
    }
    
    
    my $database        = databaseName($dbh);

    no warnings;
    my $userName                        = $OSNAME eq 'MSWin32' ? eval('Win32::LoginName') : ${[getpwuid( $< )]}->[6]; $userName =~ s/,.*//;
    use warnings;
    my $date            = strftime "%d/%m/%Y", localtime;
#warn Dumper $userName ;    
#warn Dumper $ra_columns ;
#exit ;

    my $execs           = ExecSp($dbh) ;

#warn Dumper     $widest_column_name_padding;

    foreach my $exec (@$execs) {
        
        my $ofile = $$exec[0];
        
        (my $fileName = "${ofile}" ) =~ s{[.]}{_} ;
        $fileName =~ s{[\]\[]}{}g ;
        $fileName =~ s{\s}{}g ;
        my $testName = $fileName;

        # if not already defined in the test file (if given)
        if ( (firstidx { $_ eq $testName } @existingTests ) == -1 ) {


            my $checkText    = "";
            my $receivingTable = "" ; 
    
            if ( $runChecks ) {
            
                $checkText    = CheckForExceptions($dbh, $dbh_typeinfo, $$exec[0], $userName, $date, $$exec[1],$$exec[2] ) ;
    
                my $resultsTable = undef ;
                if ( ! defined $checkText || $checkText eq q() ) {
                    $resultsTable = CheckForResults($dbh, $dbh_typeinfo, $$exec[0], $userName, $date, $$exec[1],$$exec[2] ) ;
                }
    #warn Dumper "--------------------------";            
    #warn Dumper $resultsTable;
    #warn Dumper scalar @$resultsTable ;
    #warn Dumper @{$resultsTable->[0]};
                if (defined $resultsTable && scalar @$resultsTable eq 1  && scalar @{$resultsTable->[0]} gt 0 ) {
                    $receivingTable = do { local $"= "\n\t,\t\t" ; "\tdeclare \@ResultSet table\n\t(\t\t@{$resultsTable->[0]} \n\t)" } ;
    #                $receivingTable = do { local $"= "\n\t,\t\t" ; "@{$resultsTable->[0]}" } ;
                }
                #elsif (scalar @$resultsTable gt 1 ) {
                #    $receivingTable = "More than one set of results - can't capture them" } ;
                #}
    #warn Dumper $receivingTable ;         
    #warn Dumper $$exec[2];
            } ;
    
            my $text = Template($dbh, $dbh_typeinfo, $$exec[0], $userName, $date, $$exec[1],$$exec[2],$checkText,$receivingTable ) ;
            $fileName .= ".sql";
        
            my $fh   = IO::File->new("> ${dirs}/${fileName}") ;
        
            if (defined ${fh} ) {
                print {${fh}} $text ;
                $fh->close;
            }
            else {
                croak "Unable to write to ${ofile}.sql.";