Subversion Repositories DevTools

Rev

Rev 5209 | Rev 5212 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5209 Rev 5211
Line 37... Line 37...
37
my $opt_createVersions = 1;
37
my $opt_createVersions = 1;
38
my $opt_index = 1;
38
my $opt_index = 1;
39
my $opt_purge = 1;
39
my $opt_purge = 1;
40
my $opt_extract = 1;
40
my $opt_extract = 1;
41
my $opt_logfile = 1;
41
my $opt_logfile = 1;
-
 
42
my $opt_config;
42
 
43
 
43
 
44
 
44
#
45
#
45
#   Globals
46
#   Globals
46
#
47
#
Line 71... Line 72...
71
                "verbose:+"         => \$opt_verbose,           # flag
72
                "verbose:+"         => \$opt_verbose,           # flag
72
                "createVersions!"   => \$opt_createVersions,
73
                "createVersions!"   => \$opt_createVersions,
73
                "purge!"            => \$opt_purge,
74
                "purge!"            => \$opt_purge,
74
                "index!"            => \$opt_index,
75
                "index!"            => \$opt_index,
75
                "extract!"          => \$opt_extract,
76
                "extract!"          => \$opt_extract,
76
                "logfile!"         => \$opt_logfile,
77
                "logfile!"          => \$opt_logfile,
-
 
78
                "config:s"          => \$opt_config,
77
                );
79
                );
78
 
80
 
79
#
81
#
80
#   Process help and manual options
82
#   Process help and manual options
81
#
83
#
Line 122... Line 124...
122
mkpath($ReleaseStore);
124
mkpath($ReleaseStore);
123
Error ("Package Store not found ",$PackageStore) unless( -d $PackageStore);
125
Error ("Package Store not found ",$PackageStore) unless( -d $PackageStore);
124
Error ("Release Store not found ",$ReleaseStore) unless( -d $ReleaseStore);
126
Error ("Release Store not found ",$ReleaseStore) unless( -d $ReleaseStore);
125
 
127
 
126
#
128
#
-
 
129
#   Default config
-
 
130
#
-
 
131
$config->{'releaseAge'} = 0 unless exists $config->{'releaseAge'};
-
 
132
$config->{'packageAge'} = 0 unless exists $config->{'packageAge'};
-
 
133
 
-
 
134
#
127
#   Determine the various names for this machine
135
#   Determine the various names for this machine
128
#   Include all the IP addresses too
136
#   Include all the IP addresses too
129
#
137
#
130
my ($canonname, $aliases, $addrtype, $length, @addrs) = gethostbyname($ENV{GBE_HOSTNAME});
138
my ($canonname, $aliases, $addrtype, $length, @addrs) = gethostbyname($ENV{GBE_HOSTNAME});
131
push @addressList, $canonname ;
139
push @addressList, $canonname ;
Line 172... Line 180...
172
        #DebugDumpData("Entry", \$entry);
180
        #DebugDumpData("Entry", \$entry);
173
        my $fullName = join('_', $entry->{name}, $entry->{ver});
181
        my $fullName = join('_', $entry->{name}, $entry->{ver});
174
        my $fullPath = catfile($PackageStore , $fullName);
182
        my $fullPath = catfile($PackageStore , $fullName);
175
        next unless defined $entry->{vcs};
183
        next unless defined $entry->{vcs};
176
        next if ( $entry->{vcs} ) =~ m~^UC::~;
184
        next if ( $entry->{vcs} ) =~ m~^UC::~;
177
        unless (-d $fullPath ) {
185
        unless (-d $fullPath ) 
-
 
186
        {
178
            Message("Need to extract: $entry->{name}, $entry->{ver}");
187
            Message("Need to extract: $entry->{name}, $entry->{ver}");
179
            if ($opt_extract)
188
            if ($opt_extract)
180
            {
189
            {
181
                Verbose0("Extracting into: $fullPath");
190
                Verbose0("Extracting into: $fullPath");
-
 
191
                if ($entry->{vcs} ~= m~/MASS_Dev_Crypto/~)
-
 
192
                {
-
 
193
                    print "$fullName : SUPPRESSED\n";
-
 
194
                }
-
 
195
                else
-
 
196
                {
182
                my $rv = JatsCmd ('jats_vcsrelease', '-devmode=escrow', '-extractfiles', "-view=$fullName", "-label=$entry->{vcs}", "-root=$PackageStore", "-noprefix");
197
                    my $rv = JatsCmd ('jats_vcsrelease', '-devmode=escrow', '-extractfiles', "-view=$fullName", "-label=$entry->{vcs}", "-root=$PackageStore", "-noprefix");
183
                print "$fullName : SUCCESS\n" unless $rv;
198
                    print "$fullName : SUCCESS\n" unless $rv;
184
                print "$fullName : ERROR\n" if $rv;
199
                    print "$fullName : ERROR\n" if $rv;
185
                $entry->{bad} = 1;
200
                    $entry->{bad} = 1;
-
 
201
                }
186
            }
202
            }
187
        }
203
        }
