#! perl
########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). 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
#
#                The --Raw with --Phony option creates
#                   .PHONY <targets>
#                   <targets>:
#                       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_WRAPPER}  = ['(', ')'];
    $self->{RECIPE_COMMENT} = '';
    $self->{STACK}          = [];
    $self->{SDEF}           = '';

    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 target 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
#                       AddRecipe OR AddShellRecipe
#                       SectionIfDef and related fuction
#                           Will generate an empty definition for the 'else'
#
# 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        : QuoteDependency
#
# Description     : Escape/Quote a pathname for make
#                       Allow files with a $ in the name
#                       Allow files with a space in the name
#                       Allow files with a comma in the name
#                       Allow files with a colon in the name
#                       Allow for paths that have make-varible prefixes
#                           $(GBE_...) or ${GBE_...} or $(OBJDIR) or $(BUILDVERNUM)
#                           as these may be generated internally
#
#                       Must also allow $(GBE_TYPE) in the remainder
#
# Inputs          : uarg                - Arg to quote
#
# Returns         : Quoted arg
#

sub QuoteDependency
{
    my ($uarg) = @_;

    #
    #   Split into two
    #       $(xxx)/             - Makefile variables
    #       Remainder           - Stuff to quote
    #
    $uarg =~ m~^((\$\(.*?\)/)*)(.*)~;
    my $prefix = defined $1 ? $1 : '';
    my $arg    = defined $3 ? $3 : '';

    $arg =~ s~\$(?!\(GBE_[A-Z]+\)|{GBE_[A-Z]+}|\(OBJDIR\)|\(BUILDVERNUM\))~\$\$~g;       # $, not followed by (GBE_ or ${GBE_ or (OBJDIR)- is not $(GBE_ AND not $(OBJDIR)
    $arg =~ s~ ~\\ ~g;
    $arg =~ s~,~\$(comma)~g;
    $arg =~ s~%~\\%~g;
    $arg =~ s~:~\\:~g if ($::ScmHost eq 'Unix');
    return $prefix . $arg;
}

#-------------------------------------------------------------------------------
# Function        : AddDependancyEscaped
#
# Description     : Add a dependancy to the entry and Quote the value so that
#                   it can be it can be processed by make
#
# Inputs          : An array of dependencies to add
#
# Returns         :
#
sub AddDependancyEscaped
{
    my $self = shift;
    my @escaped;

    push @escaped, QuoteDependency($_) foreach (@_);
    UniquePush $self->{DEPENDANCY}, @escaped ;
}

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

