Subversion Repositories DevTools

#! perl
########################################################################
# Copyright ( C ) 2005 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Perl Package
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : This package contains functions to create a makefile entry
#                 The entry may consist of the following (optional) fields
#
#                 .PHONY <targets>
#                 <targets> : VARAIBLE = VALUE
#                 <targets> : <prerequisites>
#                       @echo "Run time comment"
#                       Recipe
#                       ( ShellRecipe )
#
#                 The order that information is added is not important
#                 Recipes and prerequisites may be mixed to simplify
#                 programming.
#
#                 The --Define option creates
#                 define <name>
#                   Recipe
#                 endef
#
#                The --Raw option creates
#                   Recipe
#
#
#......................................................................#

use 5.006_001;
use strict;
use warnings;

package MakeEntry;
use JatsError;
use ArrayHashUtils;

#
#   Global variables
#
my $llength = 80;                           # Target line length


#-------------------------------------------------------------------------------
# Function        : New
#
# Description     : Create a new empty entry
#
# Inputs          : handle              - FILEHANDLE or variable ref
#                                         eg: *MAKEFILE     - print to handle
#                                              \$var        - print to variable
#
#                   name                - Primary target name
#                   options             - Preload the fields
#                           --Target=name,name,name
#                           --Comment=text
#                           --Prereq=name,name,name
#                           --Recipe=text
#                           --Phony
#                           --Define
#                           --Raw
#                           --Print
#
# Returns         : Ref to a an object that can be manipulated
#
sub New
{
    my ($handle, $name, @args ) = @_;
    my $self  = {};
    $self->{DEPENDANCY}     = [];
    $self->{NAME}           = [];
    $self->{RECIPE}         = [];
    $self->{SHELL}          = [];
    $self->{PRINTED}        = 0;
    $self->{COMMENT}        = [];
    $self->{DEFN}           = {};
    $self->{PHONY}          = 0;
    $self->{DEFINE}         = 0;
    $self->{RAW}            = 0;
    $self->{FH}             = $handle;
    $self->{FH_inmemory}    = 0;
    $self->{RECIPE_PREFIX}  = '';
    $self->{RECIPE_COMMENT} = '';

    push @{$self->{NAME}}, split(/,/,$name) if ( $name );

    bless ($self, __PACKAGE__);

    #
    #   Process any argument
    #
    my $print = 0;
    foreach ( @args )
    {
        if ( m/^--Target=(.*)/ ) {
            $self->AddName(split(/,/,$1));

        } elsif ( m/^--Comment=(.*)/ ) {
            $self->AddComment($1);

        } elsif ( m/^--Prereq=(.*)/ ) {
            $self->AddDependancy(split(/,/,$1));

        } elsif ( m/^--Phony/ ) {
            $self->Phony();

        } elsif ( m/^--Define/ ) {
            $self->Define();

        } elsif ( m/^--Raw/ ) {
            $self->Raw();

        } elsif ( m/^--Recipe=(.*)/ ) {
            $self->AddRecipe($1);

        } elsif ( m/^--Print/ ) {
            $print = 1;

        } elsif ( m/^--/ ) {
            Error ("MakeEntry: Unknown option: $_");

        } else {
            $self->AddDependancy( $_ );

        }
    }

    #
    #   Set up the printer handle
    #   May be
    #       Empty           - use stderr
    #       ref to a scalar - use in memory file
    #       typeglob        - normal handle
    #
    if ( ref $handle eq 'SCALAR' )
    {
        $$handle = '' if ( ! defined $$handle );
        open(MEMORY,'>>', $handle) || Error ("Cannot open in-memory file");
        $self->{FH_inmemory} = $handle;
        $self->{FH} = \*MEMORY;

    } elsif ( ! $handle ) {
       $self->{FH} = \*STDERR;
    }

    #
    #   Print simple entry if required
    #
    $self->Print() if ( $print );
    return $self;
}

#-------------------------------------------------------------------------------
# Function        : AddName
#
# Description     : Add a name to the entry
#
# Inputs          : An array of names to add
#
# Returns         :
#
sub AddName
{
    my $self = shift;
    push @{$self->{NAME}}, @_
}

#-------------------------------------------------------------------------------
# Function        : Phony
#
# Description     : Flag the entry as a phony
#
# Inputs          :
#
# Returns         :
#
sub Phony
{
    my $self = shift;
    $self->{PHONY} = 1;
}