-
 
204
        else
-
 
205
        {
-
 
206
            #   Package already extracted
-
 
207
            #   Ensure that it does not get aged out
-
 
208
            deleteAgeMarker($fullPath);
-
 
209
        }
188
    }
210
    }
189
}
211
}
190
 
212
 
191
#-------------------------------------------------------------------------------
213
#-------------------------------------------------------------------------------
192
# Function        : createReleaseViews 
214
# Function        : createReleaseViews 
Line 321... Line 343...
321
# Description     : Rebuild the LXR Configuration file
343
# Description     : Rebuild the LXR Configuration file
322
#                   This MAY be a bit LXR version specific, but since LXR doesn't
344
#                   This MAY be a bit LXR version specific, but since LXR doesn't
323
#                   provide a scriptable way to update configuration
345
#                   provide a scriptable way to update configuration
324
#
346
#
325
#                   Uses template files that have been handcrafted after taken from
347
#                   Uses template files that have been handcrafted after taken from
326
#                   LXR. Basically we to a text repplace a glue together
348
#                   LXR. Basically we to a text replace and a glue together
327
#
349
#
328
#                   For each release we need
350
#                   For each release we need
329
#                       Long Release Name
351
#                       Long Release Name
330
#                       Short Release Name
352
#                       Short Release Name
331
#                       List of Versions
353
#                       List of Versions
Line 336... Line 358...
336
# Returns         : 
358
# Returns         : 
337
#
359
#
338
sub rebuildLxrConfig
360
sub rebuildLxrConfig
339
{
361
{
340
    my @lxrTreeText;
362
    my @lxrTreeText;
-
 
363
 
-
 
364
    #
-
 
365
    #   Sort Sub
-
 
366
    #   Sort ReleaseData by Project and Name
-
 
367
    #   $a and $b are special to the sort
-
 
368
    #
-
 
369
    sub ReleaseDataSort
-
 
370
    {
-
 
371
        my $rv = lc($ReleaseData{$a}{release}{Project}) cmp lc($ReleaseData{$b}{release}{Project});
-
 
372
        if ($rv == 0)
-
 
373
        {
-
 
374
            $rv = lc($ReleaseData{$a}{release}{Name}) cmp lc($ReleaseData{$b}{release}{Name});
-
 
375
        }
-
 
376
        return $rv;
-
 
377
    }
-
 
378
 
341
    #
379
    #
342
    #   Process configured releases
380
    #   Process configured releases
-
 
381
    #   Generate inthe order we wich to display the Releases
343
    #
382
    #
344
    #DebugDumpData("ReleaseData", \%ReleaseData);
383
    #DebugDumpData("ReleaseData", \%ReleaseData);
345
    foreach my $rtagid ( keys %ReleaseData )
384
    foreach my $rtagid ( sort ReleaseDataSort keys %ReleaseData )
346
    {
385
    {
347
        my $entry = $ReleaseData{$rtagid};
386
        my $entry = $ReleaseData{$rtagid};
348
        Information("Entry:$entry->{release}{Name}, $rtagid");
387
        Information("Entry: $entry->{release}{Project}, $entry->{release}{Name}, $rtagid");
349
        $entry->{release}{VersionsString} = join( ',', map { '"' . $_ .'"'} @{$entry->{Versions}} );
388
        $entry->{release}{VersionsString} = join( ',', map { '"' . $_ .'"'} @{$entry->{Versions}} );
350
        $entry->{release}{dbName} = genDatabaseName($rtagid);
389
        $entry->{release}{dbName} = genDatabaseName($rtagid);
351
        #DebugDumpData("ENTRY", \$entry);
390
        #DebugDumpData("ENTRY", \$entry);
352
 
391
 
353
        my $tfileName = 'lxr.tree.template';
392
        my $tfileName = 'lxr.tree.template';
Line 519... Line 558...
519
        next if ($rdirEntry =~ m~^\.~);
558
        next if ($rdirEntry =~ m~^\.~);
520
        my $vdirName = catdir($ReleaseStore, $rdirEntry );
559
        my $vdirName = catdir($ReleaseStore, $rdirEntry );
521
        next unless ( -d $vdirName );
560
        next unless ( -d $vdirName );
522
        unless(exists $ReleaseData{$rdirEntry} && $ReleaseData{$rdirEntry}{release}{LXR} )
561
        unless(exists $ReleaseData{$rdirEntry} && $ReleaseData{$rdirEntry}{release}{LXR} )
523
        {
562
        {
524
            #   Release is no longer configured - remove it
563
            #   Release is no longer configured - age it out
525
            #   Assume $rdirEntry is an rtag_id
564
            #   Assume $rdirEntry is an rtag_id
526
            Message("Delete Release: $rdirEntry");
565
            if (processAgeMarker($vdirName, $config->{'releaseAge'} ))
527
            RmDirTree($vdirName);
566
            {
528
            my $entry = $ReleaseData{$rdirEntry};
567
                Message("Delete Release: $rdirEntry");
529
            #DebugDumpData("ReleaseData:",$entry);
568
                RmDirTree($vdirName);
530
            System('--NoExit', '--NoShell', catfile($scriptDir, 'lxr.dropdb.sh'), genDatabaseName($rdirEntry));
569
                System('--NoExit', '--NoShell', catfile($scriptDir, 'lxr.dropdb.sh'), genDatabaseName($rdirEntry));
-
 
570
            }
531
        }
571
        }
532
        else
572
        else
533
        {
573
        {
534
            $ReleaseData{$rdirEntry}{release}{root} = $vdirName;
574
            $ReleaseData{$rdirEntry}{release}{root} = $vdirName;
-
 
575
            deleteAgeMarker($vdirName);
535
 
576
 
536
            #   Release is configured
577
            #   Release is configured
537
            #   Keep the last x created
578
            #   Keep the last x created
538
            #   Note: Create time is a kludge
579
            #   Note: Create time is a kludge
539
            #
580
            #
Line 697... Line 738...
697
        next if ($pdirEntry =~ m~^\.~);
738
        next if ($pdirEntry =~ m~^\.~);
698
        my $pdirName = catdir($PackageStore, $pdirEntry );
739
        my $pdirName = catdir($PackageStore, $pdirEntry );
699
        next unless ( -d $pdirName );
740
        next unless ( -d $pdirName );
700
        next if (exists $pkgsUsed{$pdirEntry} );
741
        next if (exists $pkgsUsed{$pdirEntry} );
701
 
742
 
-
 
743
        if (processAgeMarker($pdirName, $config->{packageAge})) 
-
 
744
        {
702
        Message("Cleanup: $pdirEntry");
745
            Message("Purge Package: $pdirEntry");
703
        RmDirTree($pdirName);
746
            RmDirTree($pdirName);
-
 
747
        }
704
    }
748
    }
705
    close ($pdir);
749
    close ($pdir);
706
 
750
 
707
    #DebugDumpData("pkgsUsed", \%pkgsUsed);
751
    #DebugDumpData("pkgsUsed", \%pkgsUsed);
708
}
752
}
Line 874... Line 918...
874
# Returns         : Populate Global Data
918
# Returns         : Populate Global Data
875
#
919
#
876
sub readConfig
920
sub readConfig
877
{
921
{
878
    my $cfile = catfile($scriptDir,'jats_lxr.conf');
922
    my $cfile = catfile($scriptDir,'jats_lxr.conf');
-
 
923
    if ($opt_config)
-
 
924
    {
-
 
925
        Message ("Using alternate config: $opt_config");
-
 
926
        $cfile = $opt_config;
-
 
927
    }
879
    Error ("Expected config file not found: $cfile") unless ( -f $cfile );
928
    Error ("Expected config file not found: $cfile") unless ( -f $cfile );
880
    require $cfile;
929
    require $cfile;
881
     
930
     
882
#   #
931
#   #
883
#   #   Create data
932
#   #   Create data
Line 960... Line 1009...
960
            closedir $logDir;
1009
            closedir $logDir;
961
        }
1010
        }
962
    }
1011
    }
