Subversion Repositories DevTools

#!/usr/bin/perl -w

########################################################################

# Copyright (C) 2008 ERG Limited, All rights reserved

#

# Module name   : test_schemadump.pl

# Module type   : Stand alone unit test program

# Compiler(s)   : n/a

# Environment(s): windows (dos), unix (solaris and linux)

#

# Description   : Runs schemadump.pl and then ddlfile.pl and

#                 checks that no information is lost.

#

# History       : Created by Haydon Knight May 2008

#

# Usage         : test_schemadump.pl [options]

#

########################################################################

#######################################################################

# Use lines

#######################################################################

require 5.6.1;

use strict;

use warnings;

use Pod::Usage;                             # required for help support

use Getopt::Long;

use File::Path;

#######################################################################

# Function prototypes

#######################################################################

sub parseCommandLine();

sub startupChecks();

sub main();

sub quoteCommand(@);

sub readLines($);

sub cleanup();

sub runCommand($@);

sub logprint($);

sub hchomp;

sub finish($$);

#######################################################################

# Constant global variables

#######################################################################

my $VERSION = "1.0.1";

my $UNIX = ($ENV{'OS'} && $ENV{'OS'} =~ m/win/i) ? 0 : 1;

my $dotdat = $UNIX ? "../" : "..\\";

my $scriptsDir = $0;

$scriptsDir = $dotdat unless $scriptsDir =~ m~[/\\]~;

$scriptsDir =~ s~(.*[\\/]).*~$1$dotdat~ if( $scriptsDir =~ m~[/\\]~ );

my $ddlFile = "release_manager.ddl";

my $tmpDir = ($UNIX ? "/tmp" : "C:/temp");

my $unpackDir = "$tmpDir/test_schemadump";

my $repackFile = "$tmpDir/test_schemadump.results";

my $unpackLogFile = "$tmpDir/test_schemadump.log1";

my $repackLogFile = "$tmpDir/test_schemadump.log2";

#######################################################################

# Other global variables

#######################################################################

my $verbose = 0;

my $logFile;

#######################################################################

# Main code

#######################################################################

parseCommandLine();

startupChecks();

main();

finish(0,"");

#######################################################################

# Function definitions

#######################################################################

#-------------------------------------------------------------------------------

# Function  : quoteCommand

#

# Purpose   : Quotes its arguments

#

# Arguments : @words (i) - words to be surrounded by double quotes

#

# Returns   : $quotedCommand - words quoted and joined

#

# Notes     :

#

sub quoteCommand(@)

{

    my @words = @_;

    my $quotedCommand;

    foreach my $word (@words)

    {

        $quotedCommand .= qq("$word" );

    }

    return $quotedCommand;

}

#-------------------------------------------------------------------------------

# Function  : finish

#

# Purpose   : Prints a statement indicating success/failure and exits

#

# Arguments : $exitVal (i) - Exit value (0 for success, anything else for failure)

#             $msg (i) - Message to print out, if any

#

# Returns   : none

#

# Notes     : Closes log and cleans up

#

sub finish($$)

{

    my ($exitVal, $msg) = @_;

    print STDERR $msg if $msg;

    cleanup();

    my $str = ( ($exitVal == 0) ? "was successful!" : "failed!" );

    print "test_schemadump.pl test $str\n";

    close LOGFILE if $logFile;

    exit( $exitVal );

}

#-------------------------------------------------------------------------------

# Function  : parseCommandLine

#

# Purpose   : Parses command line

#

# Arguments : none

#

# Returns   : none

#

# Notes     : 

#

sub parseCommandLine()

{

    my $opt_help = 0;

    my $opt_manual = 0;

    my $result = GetOptions (

    "help"          => \$opt_help,              # flag

    "manual"        => \$opt_manual,            # flag

    "verbose+"      => \$verbose,               # flag

    "log=s"         => \$logFile,               # String

    );

    pod2usage(-verbose => 2) if( $opt_manual );

    pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help > 0 || ! $result );

}

#-------------------------------------------------------------------------------

# Function  : startupChecks

#

# Purpose   : Makes sure scripts are available and does other general sanity tests

#

# Arguments : none

#

# Returns   : none

#

# Notes     : 

#

sub startupChecks()

{

    finish( -1, "Could not open logfile '$logFile'\n")

        if( $logFile && !open( LOGFILE, ">$logFile") );

    $logFile    =~ s~\\~/~g if $logFile;

    finish( -1, "DDL file '$scriptsDir/test/$ddlFile' not found\n") unless -e "$scriptsDir/test/$ddlFile";

    finish( -1, "Don't put spaces in your DDL filename!\n")

        if( $ddlFile =~ m/\s/ );

    finish( -1, "Could not find schemadump.pl in ${scriptsDir}schemadump.pl\n") unless -e "${scriptsDir}schemadump.pl";

    finish( -1, "Could not find ddlfile.pl in ${scriptsDir}ddlfile.pl\n")    unless -e "${scriptsDir}ddlfile.pl";

}

#-------------------------------------------------------------------------------

# Function  : readLines

#

# Purpose   : Reads in the lines of a file into an array

#

# Arguments : $filename (i) - Filename to parse lines from

#

# Returns   : @lines - lines of the file

#

# Notes     : Strips out new line characters and skips over whitespace lines

#

sub readLines($)

{

    my ($filename) = @_;

    my @lines;

    open( F, $filename) or finish( -1, "Could not open '$filename' for reading\n");

    while( <F> )

    {

        next if m~^\s*$~;

        s~[\n\r]+$~~;

        push @lines, $_;

    }

    close( F );

    return @lines;

}

