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