Subversion Repositories DevTools

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : JatsSignatureBuilder.pm
# Module type   : JATS Utility
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Generate a PAckage signature
#
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

package JatsSignatureBuilder;

use JatsError;
use FileUtils;
use JatsVersionUtils;
use JatsEnv;
use JatsSystem;
use ArrayHashUtils;
use BuildName;

use Digest::SHA::PurePerl qw(sha1);
use IPC::Open3;
use File::Path;

#-------------------------------------------------------------------------------
# Function        : GeneratePackageSignature 
#
# Description     : Generate a package 'signature' for this package
#               
#                   The signature is used to bypass the entire Make processing in a sandbox
#                   If we can find a matching package in the package store then we don't 
#                   need to 'make' this package.
#
#                   There are two scenarios:
#                       In a GIT enabled sandbox
#                       Without GIT
#                       
#                   In a GIT enabled sandbox the signature allows the use of a pre-built 
#                   package - even if the package has been built on a different branch.
#                   
#                       The signature includes:
#                           The name of this package
#                           The GIT sha1 of the directory trees that contain this package
#                           The package signatures of all dependent packages
#                           
#                   In a Non-GIT enabled sandbox the package signature will be set such that
#                   the package will never be found in the package store and the package MUST
#                   be built within the sandbox.
#                   
#                   The hard part is determing the directory trees that contains this package
#                   Ideally this is a single dir-tree, but this cannot be enforced.
#                   
#                   Source directories have been gathered during makefile generation
#                   
#                   This suits most cases, but there are a few where the user needs
#                   to give JATS a hint. Use the AsdSrcDir directive to extend
#                   the signature paths to directories not under the build.pl
#                   or any makefile included by the build.pl
#                   
#                   The generated file will be held in the sandbox directory.
#
# Inputs          : $pkgBase        - Path to the package's build file
#                   $outPath        - Base of path to create signature files 
#
# Returns         : The package signature
#
sub GeneratePackageSignature
{
    my ($pkgBase, $outPath) = @_;
    my %sigExcludeDirs;
    my %sigExcludeFiles;
    my $BuildSignatureSha1;
    my $BuildSignature;
    my @sigList;
    my $sigText;

    Error ("No directory specified") unless $pkgBase;
    Error ("Not a directory: $pkgBase") unless -d $pkgBase;

    my $parsedInfo = JatsParser::processBuild ($pkgBase);
    #DebugDumpData("GeneratePackageSignature::parsedInfo", $parsedInfo);
    Error ('BuildName not found') unless exists $parsedInfo->{BuildName};

    #
    #   Determine the saved locations for the output files
    #
    mkpath ( $outPath ) unless -d $outPath;
    my $signatureFile = CatPaths($outPath, 'Package.sig');
    my $sigDebugFile  = CatPaths($outPath, 'Package.dsig');

    #
    #   Determine if this is a GIT enabled sandbox build
    #   Need a .git directory or file in the root of the sandbox
    #
    my $gitEnabled;
    if ($::GBE_SANDBOX && -e CatPaths ($::GBE_SANDBOX, '.git') ) {
        $gitEnabled = 1;
    }

    #
    #   Start generating the signature
    #       Include the package Name, Version and Project
    #
    $BuildSignatureSha1 = Digest::SHA::PurePerl->new;
    $sigText = "PKGNAME: " . join (' ', @{$parsedInfo->{BuildName}} );

    $BuildSignatureSha1->add( $sigText );
    push @sigList, $sigText . ": " . $BuildSignatureSha1->clone->hexdigest;

    #
    #   Include the signature of ALL dependent packages
    #   Ie: The package signature is a function of the source and its dependents
    #   Assume that we are starting with a sorted list
    #
    foreach my $tag ( @{$parsedInfo->{PkgList}} )
    {
        my ($pname, $pversion) = split ($;, $tag);
        my $pkgSig = getPackageSignature($pname, $pversion);
        $BuildSignatureSha1->add("PKGSIGNATURE: $pkgSig");
        push @sigList, sprintf("PKGSIGNATURE: [%s %s] %s: %s", $pname, $pversion, $pkgSig , $BuildSignatureSha1->clone->hexdigest);
    }

    if ($gitEnabled)
    {
        #
        #   Include the sha1 of all 'git' tree items that form the complete source image
        #   Warn user if not all components are version controlled
        #
        my @relDirList = @{$parsedInfo->{DirList}}; 
        my @cmdList = map { 'HEAD:' . $_ . '/'  } @relDirList;
        Debug3(" GIT CMD: " . "git rev-parse", @cmdList );
#DebugDumpData("parsedInfo",$parsedInfo);
        #
        #   Generate a 'nice' array of display paths used
        #   The display path will be used simply to report the location in the debug of the package signature
        #   The display path is relative to the base of the sandbox
        #
        my @absDirList = map { RelPath(FullPath( $_ ),$::GBE_SANDBOX) } @relDirList;

        #
        #   Callback function to process the output of the Git parse
        #   Expect one line for each HEAD: item
        #
        my $index = 0;
        my @notControlled;
        my $callback = sub {
            my ($cdata, $gitShar) = @_;
            $gitShar =~ s~\s+$~~;
            Debug3(" GIT OUT: " . $gitShar  );
            if ($gitShar =~ m~^HEAD:(.*)~) {
                push @notControlled, $1;
                $gitShar = 'MSG: Not version controlled';
            }
            $BuildSignatureSha1->add($gitShar);
            push @sigList, "PKGSRC: $absDirList[$index++]: $gitShar: " . $BuildSignatureSha1->clone->hexdigest;
            return 0;
        };

        my $rv = GitCmd('rev-parse', @cmdList, { process => $callback } );
        Debug2("GitCmd Result: $rv");
        $BuildSignature =  $BuildSignatureSha1->hexdigest;

        if (@notControlled) {
            Warning('The following paths are not version controlled:', @notControlled);
        }
    }
    else
    {
        $BuildSignature = 'MSG: Sandbox is not git enabled';
    }

    Message("Signature: $BuildSignature");
    push @sigList, "Signature: $BuildSignature";
    FileCreate( $signatureFile, $BuildSignature );
    FileCreate( $sigDebugFile, @sigList );
Debug0("sigDebugFile: $sigDebugFile");

    return $BuildSignature;
}