963
}
1012
}
964
 
1013
 
-
 
1014
#-------------------------------------------------------------------------------
-
 
1015
# Function        : processAgeMarker 
-
 
1016
#
-
 
1017
# Description     : Age out directories
-
 
1018
#                   Will create age markers as required
-
 
1019
#
-
 
1020
# Inputs          : $tdir       - Target Directory
-
 
1021
#                   $age        - Configured age 
-
 
1022
#
-
 
1023
# Returns         : true        - Directory has reached age
-
 
1024
#
-
 
1025
sub processAgeMarker
-
 
1026
{
-
 
1027
    my ($tdir, $age) = @_;
-
 
1028
    
-
 
1029
    unless (-d $tdir) {
-
 
1030
        Warning ("Expected directory not found: $tdir");
-
 
1031
        return 0; 
-
 
1032
    }
-
 
1033
 
-
 
1034
    #   A configured age of 0 implies delete immediatly
-
 
1035
    if ($age == 0)
-
 
1036
    {
-
 
1037
        return 1;
-
 
1038
    }
-
 
1039
 
-
 
1040
    #
-
 
1041
    #   Create the file ONCE
-
 
1042
    #
-
 
1043
    my $markerfile = catfile($tdir, '.lxrAge');
-
 
1044
    unless (-f $markerfile)
-
 
1045
    {
-
 
1046
        TouchFile($markerfile);
-
 
1047
    }
-
 
1048
    else
-
 
1049
    {
-
 
1050
        if (-M $markerfile > $age)
-
 
1051
        {
-
 
1052
            return 1
-
 
1053
        }
-
 
1054
    }
-
 
1055
    return 0;
-
 
1056
}
-
 
