Subversion Repositories DevTools

########################################################################
# Copyright (C) 2008 ERG Limited, 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;