Subversion Repositories DevTools

Rev

Rev 6294 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 6294 Rev 7352
Line 39... Line 39...
39 
 
 39 
 
40 
# Symbols to autoexport (:DEFAULT tag)
 40 
# Symbols to autoexport (:DEFAULT tag)
41 
@EXPORT = qw(
 41 
@EXPORT = qw(
42 
                DPackageAdd
 42 
                DPackageAdd
43 
                DPackageSave
 43 
                DPackageSave
44 
                DPackageGenerate
 - 
 
45 
            );
 44 
            );
46 
 
 45 
 
47 
#
 46 
#
48 
#   Global data
 47 
#   Global data
49 
#
 48 
#
Line 52... Line 51...
52 
 
 51 
 
53 
#
 52 
#
54 
#   Local Data
 53 
#   Local Data
55 
#
 54 
#
56 
my $data_added;
 55 
my $data_added;
57 
my $cwd;
 - 
 
58 
 
 56 
 
59 
#-------------------------------------------------------------------------------
 57 
#-------------------------------------------------------------------------------
60 
# Function        : DPackageAdd
 58 
# Function        : DPackageAdd
61 
#
 59 
#
62 
# Description     : Called to insert new information into the data store
 60 
# Description     : Called to insert new information into the data store
Line 71... Line 69...
71 
# Returns         :
 69 
# Returns         :
72 
#
 70 
#
73 
sub DPackageAdd
 71 
sub DPackageAdd
74 
{
 72 
{
75 
    my ($platform, $using, @args ) = @_;
 73 
    my ($platform, $using, @args ) = @_;
- 
 
 74 
    Error ("Internal: DPackageAdd. ScmMakeUid is not defined") unless $::ScmMakeUid;
76 
    push @{$DPackageLibraryData{$using}{$platform}}, @args;
 75 
    push @{$DPackageLibraryData{$using}{$platform}}, @args;
- 
 
 76 
 
- 
 
 77 
    # Auto package the output file
- 
 
 78 
    unless ($data_added) {
77 
    $data_added = 1;
 79 
        $data_added = 1;
- 
 
 80 
        ::PackageFile( '*',getDpkgName(), '--Strip', '--Gbe' );
78 
    $cwd = $::Cwd;
 81 
    }
79 
}
 82 
}
80 
 
 83 
 
81 
#-------------------------------------------------------------------------------
 84 
#-------------------------------------------------------------------------------
82 
# Function        : DPackageSave
 85 
# Function        : DPackageSave
83 
#
 86 
#
84 
# Description     : Merge collected DPackageLibraryData with data stored
 87 
# Description     : Create a per-makefile file
- 
 
 88 
#                   Ensure the files don't have machine or time specific information
85 
#                   within the interface directory from other makefiles
 89 
#                   as they may be created at different time on multiple machines
86 
#
 - 
 
87 
#                   This function is called to save the data
 90 
#                   Will be OK as long as the file contents are the same
- 
 
 91 
#
88 
#                   is written and before the DPACKAGE file is written
 92 
#                   Create file names in an known order so they can be consumed
- 
 
 93 
#                   in the same order.
89 
#
 94 
#
90 
# Inputs          :
 95 
# Inputs          :
91 
#
 96 
#
92 
# Returns         :
 97 
# Returns         :
93 
#
 98 
#
94 
sub DPackageSave
 99 
