Rev 6619 | Blame | Compare with Previous | Last modification | View Log | RSS feed
#! 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## 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;