Subversion Repositories DevTools

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

# Copyright (c) VIX TECHNOLOGY (AUST) LTD

#

# Module name   : JatsLocatePkgFile.pm

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Package to simplify the process of locating one or more

#                 files with the JATS build environment.

#

#                 Specifically designed to assist in the creation of:

#                       Day0 file systems

#                       Debian Packages

#                       Deployable packages

#

#                 Intended to locate files in dependent packages

#                 Supports LinkPkgArchive and BuildPkgArchive

#

#                 Knows about the construction of programs and shared

#                 libraries as well as other special file types.

#

#                 Uses a set of options to identify the file

#                 The file specifier is of the form

#                       Name[,--Option]+

#

#                 Available Options are:

#                       --prog          - Name is a program

#                                         Search where programs are stored

#                                         Append the target specific suffix

#                       --bin           - Similar to --prog, but does not modify

#                                         the provided name.

#                       --deb           - Name is the base of a Debian Package

#                                         Searchs in BIN directories

#                       --lib           - Name is the base of a Shared Library

#                                         Searchs in LIB directories

#                       --dir=SubDir    - Search for Name in a subdir of the

#                                         dependent packages

#                       --pkg           - Search for Name in a pkg subdir

#                                         Limited by the current target

#                       --etc           - Same as --dir=etc

#                       --jar           - Same as --dir=jar

#                       --scripts       - Same as --dir=scripts

#

#                       --AllowMultiple - Allow multiple files

#

# Usage:

#

#   $Locator = JatsLocatePkgFile::New( Platform, 'P' );

#   $result = $Locator->LocateFile ('busybox,--prog');

#

#

#......................................................................#

require 5.008_002;

use strict;

use warnings;

package JatsLocatePkgFile;

use JatsError;

use JatsMakeConfig;

# automatically export what we need into namespace of caller.

use Exporter();

our (@ISA, @EXPORT);

@ISA         = qw(Exporter);

@EXPORT      = qw(

                    FileSet

                );

#

#   Hash of known file location specifications

#   Only allowed to have one in any one definition

#

my %LocSpec = (

    'prog'          => { code => \&searchProg },

    'bin'           => { code => \&searchBin },

    'deb'           => { code => \&searchDeb },

    'dir'           => { code => \&searchDir },

    'pkg'           => { code => \&searchPkg },

    'lib'           => { code => \&searchLib },

    'etc'           => { code => \&searchSimple, dir => 'etc' },

    'jar'           => { code => \&searchSimple, dir => 'jar'},

    'scripts'       => { code => \&searchSimple, dir => 'scripts'},

#    'thx'           => 1,

#    'jar'           => 1,

#    'local'         => 1,

#    'interface'     => 1,

);

#-------------------------------------------------------------------------------

# Function        : FileSet

#

# Description     : Create a new instance of a File Locator

#                   Used to provide the basic configuration of the target

#                   system

#

# Inputs          : None

#                   Useful information is prsent in the environment

#

#

# Returns         : Class Ref

#

sub FileSet

{

    Debug ("New JatsLocatePkgFile");

    my $self;

    #

    #   Load all the MakeFile generate information and  data structures

    #

    my $mi = JatsMakeConfigLoader::Load();

    #

    #   Document Class Variables

    #

    $self->{'platform'} = $mi->{'PLATFORM'};

    $self->{'type'}     = $mi->{'TYPE'};

    $self->{'cache'}    = undef;

    #

    #   Create a class

    #   Bless my self

    #

    bless ($self, __PACKAGE__);

    #

    #   Locate required entries

    #

    my @result;

    for my $entry ( @{$mi->GetDataItem('%ScmBuildPkgRules')} )

    {

        #

        #   If a BuildPkgArchive, then skip as its data will be embedded

        #   in the pseudo INTERFACE package

        #

        next if ( ($entry->{'TYPE'} eq 'build' ) );

        push @result, $entry->{'ROOT'};

    }

    $self->{'BuildPaths'} = \@result;

    $self->{'BuildParts'} = $mi->GetDataItem('%BUILDPLATFORM_PARTS');

    $self->{'a'}    =  $mi->GetDataItem('$a');

    $self->{'exe'}  =  $mi->GetDataItem('$exe');

    $self->{'so'}   =  $mi->GetDataItem('$so');

#    DebugDumpData(__PACKAGE__, $self );

    return $self;

}