sub DPackageSave
95 
{
 100 
{
96 
    my $must_save;
 101 
    my $dPkgFile = getDpkgName();
- 
 
 102 
    Debug("DPackageSave: $dPkgFile");
97 
    #
 103 
    #
98 
    #   Do not save if there is nothing to save and nothing has ever been saved
 104 
    #   Do not save if there is nothing to save and nothing has ever been saved
99 
    #   Must update if there is anything previously saved
 105 
    #   Must update if there is anything previously saved
100 
    #
 106 
    #
- 
 
 107 
    unlink $dPkgFile;
- 
 
 108 
    Verbose("DPackageSave Delete: $dPkgFile");
101 
    return unless ( $data_added );
 109 
    return unless ( $data_added );
102 
    Debug("DPackageSave");
 110 
    Verbose("DPackageSave Creating: $dPkgFile");
103 
 
 - 
 
104 
    #
 - 
 
105 
    #   Read in any existing data
 - 
 
106 
    #   It will be held in %DPackageLibraryDataStore
 - 
 
107 
    #   Then replace any data from this makefile with new information
 - 
 
108 
    #
 - 
 
109 
    Require ( "$::ScmRoot/$::ScmInterface", "Dpackage.cfg",
 - 
 
110 
                "JATS internal file missing. Rebuild required" )
 - 
 
111 
        if ( -f "$::ScmRoot/$::ScmInterface/Dpackage.cfg" );
 - 
 
112 
 
 - 
 
113 
#    DebugDumpData("%DPackageLibraryDataStore",\%DPackageLibraryDataStore );
 - 
 
114 
    if ( %DPackageLibraryData )                 # Add this makefile.pl data
 - 
 
115 
    {
 - 
 
116 
 
 - 
 
117 
        #
 - 
 
118 
        #   Detect changes in the data
 - 
 
119 
        #   Serialise the stored element and the element we wish to store
 - 
 
120 
        #   If they are the same we don't need to write out new data.
 - 
 
121 
        #
 - 
 
122 
        my $list1 = Dumper($DPackageLibraryDataStore{$cwd});
 - 
 
123 
        my $list2 = Dumper(\%DPackageLibraryData);
 - 
 
124 
        if ( $list1 ne $list2 )
 111 
    mkpath ( StripFileExt($dPkgFile) );
125 
        {
 - 
 
126 
            Debug("DPackageSave: Add DPACKAGE data");
 - 
 
127 
            $DPackageLibraryDataStore{$cwd} = {%DPackageLibraryData};
 - 
 
128 
            $must_save = 1;
 - 
 
129 
        }
 - 
 
130 
        else
 - 
 
131 
        {
 - 
 
132 
            Debug("DPackageSave: Add DPACKAGE data - no change");
 - 
 
133 
        }
 - 
 
134 
    }
 - 
 
135 
    elsif ( $DPackageLibraryDataStore{$cwd}  )      # Data has gone. Remove entry
 - 
 
136 
    {
 - 
 
137 
        Debug("DPackageSave: Remove DPACKAGE data");
 - 
 
138 
        delete $DPackageLibraryDataStore{$cwd};
 - 
 
139 
        $must_save = 1;
 - 
 
140 
    }
 - 
 
141 
 
 - 
 
142 
#    DebugDumpData("%DPackageLibraryDataStore",\%DPackageLibraryDataStore );
 - 
 
143 
 
 - 
 
144 
    #
 - 
 
145 
    #   Write it out now that it has been merged
 - 
 
146 
    #
 - 
 
147 
    if ( $must_save )
 - 
 
148 
    {
 112
149 
        Debug("DPackageSave: Save Data");
 - 
 
150 
        my $fh = ConfigurationFile::New( "$::ScmRoot/$::ScmInterface/Dpackage.cfg" );
 113 
    my $fh = ConfigurationFile::New( $dPkgFile, '--NoTime' );
151 
        $fh->Dump([\%DPackageLibraryDataStore], [qw(*DPackageLibraryDataStore)]);
 114 
    $fh->Header( "Auto-generated DPACKAGE", "JatsDPackage (version $VERSION)" );
152 
        $fh->Close();
 - 
 
153 
    }
 - 
 
154 
}
 - 
 
155 
 
 - 
 
156 
#-------------------------------------------------------------------------------
 - 
 
157 
# Function        : DPackageGenerate
 - 
 
158 
#
 - 
 
159 
# Description     : Create a simple DPACKAGE file based on collected information
 - 
 
160 
#
 - 
 
161 
#                   This function must be called after all the makefiles
 - 
 
162 
#                   have been rebuilt. It is only at this time that all the
 - 
 
163 
#                   information has been collected.
 - 
 
164 
#
 - 
 
165 
# Notes           : This file may be created on multiple build machines
 - 
 
166 
#                   at slightly different times. Take care to make the
 - 
 
167 
#                   file build machine independent.
 - 
 
168 
#
 - 
 
169 
# Inputs          : None
 - 
 
170 
#
 - 
 
171 
# Returns         : Nothing
 - 
 
172 
#
 - 
 
173 
sub DPackageGenerate
 - 
 
174 
{
 - 
 
175 
    my ($ScmRoot, $ScmInterface ) = @_;
 - 
 
176 
 
 - 
 
177 
    #
 - 
 
178 
    #   Do not generate DPACKAGE unless there is a Dpackage.cfg file
 115 
    $fh->Comment("Defined in : " . RelPath( $Cwd, AbsPath($::ScmRoot)) );
179 
    #   DPACKAGE will be created in a user directory and thus we don't
 - 
 
180 
    #   want to delete it unless we have created it
 - 
 
181 
    #
 - 
 
182 
    return
 - 
 
183 
        unless ( -f "$ScmRoot/$ScmInterface/Dpackage.cfg" );
 - 
 
184 
 
 - 
 
185 
    #
 - 
 
186 
    #   Validate globals
 116 
    $fh->WriteLn("");
187 
    #
 - 
 
188 
    Error ("ScmSrcDir not present") unless ( $::ScmSrcDir );
 - 
 
189 
    EnvImport('GBE_MACHTYPE');
 - 
 
190 
 
 - 
 
191 
    #
 - 
 
192 
    #   User status information
 - 
 
193 
    #
 - 
 
194 
    Message ("Generating DPACKAGE ($::GBE_MACHTYPE)");
 - 
 
195 
 
 - 
 
196 
    #
 - 
 
197 
    #   Read in accumulated information for the creation of the DPACKAGE file
 - 
 
198 
    #
 - 
 
199 
    Require ( "$ScmRoot/$ScmInterface", "Dpackage.cfg",
 - 
 
200 
                "JATS internal file missing. Rebuild required" );
 117 
    $fh->WriteLn("Version( 1, 0 );    # Interface version" );
201 
 
 - 
 
202 
#    DebugDumpData("%::DPackageLibraryData",\%DPackageLibraryDataStore );
 - 
 
203 
 
 - 
 
204 
    #
 - 
 
205 
    #   Delete and then re-create the the DPACKAGE file
 - 
 
206 
    #
 - 
 
207 
    my $fname = "$ScmRoot/$::ScmSrcDir/DPACKAGE.$::GBE_MACHTYPE";
 - 
 
208 
    unlink $fname;
 118 
    $fh->WriteLn("");
209 
 
 - 
 
210 
    my $fh = ConfigurationFile::New( $fname, '--NoTime' );
 - 
 
211 
    $fh->Header( "Auto-generated DPACKAGE",
 - 
 
212 
                              "JatsDPackage (version $VERSION) ( machine $::GBE_MACHTYPE )" );
 - 
 
213 
 
 - 
 
214 
    $fh->Write( "\n", "Version( 1, 0 );    # Interface version\n\n" );
 - 
 
215 
 
 - 
 
216 
    #
 119 
    #
217 
    #   Process each "Using" entry
 120 
    #   Process each "Using" entry
218 
    #   Within each entry process the "platform" targets
 121 
    #   Within each entry process the "platform" targets
219 
    #   and generate Libraries directives.
 122 
    #   and generate Libraries directives.
220 
    #
 123 
    #
221 
    foreach my $mkfile (sort keys %DPackageLibraryDataStore )
 124 
    foreach my $using ( sort keys %DPackageLibraryData ) {
222 
    {
 - 
 
223 
        my $pmkfile = $DPackageLibraryDataStore{$mkfile};
 125 
        my $uentry = $DPackageLibraryData{$using};
224 
 
 - 
 
225 
        $fh->Write( "\n#\n" );
 - 
 
226 
        $fh->Write( "# Defined in ScmRoot : ", RelPath($mkfile,$ScmRoot ), "\n" );
 - 
 
227 
 
 - 
 
228 
        $fh->Write( "#\n" );
 - 
 
229 
        foreach my $using ( sort keys %{$pmkfile}  )
 - 
 
230 
        {
 - 
 
231 
            my $uentry = $pmkfile->{$using};
 - 
 
232 
            $fh->Write( "Using( '$using' );    # Usage name\n" );
 126 
        $fh->WriteLn( "Using( '$using' );    # Usage name" );
233 
 
 127 
 
234 
            foreach my $platform ( sort keys %{$uentry} )
 128 
        foreach my $platform ( sort keys %{$uentry} ) {
235 
            {
 - 
 
236 
                my $pentry = $uentry->{$platform};
 129 
            my $pentry = $uentry->{$platform};
237 
                $fh->Write( "\nLibraries('$platform',\n" );
 130 
            $fh->WriteLn( "\nLibraries('$platform'," );
238 
                foreach my $entry ( @{$pentry} )
 131 
            foreach my $entry ( @{$pentry} ) {
239 
                {
 - 
 
240 
                    $fh->Write( "        '$entry',\n" ),
 132 
                $fh->WriteLn( "        '$entry'," ),
241 
                }
 - 
 
242 
 
 - 
 
243 
                $fh->Write( "        );\n" ),
 - 
 
244 
            }
 133 
            }
- 
 
 134 
 
- 
 
 135 
            $fh->WriteLn( "        );" ),
245 
        }
 136 
        }
246 
    }
 137 
    }
247 
    $fh->Close();
 138 
    $fh->Close();
- 
 
 139 
 
- 
 
 140 
    #
- 
 
 141 
    #   Auto Package the file
- 
 
 142 
    #
248 
}
 143 
}
249 
 
 144 
 
