######################################################################## # COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED. # # Module name : MakeObject.pm # Module type : Makefile system # Compiler(s) : Perl # Environment(s): jats # # Description : A class to describe an buildable object # Used to contain information about # Static libs, Merged Libs, Shared Libs # # Usage: # Create a new Factory for a given Type # Create new instances of that type # Per Type # NewType - Create a New Type factory # New - Create new instance # NewAdd - Create New Instance and add to lists # Get - Get an existing instance # AllTargets - Return array of all items getPath's # Per Object # getBaseDir - Base Dir of Built Object # getFullName - Full Name of Built Object # getPath - BaseDir and Full Name # # addItem - Push an item onto named list (ie: OBJS) # getItems - get Ref to named list # #......................................................................# use strict; use warnings; package MakeObject; use JatsError; #------------------------------------------------------------------------------- # Function : NewType # # Description : Creates a new Type of Object # A factory for creating classes that will contain # a set of common types # # Inputs : $name - Text name # \@ARRAY - Ref to an array that will be maintained # $base - Base directory # $code - Function to create names of new objects # # Returns : A Reference to a class that this can be used # sub NewType { my ($name, $pArray, $base, $code) = @_; my $self = {}; $base .= '/'; $base =~ s~//~/~; $self->{NAME} = $name; $self->{ARRAY} = $pArray; $self->{BASEDIR} = $base; $self->{NFUNCT} = $code; $self->{LIST} = {}; bless ($self, __PACKAGE__ ); return $self; } #------------------------------------------------------------------------------- # Function : New # # Description : Create a new object of this type # Do not add to internal lists # Can be used to create a temp template # # Inputs : $name - Name of the object # # Returns : # sub New { my ($self, $name) = @_; Error ("Bad method to create a New MakeObject" . ref($self)) unless ( $self && ref($self) eq __PACKAGE__ ); return MakeObjectBody::NewBody(@_); } #------------------------------------------------------------------------------- # Function : NewAdd # # Description : Create a new object of this type # Add it to the list of known objects # # Inputs : $name - Name of the object # # Returns : # sub NewAdd { my $self = shift; my $obj = New( $self, @_ ); # # Maintain data items # Hash of objects entries for ready access # Array list - used by user makefiles # ie: @LIBS # my $name = $obj->{NAME}; $self->{LIST}{$name} = $obj; push( @{$self->{ARRAY}}, $name ); return $obj } #------------------------------------------------------------------------------- # Function : Get # # Description : Retrieve an item # Also used to test existance # # Inputs : $self # $name - Name of item # # Returns : Ref or undef if not known # sub Get { my $parent = shift; my ($name) = @_; # # Return Item # Will not create hash entry if it doesn't exist # return $parent->{LIST}{$name}; } #------------------------------------------------------------------------------- # Function : AllTargets # # Description : Return an array of all targets # # Inputs : $self # # Returns : A Ref to an array # that contains the 'makefile' path to the generated items # sub AllTargets { my $self = shift; my @result; # # Use the Array element as the source of the list: # 1) Retains the order in which the user specified the artifacts # 2) Allows user to manipulate the list # foreach my $lib ( @{$self->{ARRAY}} ) { # # Some toolsets add names directly into the lists # Thus not all entries in the ARRAY have entries in # the LIST. We need to handle this # # If we have the object, then use it # Else use a default name construction # # Note: Is UGLY # Feature used by toolsets that create Shared and Static # library pairs. They tend to do push @::LIBS, $name # Perhaps this should be done better # unless ( exists ($self->{LIST}{$lib}) ) { push @result, $self->{BASEDIR} . $self->{NFUNCT}($lib); } else { push @result, $self->{LIST}{$lib}->getPath(); } } \@result; } #sub DESTROY #{ # DebugDumpData("DESTROY", \@_ ); #} ################################################################################ # Internal Package # package MakeObjectBody; use JatsError; #------------------------------------------------------------------------------- # Function : NewBody # # Description : Create a new 'empty' entry # # Inputs : $parent - Ref to Base Type # $name - Name # # Returns : Ref to a an object that can be manipulated # sub NewBody { my $parent = shift; my ($name) = @_; my $self = {}; Error ("No Name provided creating a new " . $parent->{NAME}) unless ( $name ); Error ("Creating duplicate name: $name of type: " . $parent->{NAME} ) if ( exists $parent->{LIST}{$name} ); Error ("Bad object name : \"$name\"", "Contains invalid characters" ) if ( $name =~ m~[^-.\$a-zA-Z0-9_]~ ); $self->{NAME} = $name; $self->{BASEDIR} = $parent->{BASEDIR}; $self->{FULLNAME} = $parent->{NFUNCT}($name); bless ($self, __PACKAGE__); return $self; } #------------------------------------------------------------------------------- # Function : getPath # getBaseDir # getFullName # # Description : Accessor functions # # Inputs : $self # # Returns : # sub getPath { my $self = shift; return $self->{BASEDIR} . $self->{FULLNAME}; } sub getBaseDir { my $self = shift; return $self->{BASEDIR}; } sub getFullName { my $self = shift; return $self->{FULLNAME}; } #------------------------------------------------------------------------------- # Function : getItems # addItem # # Description : Accessor functions for lists of things # The list will spring into existance if it doesn't exist # Will return a ref to the list or a ref to an empty list # # Inputs : $self # $name - Name of item list # $value - Value to add # # Returns : # sub getItems { my ( $self, $name ) = @_; return $self->{$name} || []; } sub addItem { my ($self, $name, $value) = @_; push @{$self->{$name}}, $value; } 1;