Subversion Repositories DevTools

Rev

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

Rev 5247 Rev 5252
Line 7... Line 7...
7
# Environment(s): jats
7
# Environment(s): jats
8
#
8
#
9
# Description   : Tools to maintain LXR information
9
# Description   : Tools to maintain LXR information
10
#
10
#
11
# Possible imporvements
11
# Possible imporvements
12
#       Delete files we don't want to index
-
 
13
#           .DMP,.dmp,.so,.gz,.zip,.lib,.bz,.bz2,.tbz,.jar,.deb,.exe,.a,.msb
-
 
14
#
-
 
15
#       Merge ripples package versions
12
#       Merge ripples package versions
16
#           Just keep one
13
#           Just keep one
17
#           At the moment, simply ignore ripples in release comparisons.
14
#           At the moment, simply ignore ripples in release comparisons.
18
#
15
#
19
#       Cots packages
16
#       Cots packages
Line 125... Line 122...
125
#   Sed with Default config
122
#   Sed with Default config
126
#
123
#
127
$Config->{'releaseAge'} = 0;
124
$Config->{'releaseAge'} = 0;
128
$Config->{'packageAge'} = 0;
125
$Config->{'packageAge'} = 0;
129
$Config->{'logAge'} = 0;
126
$Config->{'logAge'} = 0;
130
$Config->{'verbose'} = 0;
127
$Config->{'verbose'} = $opt_verbose;
131
$Config->{GBE_RM_LOCATION} = $ENV{GBE_RM_LOCATION};
128
$Config->{GBE_RM_LOCATION} = $ENV{GBE_RM_LOCATION};
132
$Config->{GBE_RM_USERNAME} = $ENV{GBE_RM_USERNAME};
129
$Config->{GBE_RM_USERNAME} = $ENV{GBE_RM_USERNAME};
133
$Config->{GBE_RM_PASSWORD} = $ENV{GBE_RM_PASSWORD};
130
$Config->{GBE_RM_PASSWORD} = $ENV{GBE_RM_PASSWORD};
134
readConfig();
131
readConfig();
135
 
132
 
Line 222... Line 219...
222
#-------------------------------------------------------------------------------
219
#-------------------------------------------------------------------------------
223
# Function        : extractPackages 
220
# Function        : extractPackages 
224
#
221
#
225
# Description     : Extract Packages from VCS
222
# Description     : Extract Packages from VCS
226
#                   Don't extract them if they already exist
223
#                   Don't extract them if they already exist
-
 
224
#                   Cleanup non-indexable files
227
#   
225
#   
228
#                   Kludge: Prevent extraction from MASS_Dev_Crypto Repo
226
#                   Kludge: Prevent extraction from MASS_Dev_Crypto Repo
229
#
227
#
230
# Inputs          : $rtagid         - Release To Process
228
# Inputs          : $rtagid         - Release To Process
231
#                                     Conatins PackageVersion data  
229
#                                     Conatins PackageVersion data  
Line 263... Line 261...
263
                        $entry->{bad} = 1;
261
                        $entry->{bad} = 1;
264
                    }
262
                    }
265
                    else
263
                    else
266
                    {
264
                    {
267
                        $result = 'SUCCESS';
265
                        $result = 'SUCCESS';
-
 
266
 
268
                    }
267
                    }
269
                }
268
                }
270
                Message("Extraction Result: $result");
269
                Message("Extraction Result: $result");
-
 
270
 
-
 
271
                #
-
 
272
                #   Clean up the extracted views
-
 
273
                #   Use lxr_clean_dir.sh
-
 
274
                #
-
 
275
                if (-d $fullPath)
-
 
276
                {
-
 
277
                    Verbose("Running lxr_clean_dir.sh");
-
 
278
                    System('--NoExit', '--NoShell', catfile($scriptDir,'lxr_clean_dir.sh') , $fullPath);
-
 
279
                }
271
            }
280
            }
272
        }
281
        }
273
        else
282
        else
