Subversion Repositories DevTools

########################################################################

# Copyright (c) VIX TECHNOLOGY (AUST) LTD

#

# 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;