1057
 
-
 
1058
 
-
 
1059
#-------------------------------------------------------------------------------
-
 
1060
# Function        : deleteAgeMarker 
-
 
1061
#
-
 
1062
# Description     : Delete any age marker
-
 
1063
#                   Used when a (potentially) agable directory is used to remove
-
 
1064
#                   the aging marker
-
 
1065
#
-
 
1066
# Inputs          :  $tdir      - Directory
-
 
1067
#
-
 
1068
# Returns         : 
-
 
1069
#
-
 
1070
sub deleteAgeMarker
-
 
1071
{
-
 
1072
    my ($tdir) = @_;
-
 
1073
    
-
 
1074
    unless (-d $tdir) {
-
 
1075
        Warning ("Expected directory not found: $tdir");
-
 
1076
        return 0; 
-
 
1077
    }
-
 
1078
 
-
 
1079
    #
-
 
1080
    #   Use same file name as in processAgeMarker
-
 
1081
    #
-
 
1082
    my $markerfile = catfile($tdir, '.lxrAge');
-
 
1083
    unlink $markerfile;
-
 
1084
}
-
 
1085
 
965
 
1086
 
966
#-------------------------------------------------------------------------------
1087
#-------------------------------------------------------------------------------
967
#   Documentation
1088
#   Documentation
968
#
1089
#
969
 
1090
 
Line 984... Line 1105...
984
    -[no]createVersions - Create new versions. Default:Create
1105
    -[no]createVersions - Create new versions. Default:Create
985
    -[no]extract        - Extract source code. Default:Extract
1106
    -[no]extract        - Extract source code. Default:Extract
986
    -[no]index          - Index new LXR versions. Default:Index
1107
    -[no]index          - Index new LXR versions. Default:Index
987
    -[no]purge          - Purge unused packages. Default:Purge
1108
    -[no]purge          - Purge unused packages. Default:Purge
988
    -[no]logfile        - Capture out to a log file. Default:Log
1109
    -[no]logfile        - Capture out to a log file. Default:Log
-
 
1110
    -config=file        - Alternate config file
989
 
1111
 
990
=head1 OPTIONS
1112
=head1 OPTIONS
991
 
1113
 
992
=over 8
1114
=over 8
993
 
1115
 
Line 1021... Line 1143...
1021
 
1143
 
1022
=item B<-[no]purge>
1144
=item B<-[no]purge>
1023
 
1145
 
1024
This option can be used to suppress purging of packages that are no longer used by any of the LXR Trees.
1146
This option can be used to suppress purging of packages that are no longer used by any of the LXR Trees.
1025
 
1147
 
-
 
1148
=item B<-config=file>
-
 
1149
 
-
 
1150
This option can be used to override the standard config file. Used in testing.
-
 
1151
 
1026
=back
1152
=back
1027
 
1153
 
1028
=head1 DESCRIPTION
1154
=head1 DESCRIPTION
1029
 
1155
 
1030
This program is a tool for creating and maintaining an LXR instance within the VIX Build System.
1156
This program is a tool for creating and maintaining an LXR instance within the VIX Build System.