274
        {
283
        {
275
            #   Package already extracted
284
            #   Package already extracted
Line 531... Line 540...
531
    #
540
    #
532
    #DebugDumpData("ReleaseData", \%ReleaseData);
541
    #DebugDumpData("ReleaseData", \%ReleaseData);
533
    foreach my $rtagid ( sort ReleaseDataSort keys %ReleaseData )
542
    foreach my $rtagid ( sort ReleaseDataSort keys %ReleaseData )
534
    {
543
    {
535
        my $entry = $ReleaseData{$rtagid};
544
        my $entry = $ReleaseData{$rtagid};
536
        Information("Entry: $entry->{release}{Project}, $entry->{release}{Name}, $rtagid");
545
        Information("Entry: $entry->{release}{Project}, $entry->{release}{Name}, $entry->{release}{LXRSTATE}, $rtagid");
-
 
546
        next if ($entry->{release}{LXRSTATE} eq 'D');
537
        $entry->{release}{VersionsString} = join( ',', map { '"' . $_ .'"'} @{$entry->{Versions}} );
547
        $entry->{release}{VersionsString} = join( ',', map { '"' . $_ .'"'} @{$entry->{Versions}} );
538
        $entry->{release}{dbName} = genDatabaseName($rtagid);
548
        $entry->{release}{dbName} = genDatabaseName($rtagid);
539
        $entry->{release}{root} = catdir($ReleaseStore, $rtagid );
549
        $entry->{release}{root} = catdir($ReleaseStore, $rtagid );
540
        #DebugDumpData("ENTRY", \$entry);
550
        #DebugDumpData("ENTRY", \$entry);
541
 
551
 
Line 663... Line 673...
663
                       );
673
                       );
664
               Verbose("genxref exit: $rv");
674
               Verbose("genxref exit: $rv");
665
               unless ($rv) {
675
               unless ($rv) {
666
                   TouchFile($markerFile);
676
                   TouchFile($markerFile);
667
               }
677
               }
-
 
678
               else
-
 
679
               {
-
 
680
                   Warning("Error indexing $rtagid ($rv)");
-
 
681
               }
668
            }
682
            }
669
            else
683
            else
670
            {
684
            {
671
                Verbose("Already indexed: $rtagid, $version");
685
                Verbose("Already indexed: $rtagid, $version");
672
            }
686
            }
Line 723... Line 737...
723
                {
737
                {
724
                    my $glimpseData = catdir( $Config->{glimpseDir}, $rdirEntry );
738
                    my $glimpseData = catdir( $Config->{glimpseDir}, $rdirEntry );
725
                    RmDirTree($glimpseData);
739
                    RmDirTree($glimpseData);
726
                }
740
                }
727
            }
741
            }
-
 
742
            else
-
 
743
            {
-
 
744
                #
-
 
745
                #   Build up the list of known versions
-
 
746
                #
-
 
747
                foreach my $entry ( getReleaseVersions($vdirName) )
-
 
748
                {
-
 
749
                    push @{$ReleaseData{$rdirEntry}{Versions}}, $entry->{name};
-
 
750
                }
-
 
751
            }
728
        }
752
        }
729
        else
753
        else