#-------------------------------------------------------------------------------
# Function        : AddDefn
#
# Description     : Add a definition to the entry
#                   Preserve the order
#
# 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 || '';
        push @{$self->{DEFN}}, join( $;, $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        : RecipeWrapper
#
# Description     : Add a wrapper around the recipe
#
# Inputs          : begin   - Start of wrapper
#                   end     - End of wrapper
#
# Returns         :
#
sub RecipeWrapper
{
    my $self = shift;
    Error("RecipeWrapper requires exacly two arguments") unless scalar @_ == 2;
    my ($begin, $end) = @_;
    $self->{RECIPE_WRAPPER}[0] = $begin;
    $self->{RECIPE_WRAPPER}[1] = $end;
}

#-------------------------------------------------------------------------------
# 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        : AddOneRecipe
#
# Description     : Add an array as a single recipe that has been formatted with implicit line breaks
#
# Inputs          : A recipe with implicit line breaks for formatting purposes.
#
# Returns         :
#
sub AddOneRecipe
{
    my $self = shift;
    my @data = @_;
    my $prefix = $self->{RECIPE_PREFIX};

    $data[0] = $prefix . $data[0];
    push @{$self->{RECIPE}}, \@data;
}

#-------------------------------------------------------------------------------
# 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
#                   breaks for formatting purposes.
#
# Returns         :
#
sub AddShellRecipe
{
    my $self = shift;
    push @{$self->{SHELL}}, @_
}

#-------------------------------------------------------------------------------
# Function        : NewSection 
#
# Description     : Create a new section within the current recipe
#                   Only used within a standard recipe (not raw or defined)
#                   Used to create multiple sections in cases with multiple shell
#                   and recipe sections.
#
#                   Save existing entries and start again
#
# Inputs          : None 
#
# Returns         : 
#
sub NewSection
{
    my $self = shift;
    my %data;

    $data{RECIPE}           = $self->{RECIPE};
    $data{SHELL}            = $self->{SHELL};
    $data{RECIPE_PREFIX}    = $self->{RECIPE_PREFIX};
    $data{RECIPE_COMMENT}   = $self->{RECIPE_COMMENT};
    $data{RECIPE_WRAPPER}   = $self->{RECIPE_WRAPPER};
    $data{SDEF}             = $self->{SDEF};
    

    push @{$self->{STACK}}, \%data;

    $self->{RECIPE}         = []; 
    $self->{SHELL}          = [];
    $self->{RECIPE_PREFIX}  = '';
    $self->{RECIPE_COMMENT} = '';
    $self->{RECIPE_WRAPPER} = ['(', ')'];
    $self->{SDEF}           = '';
}

#-------------------------------------------------------------------------------
# Function        : SectionIfDef 
#
# Description     : Place the current section within a ifdef ... endif block
#
# Inputs          : defn        - Definition to use within the ifdef construct 
#
# Returns         : Nothing
#

sub SectionIfDef
{
    my $self = shift;
    $self->{SDEF} = 'ifdef ' . $_[0];
}

#-------------------------------------------------------------------------------
# Function        : SectionIfEq
#
# Description     : Place the current section within a ifeq ... endif block
#
# Inputs          : arg1
#                   arg2
#
# Returns         : Nothing
#

sub SectionIfEq
{
    my $self = shift;
    $self->{SDEF} = 'ifeq "' . $_[0] . '" "' . $_[1] . '"';
}

#-------------------------------------------------------------------------------
# Function        : SectionIfNeq
#
# Description     : Place the current section within a ifeq ... endif block
#
# Inputs          : arg1
#                   arg2
#
# Returns         : Nothing
#
sub SectionIfNeq
{
    my $self = shift;
    $self->{SDEF} = 'ifneq "' . $_[0] . '" "' . $_[1] . '"';
}


#-------------------------------------------------------------------------------
# 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 ( @{$self->{DEFN}} ){
            my ($defn,$value) = split($;, $_);
            print( "$tstring: $defn := $value\n" );
        }
    }

    if ( $self->{RAW}  )
    {
        if ( $self->{PHONY} )
        {
            my $tstring = $self->{NAME}[0];
            print($tstring . ":\n");
        }
        my $tstring = join ("\n", @{$self->{RECIPE}});
        print $tstring;
    }
    elsif ( $self->{DEFINE}  )
    {
        # Just print the recipe
        # May be warpped in an ifdef with an empty 'else'

        my $tstring = $self->{NAME}[0];
        my $sdef =    $self->{SDEF};

        print "$sdef" if ($sdef);

        print "\ndefine $tstring";
        print_list ( '', '', $self->{RECIPE}, '');
        print_list ( $self->{RECIPE_WRAPPER}[0], '; \\', $self->{SHELL}, $self->{RECIPE_WRAPPER}[1] );
        print "\nendef";
        if ($sdef) {
            print "\nelse";
            print "\ndefine $tstring";
            print "\nendef";
            print "\nendif";
        }
    }
    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;

        #
        #   Push the current section onto the stack
        #   This will simplify processing of all sections
        #
        $self->NewSection();
        foreach my $recipeEntry (@{$self->{STACK}})
        {
            my $comment = $recipeEntry->{RECIPE_COMMENT};
            my $wrapper = $recipeEntry->{RECIPE_WRAPPER};
            my $prefix =  $recipeEntry->{RECIPE_PREFIX};
            my $recipe =  $recipeEntry->{RECIPE};
            my $shell =   $recipeEntry->{SHELL};
            my $sdef =    $recipeEntry->{SDEF};

            if ($sdef) {
                print "\n$sdef";
            }

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

            #
            #   Print the recipe
            #
            print_list ( '', '', $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 ( $prefix . $wrapper->[0], ';\\', $shell, $wrapper->[1]);

            if ($sdef) {
                print "\nendif";
            }
        }
    }

    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 )
                {
                    next unless (defined $_);
                    next unless ( length($_));
                    print( $tail . "\n" . $leadin . $indent . $_ );
                    $indent = "\t";
                    $tail = " \\";
                }
                print $linesep;
            }
            else
            {
                print( "\n" . $leadin . $_ . $linesep );
            }
        }

        if ( $suffix )
        {
            $leadin = chop($leadin) if ($prefix);
            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;