#-------------------------------------------------------------------------------

# Function  : cleanup

#

# Purpose   : Makes sure the temporary files used by this script are removed from

#             the file system.

#

# Arguments : $unpackDir (gi) - A directory to recursively remove

#             $repackFile (gi) - Reconstructed DDL file to remove

#             $repackLogFile (gi) - Log file for ddlfile.pl to remove

#             $unpackLogFile (gi) - Log file for schemadump.pl to remove

#

# Returns   : nothing

#

# Notes     : Calls die() as cleanup is called by finish()

#

sub cleanup()

{

    rmtree $unpackDir if -e $unpackDir;

    unlink $repackFile if -e $repackFile;

    unlink $unpackLogFile if -e $unpackLogFile;

    unlink $repackLogFile if -e $repackLogFile;

    die "Couldn't remove directory '$unpackDir'\n" if -e $unpackDir;

    die "Couldn't remove file '$repackFile'\n" if -e $repackFile;

    die "Couldn't remove file '$repackLogFile'\n" if -e $repackLogFile;

    die "Couldn't remove file '$unpackLogFile'\n" if -e $unpackLogFile;

}

#-------------------------------------------------------------------------------

# Function  : main

#

# Purpose   : Provides scope

#

# Arguments : none

#

# Returns   : none

#

# Notes     : Does all the real work of this script

#

sub main()

{

    cleanup();

    finish( -1, "Could not create temp directory '$unpackDir'\n") unless mkdir $unpackDir;

    #

    # Create the directory structure and the reconstructed DDL file

    #

    if( $UNIX )

    {

        runCommand "cd $scriptsDir;./schemadump.pl -src=test/$ddlFile -dest=$unpackDir -log=$unpackLogFile -verbose";

        runCommand "cd $scriptsDir;./ddlfile.pl -src=$unpackDir -dest=$repackFile -log=$repackLogFile -verbose";

    }

    else

    {

        runCommand "chdir $scriptsDir & schemadump.pl -src=test/$ddlFile -dest=$unpackDir -log=$unpackLogFile -verbose";

        runCommand "chdir $scriptsDir & ddlfile.pl -src=$unpackDir -dest=$repackFile -log=$repackLogFile -verbose";

    }

    my @origLines = readLines( "$scriptsDir/test/$ddlFile" );

    my @newLines  = readLines( $repackFile );

    #

    # Now, check that the two DDL files have the same information content

    #

    for( my $i = 0; $i < scalar(@origLines); $i++)

    {

        finish( -1, "Ran out of new lines at line $i\n") if( scalar(@newLines) < $i );

        finish( -1, "Line $i is the first line to differ\n") if( $origLines[$i] ne $newLines[$i] );

    }

    finish( -1, "Originally there were only " . scalar(@origLines)

        . " non-blank lines; now there are " . scalar(@newLines) . "\n")

        if( scalar(@newLines) > scalar(@origLines) );

}

#-------------------------------------------------------------------------------

# Function  : runCommand

#

# Purpose   : Runs a command in the shell

#

# Arguments : $cmd (i) - command to run.  Basically this is all arguments that should

#                        not be quoted.

#             @args (i) - additional arguments.  These are all quoted, so be careful

#                         when passing in wildcard arguments.

#

# Returns   : The shell stdout output of the command

#

# Notes     :

#

sub runCommand($@)

{

    my ($cmd, @args) = @_;

    my $fullCmd = $cmd;

    $fullCmd .= " " . quoteCommand(@args) if @args;

    logprint "Running command '$fullCmd'";

    return hchomp `$fullCmd`;

}

#-------------------------------------------------------------------------------

# Function  : logprint

#

# Purpose   : Prints comments

#

# Arguments : $s (i) - string to be printed

#

# Returns   : nothing

#

# Notes     : Prints to screen if verbose

#             Prints to log if logfile specified on command line

#

sub logprint($)

{

    my ($s) = @_;

    $s =~ s~[\n\r]$~~;

    print "Log: $s\n" if( $verbose );

    print LOGFILE "Log: $s\n" if( $logFile );

}

#-------------------------------------------------------------------------------

# Function  : hchomp

#

# Purpose   : Remove newline characters from the end of a string

#

# Arguments : A single string, or an array of strings

#

# Returns   : Input without newline characters

#

# Notes     :

#

sub hchomp

{

    return @_ unless @_;

    my @stuff = @_;

    foreach my $a (@stuff)

    {

        $a =~ s~[\n\r]+$~~;

    }

    return ( (scalar(@stuff) == 1) ? $stuff[0] : @stuff );

}

#######################################################################

# Documentation

#######################################################################

=pod

=head1 NAME

test_schemadump.pl - unit test for schemadump.pl and ddlfile.pl

=head1 SYNOPSIS

test_schemadump.pl [options]

Options:

  -help              - brief help message

  -man               - Full documentation

  -log=logFile       - Log messages to this file

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=item B<-log=logFile>

Specify a file to write log messages to.  Default is to just write

to the terminal.

=back

=head1 DESCRIPTION

This script is used to unit test schemadump.pl and ddlfile.pl.

It does this by running schemadump.pl to create a directory

structure, then running ddlfile.pl to recreate the input

DDL file.  This recreated file is compared with the original

input file to schemadump.pl and a check is performed to ensure

that no information is lost.

=cut