#-------------------------------------------------------------------------------
# Function        : getPackageSignature 
#
# Description     : Helper routine 
#                   Given a package name and package version determine the package
#                   signature.
#                   
#                   Can used predetermined data or perform a package repo scan
#                   
#                   This version assumes that we are buildign within a jats sandbox
#                   Each packages signature file Package.sig is stored in the packages
#                   interface directory (at the moment).
#                   
#                   Process:
#                       Locate the packages interface directory - we have a link file to it
#                       Read in the PAckage Signature file
#
# Inputs          : $pname      - Package Name
#                   $pversion   - Package Version
#                   $mode       - Optional. true -> do not error if not found
#
# Returns         : The package signature. Undefined if the package canot be found
#                    
sub getPackageSignature
{
    my ($pname, $pversion, $mode ) = @_;
    my $prj = '';
    my $pkg;
    my $version;
    my $pkgSig;

    # 
    #   We are in a sandbox and expect to find a interface/Package.sig file
    #   This will allow us to locate the package in the package store
    #   
    #   If there is no interface/Package.sig, then the user must build (not make)
    #   the package in the sandbox.
    #   
    #   ie: the interface/Package.sig file allows us to use the package from package cache
    #       or indicates that the user has not yet built the package
    #       
    #   First locate the packages interface directory
    #   We have a nice link from the sandbox to assist in this
    #
    my ($pn, $pv, $ps ) = SplitPackage ($pname, $pversion );
    $version = 'sandbox';
    $prj = '.' . $ps if ( $ps ); 
    $version .= $prj;
     
    my $ifaceDir = CatPaths($::GBE_SANDBOX, 'sandbox_dpkg_archive', $pname, $version . '.int');
    $ifaceDir = TagFileRead($ifaceDir);
    $ifaceDir =~ s~\\~/~g;
    $ifaceDir =~ s~GBE_SANDBOX/~$::GBE_SANDBOX/~;
    my $pkgSigFile = CatPaths( $ifaceDir, 'Package.sig');

    if ( -f $pkgSigFile)
    {
#Debug0("$pname, $pversion --> $pkgSigFile");
        $pkgSig = TagFileRead($pkgSigFile);
        Error("Package signature invalid for $pname/$version", "Signature: $pkgSig") 
            if((length($pkgSig) != 40) && $pkgSig !~ m~^MSG:~) ;
    }
    else
    {
        Error("Package signature not found for $pname/$version", "You must 'build' the package before using it") unless $mode;
    }

    return $pkgSig;
}