#-------------------------------------------------------------------------------
# Function        : Define
#
# Description     : Flag the entry as a define, rather than a normal target
#                   Many of the other commands are not supported
#                   Only AddComment and AddRecipe
#
# Inputs          :
#
# Returns         :
#
sub Define
{
    my $self = shift;
    $self->{DEFINE} = 1;
}

#-------------------------------------------------------------------------------
# Function        : Raw
#
# Description     : Flag the entry as raw text
#                   Many of the other commands are not supported
#                   Only AddComment and AddRecipe
#
# Inputs          :
#
# Returns         :
#
sub Raw
{
    my $self = shift;
    $self->{RAW} = 1;
}

#-------------------------------------------------------------------------------
# Function        : AddComment
#
# Description     : Add a comment to the entry
#
# Inputs          : An array of names to add
#
# Returns         :
#
sub AddComment
{
    my $self = shift;
    push @{$self->{COMMENT}}, @_
}

#-------------------------------------------------------------------------------
# Function        : AddDependancy
#
# Description     : Add a dependancy to the entry
#
# Inputs          : An array of dependacies to add
#
# Returns         :
#
sub AddDependancy
{
    my $self = shift;
    UniquePush $self->{DEPENDANCY}, @_ ;
}

#-------------------------------------------------------------------------------
# Function        : AddDefn
#
# Description     : Add a definition to the entry
#
# Inputs          : A hash of definitions to add
#                   The Hash gets lost in the subcall. Its simply a list
#                   of NAME, VALUE pairs
#
# Returns         :
#
sub AddDefn
{
    my $self = shift;
    while ( @_ )
    {
        my $defn = shift;
        my $value = shift || '';
        $self->{DEFN}{$defn} = $value;
    }
}

#-------------------------------------------------------------------------------
# Function        : RecipePrefix
#
# Description     : Set the recipe prefix
#                   This will be added to ALL recipe entries
#
# Inputs          :
#
# Returns         :
#
sub RecipePrefix
{
    my $self = shift;
    my $prefix = shift || '';
    $self->{RECIPE_PREFIX} = $prefix;
}

#-------------------------------------------------------------------------------
# Function        : RecipeComment
#
# Description     : Add a runtime comment to the entry
#
# Inputs          : String to print at runtime
#
# Returns         :
#
sub RecipeComment
{
    my $self = shift;
    $self->{RECIPE_COMMENT} = join( ' ', @_);
}