730
        {
754
        {
731
            $ReleaseData{$rdirEntry}{release}{LXRSTATE} = 'I';
755
            $ReleaseData{$rdirEntry}{release}{LXRSTATE} = 'I';
732
            deleteAgeMarker($vdirName);
756
            deleteAgeMarker($vdirName);
Line 735... Line 759...
735
            #   Keep the last x created
759
            #   Keep the last x created
736
            #   Note: Create time is a kludge
760
            #   Note: Create time is a kludge
737
            #
761
            #
738
            #   Process each version within the Release
762
            #   Process each version within the Release
739
            #
763
            #
740
            my @versionData;
-
 
741
            opendir (my $vdir, $vdirName) || Warning ("Cannot open directory: $vdirName", $!);
-
 
742
            while (my $vdirEntry = readdir($vdir))
-
 
743
            {
-
 
744
                #   Skip hidden files and directories
-
 
745
                next if ($vdirEntry =~ m~^\.~);
-
 
746
                my $ldirName = catdir($vdirName, $vdirEntry );
-
 
747
                next unless ( -d $ldirName );
-
 
748
                my $data;
-
 
749
                $data->{name} = $vdirEntry; 
-
 
750
                $data->{path} = $ldirName; 
-
 
751
                $data->{ctime} = (stat $ldirName)[9];
-
 
752
                push @versionData  , $data;
-
 
753
            }
-
 
754
            close ($vdir);
-
 
755
            #DebugDumpData("versionData",\@versionData);
-
 
756
 
-
 
757
            my $keepCount = 0;
764
            my $keepCount = 0;
758
            foreach my $entry ( sort { $b->{ctime} <=> $a->{ctime}} @versionData )
765
            foreach my $entry ( getReleaseVersions($vdirName) )
759
            {
766
            {
760
                #DebugDumpData("Entry", $entry);
767
                #DebugDumpData("Entry", $entry);
761
                $keepCount++;
768
                $keepCount++;
762
                if ($keepCount > 5)
769
                if ($keepCount > 5)
763
                {
770
                {
Line 775... Line 782...
775
    }
782
    }
776
    close ($rdir);
783
    close ($rdir);
777
}
784
}
778
 
785
 
779
#-------------------------------------------------------------------------------
786
#-------------------------------------------------------------------------------
-
 
787
# Function        : getReleaseVersions 
-
 
788
#
-
 
789
# Description     : Get the Versions in a Release
-
 
790
#
-
 
791
# Inputs          : $vdirName         - Path to process
-
 
792
#
-
 
793
# Returns         : A sorted array of data items (Most recent first)
-
 
794
#                   Each items consists of:
-
 
795
#                       {name}
-
 
796
#                       {path}
-
 
797
#                       {ctime}    
-
 
798
#
-
 
799
sub getReleaseVersions
-
 
800
{
-
 
801
    my ($vdirName) = @_;
-
 
802
    my @versionData;
-
 
803
 
-
 
804
    opendir (my $vdir, $vdirName) || Warning ("Cannot open directory: $vdirName", $!);
-
 
805
    while (my $vdirEntry = readdir($vdir))
-
 
806
    {
-
 
807
        #   Skip hidden files and directories
-
 
808
        next if ($vdirEntry =~ m~^\.~);
-
 
809
        my $ldirName = catdir($vdirName, $vdirEntry );
-
 
810
        next unless ( -d $ldirName );
-
 
811
        my $data;
-
 
812
        $data->{name} = $vdirEntry; 
-
 
813
        $data->{path} = $ldirName; 
-
 
814
        $data->{ctime} = (stat $ldirName)[9];
-
 
815
        push @versionData  , $data;
-
 
816
    }
-
 
817
    close ($vdir);
-
 
818
    #DebugDumpData("versionData",\@versionData);
-
 
819
 
-
 
820
    my @sortedList = sort { $b->{ctime} <=> $a->{ctime}} @versionData;
-
 
821
    #DebugDumpData("SortedVersionData",\@sortedList);
-
 
822
    return @sortedList;
-
 
823
}
-
 
824
 
-
 
825
 
-
 
826
#-------------------------------------------------------------------------------
780
# Function        : getLatestVersion 
827
# Function        : getLatestVersion 
781
#
828
#
782
# Description     : For a specified directory return the newest subdir
829
# Description     : For a specified directory return the newest subdir
783
#
830
#
784
#                   Used to determine the most recent version
831
#                   Used to determine the most recent version
Line 1264... Line 1311...
1264
            mkpath($Config->{lxrLogDir}); 
1311
            mkpath($Config->{lxrLogDir}); 
1265
            if (-d $Config->{lxrLogDir} )
1312
            if (-d $Config->{lxrLogDir} )
1266
            {
1313
            {
1267
                open STDOUT, '>', $name  or die "Can't redirect STDOUT: $!";
1314
                open STDOUT, '>', $name  or die "Can't redirect STDOUT: $!";
1268
                open STDERR, ">&STDOUT"  or die "Can't dup STDOUT: $!";
1315
                open STDERR, ">&STDOUT"  or die "Can't dup STDOUT: $!";
-
 
1316
                STDOUT->autoflush(1);
-
 
1317
                STDERR->autoflush(1);
1269
            }
1318
            }
1270
            else
1319
            else
1271
            {
1320
            {
1272
                Warning("Can't create log dir: $Config->{lxrLogDir}. $!");
1321
                Warning("Can't create log dir: $Config->{lxrLogDir}. $!");
1273
            }
1322
            }
Line 1328... Line 1377...
1328
    if ($age == 0)
1377
    if ($age == 0)
1329
    {
1378
    {
1330
        return 1;
1379
        return 1;
1331
    }
1380
    }
1332
 
1381
 
-
 
1382
    #   Test for Age me now marker file
-
 
1383
    my $purgefile = catfile($tdir, '.lxrPurge');
-
 
1384
    if (-f $purgefile )
-
 
1385
    {
-
 
1386
        Verbose ("Age:  ForcedPurge $tdir");
-
 
1387
        return 1;
-
 
1388
    }
-
 
1389
 
1333
    #
1390
    #
1334
    #   Create the file ONCE
1391
    #   Create the file ONCE
1335
    #
1392
    #
1336
    my $markerfile = catfile($tdir, '.lxrAge');
1393
    my $markerfile = catfile($tdir, '.lxrAge');
1337
    unless (-f $markerfile)
1394
    unless (-f $markerfile)