#-------------------------------------------------------------------------------
# Function        : GitCmd
#
# Description     : Run a Git Command and capture/process the output
#
#                   Based on JatsSvnCore:SvnCmd
#
# Inputs          : Command
#                   Command arguments
#                   Last argument may be a hash of options.
#                       nosavedata  - Don't save the data
#                       process     - Callback function
#                       printdata   - Print data
#                       error       - Error Message
#                                     Used as first line of an Error call
#
# Returns         : non-zero on errors detected
#
sub GitCmd
{
    my $self;           # Local storage
    Debug ("GitCmd");

    #
    #   Locate essential tools
    #
    our $GBE_SVN_PATH;
    EnvImportOptional('GBE_GIT_PATH', '');
    Debug ("GBE_GIT_PATH", $::GBE_GIT_PATH);

    my $stdmux = LocateProgInPath ( 'stdmux');
    my $git    = LocateProgInPath ( 'git', '--All', '--Path=' . $::GBE_GIT_PATH );
    
    #
    #   Extract arguments and options
    #   If last argument is a hash, then its a hash of options
    #
    my $opt;
    $opt = pop @_
        if (@_ > 0 and UNIVERSAL::isa($_[-1],'HASH'));

    $self->{PRINTDATA} = $opt->{'printdata'} if ( exists $opt->{'printdata'} );

    Verbose2 "GitCmd $git @_";

    #
    # Useful debugging
    #
    # $self->{LAST_CMD} = [$svn, @_];

    #
    #   Reset command output data
    #
    $self->{ERROR_LIST} = [];
    $self->{RESULT_LIST} = [];
#    $self->{LAST_CMD} = \@_;

    #
    #   Make use of a wrapper program to mux the STDERR and STDOUT into
    #   one stream (STDOUT). #   This solves a lot of problems
    #
    #   Do not use IO redirection of STDERR because as this will cause a
    #   shell (sh or cmd.exe) to be invoked and this makes it much
    #   harder to kill on all platforms.
    #
    #   Use open3 as it allows the arguments to be passed
    #   directly without escaping and without any shell in the way
    #
    local (*CHLD_OUT, *CHLD_IN);
    my $pid = open3( \*CHLD_IN, \*CHLD_OUT, '>&STDERR', $stdmux, $git, @_);

    #
    #   Looks as though we always get a PID - even if the process dies
    #   straight away or can't be found. I suspect that open3 doesn't set
    #   $! anyway. I know it doesn't set $?
    #
    Debug ("Pid: $pid");
    Error ("Can't run command: $!") unless $pid;

    #
    #   Close the input handle
    #   We don't have anything to send to this program
    #
    close(CHLD_IN);

    #
    #   Monitor the output from the utility
    #   Have used stdmux to multiplex stdout and stderr
    #
    #   Note: IO::Select doesn't work on Windows :(
    #   Note: Open3 will cause blocking unless both streams are read
    #         Can't read both streams because IO::Select doesn't work
    #
    #   Observation:
    #       svn puts errors to STDERR
    #       svn puts status to STDOUT
    #
    while (<CHLD_OUT>)
    {
        s~\s+$~~;
        tr~\\/~/~;


        Verbose3 ( "GitCmd:" . $_);
        m~^STD(...):(.+)~;
        my $data = $1 ? $2 : $_;
        next unless ( $data );

        if ( $1 && $1 eq 'ERR' )
        {
            #
            #   Process STDERR output
            #
            push @{$self->{ERROR_LIST}}, $data;
        }
        else
        {
            #
            #   Process STDOUT data
            #
            push @{$self->{RESULT_LIST}}, $data unless ($opt->{'nosavedata'});

            #
            #   If the user has specified a processing function then pass each
            #   line to the specified function.  A non-zero return will
            #   be taken as a signal to kill the command.
            #
            if ( exists ($opt->{'process'}) && $opt->{'process'}($self, $data) )
            {
                kill 9, $pid;
                sleep(1);
                last;
            }
        }
    }

    close(CHLD_OUT);

    #
    #   MUST wait for the process
    #   Under Windows if this is not done then we eventually fill up some
    #   perl-internal structure and can't spawn anymore processes.
    #
    my $rv = waitpid ( $pid, 0);

    #
    #   If an error condition was detected and the user has provided
    #   an error message, then display the error
    #
    #   This simplifies the user error processing
    #
    if ( @{$self->{ERROR_LIST}} && $opt->{'error'}  )
    {
        Error ( $opt->{'error'}, @{$self->{ERROR_LIST}} );
    }

    #
    #   Exit status has no meaning since open3 has been used
    #   This is because perl does not treat the opened process as a child
    #   Not too sure it makes any difference anyway
    #
    #
    Debug ("Useless Exit Status: $rv");
    my $result = @{$self->{ERROR_LIST}} ? 1 : 0;
    Verbose3 ("Exit Code: $result");

    return $result;
}