#-------------------------------------------------------------------------------
# Function        : AddRecipe
#
# Description     : Add a line to the line-by-line recipe
#
# Inputs          : One or more recipe lines
#                   Each line of the recipe will be prefixed with the current
#                   recipe prefix.
#
#                   An array will be treated as a recipe with implicit line
#                   breaks for formatting purposes.
#
# Returns         :
#
sub AddRecipe
{
    my $self = shift;
    my $prefix = $self->{RECIPE_PREFIX};
    foreach ( @_ )
    {
        if (ref($_) eq "ARRAY")
        {
            $_->[0] = $prefix . $_->[0];
            push @{$self->{RECIPE}}, $_;
        }
        else
        {
            push @{$self->{RECIPE}}, $prefix . $_;
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : AddShellRecipe
#
# Description     : Add recipe lines that will be processed within a 'shell'
#
# Inputs          : One or more recipe lines
#
#                   An array will be treated as a recipe with implicit line
#                   breakes for formatting purposes.
#
# Returns         :
#
sub AddShellRecipe
{
    my $self = shift;
    push @{$self->{SHELL}}, @_
}


#-------------------------------------------------------------------------------
# Function        : Print
#
# Description     : Print the entry
#
# Inputs          : None
#
# Returns         : Nothing
#
sub Print
{
    my $self = shift;

    #
    #   Set the default print stream to the desired stream
    #   This greatly simplifies the use of print
    #
    my $fh = $self->{FH};
    my $old_fh = select($fh);


    #
    #   A nice comment header
    #
    if ( @{$self->{COMMENT}} )
    {
        print( "#\n" );
        print map {"# $_\n"} @{$self->{COMMENT}};
        print( "#\n" );
    }

    #
    #   Print the targets
    #   Print PHONY information
    #   Print on multiple lines if multiple targets are very long
    #
    if ( $self->{PHONY} )
    {
        my $phony_string = ".PHONY: ";
        my $tstring = join $;, @{$self->{NAME}};
        my $join = length ($tstring) < $llength ? ' ' : "\n$phony_string";
        $tstring =~ s~$;~$join~g;
        print "$phony_string$tstring\n";
    }

    #
    #   Print any definitions
    #       target: DEFN = VALUE
    #
    if ( $self->{DEFN}  )
    {
        my $tstring = join $;, @{$self->{NAME}};
        my $join = length ($tstring) < $llength ? ' ' : " \\\n    ";
        $tstring =~ s~$;~$join~g;
        foreach  ( keys %{$self->{DEFN}}  )
        {
            my $value = $self->{DEFN} {$_};
            print( "$tstring: $_ = $value\n" );
        }
    }

    if ( $self->{RAW}  )
    {
        my $tstring = join ("\n", @{$self->{RECIPE}});
        print $tstring;
    }
    elsif ( $self->{DEFINE}  )
    {

        my $tstring = $self->{NAME}[0];
        print "define $tstring";
        print_list ( '', '', $self->{RECIPE}, '');
        print "\nendef";
    }
    else
    {
        #
        #   Print the main target name
        #   Print on multiple lines if multiple targets are very long
        #
        my $tstring = join $;, @{$self->{NAME}};
        my $join = length ($tstring) < $llength ? ' ' : " \\\n";
        $tstring =~ s~$;~$join~g;
        my $nlength = length $tstring;
        print "$tstring:";
        
        #
        #   Print the prerequisites
        #   Print on multiple lines if long
        #
        $tstring = join $;, @{$self->{DEPENDANCY}};
        $join = $nlength + length ($tstring) < $llength ? ' ' : " \\\n\t";
        $tstring =~ s~$;~$join~g;
        print $join . $tstring;

        #
        #   Print the Recipe runtime comment
        #
        if ( $self->{RECIPE_COMMENT} )
        {
            print "\n\t\@echo \"$self->{RECIPE_COMMENT}\"";
        }

        #
        #   Print the recipe
        #
        print_list ( '', '', $self->{RECIPE}, '');

        #
        #   Print the recipe as a shell command
        #   Bracket the recipes with ( .. ) and place semi colons between lines
        #   Use the current recipe prefix
        #
        print_list ( $self->{RECIPE_PREFIX} . '(', ';\\', $self->{SHELL}, ')');
    }

    print "\n\n";

    #
    #   Flag the entry as having been printed
    #   Used as a sanity test when the object is destroyed
    #
    $self->{PRINT} = 1;

    #
    #   Restore default output stream handle
    #
    select($old_fh);
}

#-------------------------------------------------------------------------------
# Function        : print_list
#
# Description     : Internal helper rouitine
#
# Inputs          : $prefix     - Optional prefix to wrap the list
#                                 If present will cause extra indentation
#                   $linesep    - Line seperator string
#                   $ref        - Ref to the list to display
#                                 Each element will be a line of text, or an
#                                 array of arguments which will be displayed on
#                                 new lines for pretty printing
#                   $suffix     - Optional suffix.
#
# Returns         :
#
sub print_list
{
    my ($prefix, $linesep ,$ref, $suffix) = @_;
    my @entry = @{$ref};
    my $leadin = "\t";

    if ( @entry  )
    {
        if ( $prefix )
        {
            print( "\n" . $leadin . $prefix . "\\" );
            $leadin .= "\t";
        }

        foreach ( @entry )
        {
            if (ref($_) eq "ARRAY")
            {
                my @array = @{$_};
                my $indent = '';
                my $tail = '';
                foreach ( @array )
                {
                    print( $tail . "\n" . $leadin . $indent . $_ );
                    $indent = "\t";
                    $tail = " \\";
                }
                print $linesep;
            }
            else
            {
                print( "\n" . $leadin . $_ . $linesep );
            }
        }

        if ( $suffix )
        {
            print( "\n" . $leadin . $suffix );
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : DESTROY
#
# Description     : Sanity test
#
# Inputs          :
#
# Returns         :
#
sub DESTROY
{
    my $self = shift;
    unless ($self->{PRINT} )
    {
        $self->{PRINT} = 1;
        Error ("Destroying MakeEntry before printing.",
               "Name: @{$self->{NAME}}");
    }

    #
    #   If using an in-memory file close the handle
    #
    close $self->{FH} if ( $self->{FH_inmemory} );
}

1;