250 
#-------------------------------------------------------------------------------
 145 
#-------------------------------------------------------------------------------
251 
# Function        : Require
 146 
# Function        : getDpkgName
252 
#
 147 
#
253 
# Description     : Internal implementation
 148 
# Description     : Internal function to return the name of the DPACKAGE file
- 
 
 149 
#                   generatde by this makefile
- 
 
 150 
#
- 
 
 151 
#                   The files are created in the 'interface/gbe' directory so that
- 
 
 152 
#                   that they can be automatically found by the process that loads
- 
 
 153 
#                   the definitions. ie: A makefile will be able to use the definitions
- 
 
 154 
#                   created within the same makefile.
- 
 
 155 
#
- 
 
 156 
#                   Use a 4 digit number so that the files can be ordered with a sort
254 
#
 157 
#
255 
# Inputs          : $path
 158 
# Inputs          : None
256 
#                   $file
 - 
 
257 
#                   ...
 - 
 
258 
#
 159 
#
259 
# Returns         :
160 
# Returns         : Name of the genetated file
260 
#
 161 
#
261 
sub Require
 162 
my $dPkgFile;
262 
{
 - 
 
263 
    my ($path, $file) = @_;
 163 
sub getDpkgName {
264 
    $path .= "/$file";
 164 
    unless ($dPkgFile) {
- 
 
 165 
        $dPkgFile = "$::ScmRoot/$::ScmInterface/gbe/DPACKAGE_" . sprintf("%04d",$::ScmMakeUid) . ".cfg";
265 
 
 166 
    }
266 
    require $path;
 167 
    return $dPkgFile;
267 
}
 168 
}
268 
 
 - 
 
269 
1;
 169 
1;
270 
 
 170 
 
271 
 
 -