###############################################################################
#   Internal Package
#   Primarily to hide the use of the AUTOLOAD
#       Which still doesn't behave as expected
#       Have trouble with $self in AUTOLOAD. Its not appearig as an argument.
#   
package JatsParser;
use strict;
use warnings;

my $currentClass;
our $ProjectBase;
our $ScmRoot;

#-------------------------------------------------------------------------------
# Function        : JatsParser::processBuild 
#
# Description     : Process the build.pl file and associated makefile.pl's
#                   A static-ish method to do all of the hard work.
#
# Inputs          : $buildPath  - Path to the build file
#
# Returns         : A few globals 
#
sub processBuild
{
    my ($baseDir) = @_;
    my @AllSubDirs;

    #
    #   Process the build.pl file
    #
    my $filename = ::CatPaths($baseDir, 'build.pl');
    ::Error ("Build file not found : $filename") unless -f $filename;
    $baseDir = ::RelPath(::FullPath ($baseDir));
    my $buildParser = newJatsParser();
    $buildParser->parseFile($baseDir , 'build.pl');

    #DebugDumpData("parser", $parser);

    #
    #   If no source subdirs where specified in the build file then insert the  default one
    #   This is the same action as perform by jats build
    #
    if ( ! defined $buildParser->{SubDirs}) {
        push @{$buildParser->{SubDirs}}, ::CatPaths($baseDir, 'src');
    }

    #
    #   If the 'common' makefile exists then parse it as well
    #
    my $commonMakefile = ::CatPaths($baseDir, 'makefile.pl');
    unless ( -f $commonMakefile) {
        $commonMakefile = undef;
    }

    #
    #   Add the build path to the list of known subdirectories
    #
    @AllSubDirs = $baseDir;

    #
    #   Process all subdirs
    #       Order is not important - in this case
    #
    my @SubDirs = @{$buildParser->{SubDirs}};
    my $parser = newJatsParser($baseDir, $commonMakefile);
    while (@SubDirs)
    {
        my $makeDir = ::CleanDirName(pop @SubDirs);

        @{$parser->{SubDirs}} = ();
        $parser->parseFile($makeDir, 'makefile.pl');

        push @SubDirs, @{$parser->{SubDirs}} if (defined $parser->{SubDirs});
        ::UniquePush (\@AllSubDirs, $makeDir);
    }

    my @AllInclude = @{$parser->{Includes}} if defined $parser->{Includes};

    #
    #   Generate a list of root directories used by the package
    #   ie: want top level directories only and not subdirectories
    #
    my @PackageDirs = generateMinDirList(@AllSubDirs, @AllInclude);

    #
    #   Generate a list of all the external packages
    #   Don't sort the list. Order may be important
    #   
    my @AllPackages = ();
    push @AllPackages, @{$buildParser->{PkgList}} if (defined $buildParser->{PkgList});

    #
    #   Prepare a structure to be returned
    #   
    my $data;
    $data->{BuildName} = $buildParser->{BuildName};
    $data->{BaseDir} = $baseDir; 
    $data->{PkgList} = \@AllPackages;
    $data->{DirList} = \@PackageDirs;
    return $data;
}

#-------------------------------------------------------------------------------
# Function        : generateMinDirList 
#
# Description     : Generate a list of root directories used by the package
#                   ie: want top level directories onyl and not subdirectories
#  
#
# Inputs          : A list of paths to process
#
# Returns         : A list of processed paths 
#
sub generateMinDirList
{
    #
    #   Convert all to absolute paths
    #
    my @baseList;
    foreach  (@_) {
        push @baseList, ::FullPath($_);
    }
    

    #   Process the complete list to remove subdirectories
    #   Process is:
    #       Sort list. Will end up with shortest directories first, thus subdirs will follow parents
    #       Insert each item into a new list iff it is not a subdir of something already in the list
    #
    my @dirList = sort {uc($a) cmp uc($b)} @baseList;
    
    my @newlist; 
    foreach my $newItem ( @dirList ) {
        my $match = 0;
        foreach my $item ( @newlist ) {
            if (index ($newItem, $item) == 0) {
                $match = 1;
                last;
            }
        }
        push @newlist, $newItem if (! $match);
   }

   #
   #   Convert back to relative paths
   #
   @baseList = ();
   foreach ( @newlist ) {
       push @baseList, ::RelPath($_);
   }

   return @baseList;
}