#-------------------------------------------------------------------------------

# Function        : LocateFile

#

# Description     : Locate a file as specified by a user description

#

# Inputs          : $self                   - Instance Data

#                   $fspec                  - A file specification

#

# Returns         : A list of files that match

#                   May not return on error

#

sub LocateFile

{

    my $self = shift;

    my ($fspec) = @_;

    my $opts;

    my $mode;

    #

    #   Split the file spec into bits

    #   Extract options and the base file name

    #       Create a hash of options

    #       Convert options to lowercase

    #       Extract any assignments

    #       Treat --Flag as --Flag=1

    #

    $self->{'uspec'} = $fspec;

    while ( $fspec =~ m~^(.*),--(.*?)(=(.*?))?,*$~ )

    {

        $fspec = $1;

        my $opt = lc($2);

        $opts->{$opt} = defined($3) ? $4 : 1;

        $mode = $LocSpec{$opt}

            if ( exists $LocSpec{$opt} )

    }

    #

    #   Save the remainder as the filename

    #   It may not exist

    #

    $opts->{'file'} = $fspec;

    $opts->{'Mode'} = $mode;

#    DebugDumpData("File", $opts);

    #

    #   Dispatch to a suitable processing routine

    #

    if ( $mode )

    {

        if ( $mode->{'code'} )

        {

            my @result = ( $mode->{'code'}( $self, $opts ) );

print "-----Files found: $#result\n";            

            if ( ! $opts->{'allowmultiple'} )

            {

                Error ("Mutliple Files found: $self->{'uspec'}" )

                    if ( $#result > 1 );

            }

            return wantarray ? @result : $result[0];

        }

        DebugDumpData("File", $opts);

        Error ("Unknown search method: @_");

    }

    else

    {

        #

        #   No Mode specified

        #   Must be a local file

        #

        my $ufile = $opts->{'file'};

        return $ufile

            if ( -f $ufile );

        return undef;

    }

}

#-------------------------------------------------------------------------------

# Function        : searchLib

#

# Description     : The user is looking for a shared library file

#                   It will have a specific extension

#                   It will be in one of the 'lib' directories known to JATS

#

#                   Current Limitations:

#                       Does not perform Unix Lib Prefix

#                       Does not handle Name.version.so

#                       Does not handle 'so' Name and 'real' name pairs

#

#

# Inputs          : $self                   - Instance Data

#                   $opts                   - Options Hash

#

# Returns         : 

#

sub searchLib

{

    my ($self, $opts) = @_;

    my $ufile = $opts->{'file'};

    my $ext =  $self->{so} ? '.' . $self->{a} : '';

    my @results;

    foreach my $dir ( @{ LibDirs($self) } )

    {

        foreach  ( glob ( "$dir/*") )

        {

            foreach my $type ( $self->{'type'}, '' )

            {

                push @results, $_  if ( $_ =~ "/$ufile$type$ext\$" );

            }

        }

#        foreach my $type ( $self->{'type'}, '' )

#        {

#            my $file = "$dir/$ufile" . $type . $ext;

#            push @results, $file

#                if ( -f $file );

#            }

    }

    return @results;

}

#-------------------------------------------------------------------------------

# Function        : searchProg

#

# Description     : The user is looking for a program file

#                   It will have a specific extension

#                   It will be in one of the 'Bin' directories known to JATS

#

# Inputs          : $self                   - Instance Data

#                   $opts                   - Options Hash

#

# Returns         : 

#

sub searchProg

{

    my ($self, $opts) = @_;

    my $ufile = $opts->{'file'} . $self->{exe};

    my @results;

    foreach my $dir ( @{ BinDirs($self) } )

    {

        foreach  ( glob ( "$dir/*") )

        {

            push @results, $_  if ( $_ =~ "/$ufile\$" );

        }

    }

    return @results;

#    my $ufile = $opts->{'file'} . $self->{exe};

#    foreach my $dir ( @{ BinDirs($self) } )

#    {

#        my $file = "$dir/$ufile";

#        return $file

#            if ( -f $file );

#    }

#    return undef;

}

#-------------------------------------------------------------------------------

# Function        : searchBin

#

# Description     : The user is looking for a program file

#                   It will be in one of the 'Bin' directories known to JATS

#

# Inputs          : $self                   - Instance Data

#                   $opts                   - Options Hash

#

# Returns         : 

#

sub searchBin

{

    my ($self, $opts) = @_;

    my $ufile = $opts->{'file'};

    my @results;

    foreach my $dir ( @{ BinDirs($self) } )

    {

        foreach  ( glob ( "$dir/*") )

        {

            push @results, $_  if ( $_ =~ "/$ufile\$" );

        }

    }

    return @results;

}

#-------------------------------------------------------------------------------

# Function        : searchDeb

#

# Description     : The user is looking for a Debian Package

#                   It will have a specific extension

#                   It will be in one of the 'Bin' directories known to JATS

#

# Inputs          : $self                   - Instance Data

#                   $opts                   - Options Hash

#

# Returns         : 

#

sub searchDeb

{

    my ($self, $opts) = @_;

    foreach my $dir ( @{ BinDirs($self) } )

    {

        if ( my @files = glob ( "$dir/$opts->{file}_*.deb" ) )

        {

            return $files[0];

        }

    }

    return undef;

}

#-------------------------------------------------------------------------------

# Function        : searchDir

#

# Description     : The user is looking for a file in a package subdir

#                   It will be in one of the package directories

#

# Inputs          : $self                   - Instance Data

#                   $opts                   - Options Hash

#

# Returns         : 

#

sub searchDir

{

    my ($self, $opts) = @_;

    my $ufile = $opts->{'file'};

    foreach my $dir ( @{ MiscDirs($self, $opts->{'dir'}) } )

    {

        my $file = "$dir/$ufile";

        return $file

            if ( -f $file );

    }

    return undef;

}

#-------------------------------------------------------------------------------

# Function        : searchSimple

#

# Description     : The user is looking for a file in known subdir subdir

#                   It will be in one of the package directories

#

# Inputs          : $self                   - Instance Data

#                   $opts                   - Options Hash

#

# Returns         : 

#

sub searchSimple

{

    my ($self, $opts) = @_;

    my $mode = $opts->{'Mode'}{'dir'};

    Error ("JatsLocatePkgFile. searchSimple. Internal Error. No 'dir' configured'",

            "Entry: $self->{'uspec'}") unless ( $mode );

    $opts->{'dir'} = $mode;

    return searchDir( $self, $opts );

}

#-------------------------------------------------------------------------------

# Function        : searchPkg

#

# Description     : The user is looking for a file in a package pkg subdir

#                   It will be in one of the package directories

#

# Inputs          : $self                   - Instance Data

#                   $opts                   - Options Hash

#

# Returns         : 

#

sub searchPkg

{

    my ($self, $opts) = @_;

    my $ufile = $opts->{'file'};

    foreach my $dir ( @{ PkgDirs($self) } )

    {

        my $file = "$dir/$ufile";

        return $file

            if ( -f $file );

    }

    return undef;

}

#-------------------------------------------------------------------------------

# Function        : BinDirs

#

# Description     : Return an array of directories to search for Bin files

#                   Cache results for future use

#

#                   Bin dirs are used to hold:

#                       Programs

#                       Debian Packages

#                       File System Images

#

#                   The directory is named after a platform and will have

#                   a P or D suffix

#

#                   Template:       {BASE}/bin/{PLATFORM}{TYPE}

#                   Compatability:  {BASE}/bin.{PLATFORM}{TYPE}

#                                   {BASE}/bin/bin.{PLATFORM}{TYPE}

#

# Inputs          : $self                   - Instance Data

#

# Returns         : An Array

#

sub BinDirs

{

    my $self = shift;

    #

    #   Return cached results

    #

    unless ( $self->{'cache'}{'bin'} )

    {

        #

        #   Create an array of location to search

        #

        my @dirs;

        foreach my $base ( @{$self->{'BuildPaths'}} )

        {

            foreach my $type ( $self->{'type'}, '' )

            {

                foreach my $subdir ( @{$self->{'BuildParts'}} )

                {

                    my $dir = "$base/bin/$subdir$type";

#print "----Try : $dir\n";

                    push @dirs, $dir if ( -d $dir );

                }

            }

        }

        $self->{'cache'}{'bin'} = \@dirs;

    }

    return $self->{'cache'}{'bin'}

}

#-------------------------------------------------------------------------------

# Function        : LibDirs

#

# Description     : Return an array of directories to search for Lib files

#                   Cache results for future use

#

#                   Lib dirs are used to hold:

#                       Shared Libraries

#                       Static Libraries

#

#                   The file name should have an embedded type (P or D)

#

#                   Template:       {BASE}/lib/{PLATFORM}

#                   Compatability:  {BASE}/lib/{PLATFORM}{TYPE}

#                                   {BASE}/lib.{PLATFORM}{TYPE}

#                                   {BASE}/lib/lib.{PLATFORM}{TYPE}

#

# Inputs          : $self                   - Instance Data

#

# Returns         : An Array

#

sub LibDirs

{

    my $self = shift;

    #

    #   Return cached results

    #

    unless ( $self->{'cache'}{'lib'} )

    {

        #

        #   Create an array of location to search

        #

        my @dirs;

        foreach my $base ( @{$self->{'BuildPaths'}} )

        {

            foreach my $type ( $self->{'type'}, '' )

            {

                foreach my $subdir ( @{$self->{'BuildParts'}})

                {

                    my $dir = "$base/lib/$subdir$type";

#print "----Try : $dir\n";

                    push @dirs, $dir if ( -d $dir );

                }

            }

        }

        $self->{'cache'}{'lib'} = \@dirs;

    }

    return $self->{'cache'}{'lib'}

}

#-------------------------------------------------------------------------------

# Function        : PkgDirs

#

# Description     : Return an array of directories to search for Pkg files

#                   Cache results for future use

#

#                   pkg dirs are used to contain foreign subdirectory trees

#                   Typically used to transparently transfer 3rd parts software

#

#                   There are two forms of pkg dir

#                   Both are not supported within the same package

#

#                   Form-1

#                   Template:       {BASE}/pkg

#

#                   Form-2

#                   Template:       {BASE}/pkg.{PLATFORM}

#                   Template:       {BASE}/pkg.{MACHTYPE}

#

#                   Currently NOT a very good pkg searcher

#                   It does not handle pkg/pkg.MACHTYPE dirs

#

# Inputs          : $self                   - Instance Data

#

# Returns         : An Array

#

sub PkgDirs

{

    my $self = shift;

    #

    #   Return cached results

    #

    unless ( $self->{'cache'}{'pkg'} )

    {

        #

        #   Create an array of location to search

        #

        my @dirs;

        foreach my $base ( @{$self->{'BuildPaths'}} )

        {

            next unless ( -d "$base/pkg" );

            foreach my $subdir ( @{$self->{'BuildParts'}} )

            {

                my $dir = "$base/pkg/$subdir";

#print "----Try : $dir\n";

                push @dirs, $dir if ( -d $dir );

            }

            unless ( @dirs )

            {

                push @dirs, $base;

            }

        }

        $self->{'cache'}{'pkg'} = \@dirs;

    }

    return $self->{'cache'}{'pkg'}

}

#-------------------------------------------------------------------------------

# Function        : MiscDirs

#

# Description     : Return an array of directories to search for Misc files

#                   Cache results for future use

#

#                   Misc dirs are used to contains files of known types

#                   Normally a flat directory structure

#                   No 'type' information

#

#                   Template:   {BASE}/{DIR}

#

#                   Used for dirs that are not special, like the Bin and Lib

#

# Inputs          : $self                   - Instance Data

#                   $root                   - Base of the section

#

# Returns         : An Array

#

sub MiscDirs

{

    my ($self, $root) = @_;

    #

    #   Clean up the user path

    #   Remove leading, trailing and multiple /

    #

    $root =~ s~/+~/~g;

    $root =~ s~^/~~;

    $root =~ s~/$~~;

    #

    #   Return cached results

    #

    unless ( $self->{'cache'}{$root} )

    {

        #

        #   Create an array of location to search

        #

        my @dirs;

        foreach my $base ( @{$self->{'BuildPaths'}} )

        {

            my $dir = "$base/$root";

#print "----Try : $dir\n";

            push @dirs, $dir if ( -d $dir );

        }

        $self->{'cache'}{$root} = \@dirs;

    }

    return $self->{'cache'}{$root}

}

#sub DESTROY

#{

#    DebugDumpData(__PACKAGE__, @_);

#}

1;