#-------------------------------------------------------------------------------
# Function        : AUTOLOAD
#
# Description     : Intercept and process user directives
#                   It does not attempt to distinguish between user errors and
#                   programming errors. It assumes that the program has been
#                   tested. 
#
# Inputs          : Original function arguments (captured)
#
#
our $AUTOLOAD;
sub AUTOLOAD
{
    #
    #   Don't respond to class destruction
    #
    return if our $AUTOLOAD =~ /::DESTROY$/;

    my $self = $currentClass;
    my $type = ref ($self) || ::Error("$self is not an object");

    my $args = ::JatsError::ArgsToString( \@_);
    my $fname = $AUTOLOAD;
    $fname =~ s~^\w+::~~;
    my ($package, $filename, $line) = caller;

    #
    #   If directive is inlined
    #   Replace it with the raw text of the directive
    #       Really only for display purposes
    #
    if ($fname eq 'If')
    {
        return $fname . '(' . join( ',', map { qq/"$_"/ } @_ ) . ')' ;
    }

    #
    #   Capture  and process some directives
    #
    my %directives = ( AddIncDir => 1, 
                       AddSrcDir => 1, 
                       AddDir => 1, 
                       AddLibDir => 1,
                        
                       LinkPkgArchive => 2, 
                       BuildPkgArchive => 2,

                       BuildName => 3,
                        
                       SetProjectBase  => 4,

                       SubDir => 5,
                       BuildSubDir => 5,

                       );

    if ($directives{$fname})
    {
#        ::Debug0 ("Directive: $fname( $args );", "File: $filename, Line: $line, Mode: $directives{$fname}" );

        #   AddIncDir
        #   AddSrcDir
        #   AddLibDir
        #   AddDir
        #       Directives that specify directories that extend paths
        #
        if ($directives{$fname} == 1)
        {
            for (my $ii = 1; $ii < scalar @_; $ii++)
            {
                my $arg = $_[$ii];
                next if ( $arg =~ m~^--~);
#::Debug0("Processing: $arg");
#::DebugDumpData("Self", $self);
                #
                #   Skip if the path looks like it conatins keywords
                #   interface and local
                #   
                if ($arg =~ m~/interface/~ || $arg =~ m~/local/~ ) {
                    $arg = '.'
                }

                my $dirtyPath = $arg;
                $dirtyPath = join( '/', $self->{baseDir}, $arg) unless ($arg =~ m~^/~ || $arg =~ m~^\w:~) ;
#::Debug0("DirtyPath: $dirtyPath");
                my $path =  ::CleanPath($dirtyPath );
#::Debug0("CleanPath: $path");
                ::UniquePush (\@{$self->{Includes}}, $path);
                ::Error ("Included directory does not exist: $path") unless -d $path;
            }
        }

        #
        #   LinkPkgArchive
        #   BuildPkgArchive
        #       Directives that define external packages
        #
        if ($directives{$fname} == 2) {
            push @{$self->{PkgList}}, join($;, @_);
        }

        #
        #   BuildName
        #       Directive that specifies the Build Name
        #       Format into name, version, suffix
        #   
        if ($directives{$fname} == 3) {
            my $build_info = BuildName::parseBuildName( @_ );
            $build_info->{BUILDNAME_PROJECT}  = $build_info->{BUILDNAME_PROJECT} ? '.' . $build_info->{BUILDNAME_PROJECT} : '';
            my @data = ($build_info->{BUILDNAME_PACKAGE}, $build_info->{BUILDNAME_VERSION}, $build_info->{BUILDNAME_PROJECT}); 
            $self->{BuildName} = \@data;
        }

        #
        #   SetProjectBase
        #       Handle ProjectBase variable
        #       Only handle a subset as I want to deprecate this
        #       Handle ONLY one arg
        #       Must be either : --Up=nn, or a string ( ../.. );
        #
        if ($directives{$fname} == 4) {
            if (scalar @_ > 1 ) {
               :: Error ("Multiple arguments to SetProjectBase not supported");
            }

            my $dirString = $_[0];
            if ($dirString =~ m~--Up=(\d+)~) {
                my $count = $1;
                $dirString = '/..' x $count;
            }
            my $newProjectBase = $self->{ProjectBase} . $dirString;
            $newProjectBase = ::CleanPath($newProjectBase);
#::Debug0 ("SetProjectBase:" . $newProjectBase);

            no strict;
            no warnings 'all';
            $ProjectBase =  $newProjectBase;
#::Debug0 ("ProjectBase: $ProjectBase");
        }

        #
        #   SubDir
        #   BuildSubDir
        #       Directives that specify subdirectories to be included in the build
        #       Assume they are relative
        #
        if ($directives{$fname} == 5) {
            foreach ( @_ ) {
                push  @{$self->{SubDirs}}, ::CatPaths($self->{baseDir}, $_ );
            }
        }
    }
}


#-------------------------------------------------------------------------------
# Function        : newJatsParser 
#
# Description     : New instance of a JatsParser object
#
# Inputs          : $buildBase - Root of the build 
#                   $commonFile - Common makefile to be prefixed to all
#
# Returns         : 
#
sub newJatsParser
{
    my ($buildBase, $commonFile) = @_;
    my $class = 'JatsParser';
    my $self  = {};
    bless $self, $class;

    #
    #   Init Data
    #
    $self->{baseDir} = '';
    $self->{filename} = '';
    $self->{SubDirs} = ();
    $self->{PkgList} = ();
    $self->{Includes} = ();
    $self->{ScmRoot} = ::FullPath($buildBase) if defined $buildBase ;
    $self->{ProjectBase} = $self->{ScmRoot};
    $self->{Common} = $commonFile if defined $commonFile;

    #
    #   Return class
    #
    return $self;
}

#-------------------------------------------------------------------------------
# Function        : parseFile 
#
# Description     : Parse a build or makefile and return data
#
# Inputs          : $baseDir      - Base directory
#                   $filename     - File to process
#
# Returns         : stuff 
#
sub parseFile
{
    my ($self, $baseDir, $filename) = @_;

    $currentClass = $self;
    $self->{baseDir} = $baseDir;
    $self->{filename} = $filename;
    $filename =  ::CatPaths($baseDir,$filename);
    ::Error("File not found: $filename") unless -f $filename;

    #
    #   Set Jats-global variables
    #       $ProjectBase
    #       $ScmRoot
    #
    no strict;
    $ProjectBase =  $self->{ProjectBase};
    $ScmRoot = ::RelPath( $self->{ScmRoot}, ::FullPath($self->{baseDir}) ) if defined( $self->{ScmRoot}); 

    local @ARGV;
    $ARGV[1] = 'Dummy';
    use strict;

    #
    #   Create the code to be processed
    #   Join the common-makefile and the user-makefile
    #       Set Line numbers and filenames
    #
    my $commonCode = "#No Common Code\n";
    $commonCode = slurpFile($self,$self->{Common}) if (exists $self->{Common});
    my $code =  slurpFile($self,$filename);

#    ::Debug0("code:\n", $commonCode . $code);

    #
    #   Evaluate the code
    #
    no strict;
    no warnings 'all';
    eval $commonCode . $code;
    if ($@) {
        ::Error('Bad eval of Code:', $@);
        ::Debug0("Code", $code);
    }
    use strict;
    use warnings;

#    ::DebugDumpData("ParsedData", $self);
}

#-------------------------------------------------------------------------------
# Function        : slurpFile 
#
# Description     : Read and entire (build / makefile ) into a string
#                   Clean it up a little bit
#
# Inputs          : $file   - File to process 
#
# Returns         : Entire file as a sinngle string
#


sub slurpFile
{
    my ($self, $file) = @_;
    local $/;
    open my $fh, '<', $file or ::Error("Cannot open $file. $!" );
    $/ = undef;
    my $data = <$fh>;
    close $fh;

    #
    #   Remove ugly directives
    #   Messes with line numbers
    #
    $data =~ s~^\s*require.*~_JatsRequire();~gm;
    $data =~ s~^\s*die.*~_JatsDie();~mg;
    $data =~ s~^\s*unless.*~_JatsUnless();~mg;

    $data =~ s~^\s*\$MAKELIB_PL\s+.*~_JatsDefine();~mg;
    $data =~ s~^\s*\$BUILDLIB_PL\s+.*~_JatsDefine();~mg;

    #
    #   Some old build files use some rubbish perl
    #
#    $data =~ s~^my~#my~mg;

    #
    #   Put a nice header on the file for error reporting
    #
    my $absName = ::FullPath($file);
    my $header = "#line 1 \"$absName\"\n" ;

    return $header . $data;
}
1;