WebSVN – DevTools – Diff – /lxr_manager/trunk/src/jats_lxr.pl



# Environment(s): jats
#
# Description   : Tools to maintain LXR information
#
# Possible imporvements
 
 
 
#       Merge ripples package versions
#           Just keep one
#           At the moment, simply ignore ripples in release comparisons.
#
#       Cots packages

#   Sed with Default config
#
$Config->{'releaseAge'} = 0;
$Config->{'packageAge'} = 0;
$Config->{'logAge'} = 0;
$Config->{'verbose'} = $opt_verbose;
$Config->{GBE_RM_LOCATION} = $ENV{GBE_RM_LOCATION};
$Config->{GBE_RM_USERNAME} = $ENV{GBE_RM_USERNAME};
$Config->{GBE_RM_PASSWORD} = $ENV{GBE_RM_PASSWORD};
readConfig();
 

#-------------------------------------------------------------------------------
# Function        : extractPackages 
#
# Description     : Extract Packages from VCS
#                   Don't extract them if they already exist
#                   Cleanup non-indexable files
#   
#                   Kludge: Prevent extraction from MASS_Dev_Crypto Repo
#
# Inputs          : $rtagid         - Release To Process
#                                     Conatins PackageVersion data  

                        $entry->{bad} = 1;
                    }
                    else
                    {
                        $result = 'SUCCESS';
 
                    }
                }
                Message("Extraction Result: $result");
 
                #
                #   Clean up the extracted views
                #   Use lxr_clean_dir.sh
                #
                if (-d $fullPath)
                {
                    Verbose("Running lxr_clean_dir.sh");
                    System('--NoExit', '--NoShell', catfile($scriptDir,'lxr_clean_dir.sh') , $fullPath);
                }
            }
        }
        else
        {
            #   Package already extracted

    #
    #DebugDumpData("ReleaseData", \%ReleaseData);
    foreach my $rtagid ( sort ReleaseDataSort keys %ReleaseData )
    {
        my $entry = $ReleaseData{$rtagid};
        Information("Entry: $entry->{release}{Project}, $entry->{release}{Name}, $entry->{release}{LXRSTATE}, $rtagid");
        next if ($entry->{release}{LXRSTATE} eq 'D');
        $entry->{release}{VersionsString} = join( ',', map { '"' . $_ .'"'} @{$entry->{Versions}} );
        $entry->{release}{dbName} = genDatabaseName($rtagid);
        $entry->{release}{root} = catdir($ReleaseStore, $rtagid );
        #DebugDumpData("ENTRY", \$entry);
 

                       );
               Verbose("genxref exit: $rv");
               unless ($rv) {
                   TouchFile($markerFile);
               }
               else
               {
                   Warning("Error indexing $rtagid ($rv)");
               }
            }
            else
            {
                Verbose("Already indexed: $rtagid, $version");
            }

                {
                    my $glimpseData = catdir( $Config->{glimpseDir}, $rdirEntry );
                    RmDirTree($glimpseData);
                }
            }
            else
            {
                #
                #   Build up the list of known versions
                #
                foreach my $entry ( getReleaseVersions($vdirName) )
                {
                    push @{$ReleaseData{$rdirEntry}{Versions}}, $entry->{name};
                }
            }
        }
        else
        {
            $ReleaseData{$rdirEntry}{release}{LXRSTATE} = 'I';
            deleteAgeMarker($vdirName);

            #   Keep the last x created
            #   Note: Create time is a kludge
            #
            #   Process each version within the Release
            #
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
            my $keepCount = 0;
            foreach my $entry ( getReleaseVersions($vdirName) )
            {
                #DebugDumpData("Entry", $entry);
                $keepCount++;
                if ($keepCount > 5)
                {

    }
    close ($rdir);
}
 
#-------------------------------------------------------------------------------
# Function        : getReleaseVersions 
#
# Description     : Get the Versions in a Release
#
# Inputs          : $vdirName         - Path to process
#
# Returns         : A sorted array of data items (Most recent first)
#                   Each items consists of:
#                       {name}
#                       {path}
#                       {ctime}    
#
sub getReleaseVersions
{
    my ($vdirName) = @_;
    my @versionData;
 
    opendir (my $vdir, $vdirName) || Warning ("Cannot open directory: $vdirName", $!);
    while (my $vdirEntry = readdir($vdir))
    {
        #   Skip hidden files and directories
        next if ($vdirEntry =~ m~^\.~);
        my $ldirName = catdir($vdirName, $vdirEntry );
        next unless ( -d $ldirName );
        my $data;
        $data->{name} = $vdirEntry; 
        $data->{path} = $ldirName; 
        $data->{ctime} = (stat $ldirName)[9];
        push @versionData  , $data;
    }
    close ($vdir);
    #DebugDumpData("versionData",\@versionData);
 
    my @sortedList = sort { $b->{ctime} <=> $a->{ctime}} @versionData;
    #DebugDumpData("SortedVersionData",\@sortedList);
    return @sortedList;
}
 
 
#-------------------------------------------------------------------------------
# Function        : getLatestVersion 
#
# Description     : For a specified directory return the newest subdir
#
#                   Used to determine the most recent version

            mkpath($Config->{lxrLogDir}); 
            if (-d $Config->{lxrLogDir} )
            {
                open STDOUT, '>', $name  or die "Can't redirect STDOUT: $!";
                open STDERR, ">&STDOUT"  or die "Can't dup STDOUT: $!";
                STDOUT->autoflush(1);
                STDERR->autoflush(1);
            }
            else
            {
                Warning("Can't create log dir: $Config->{lxrLogDir}. $!");
            }

    if ($age == 0)
    {
        return 1;
    }
 
    #   Test for Age me now marker file
    my $purgefile = catfile($tdir, '.lxrPurge');
    if (-f $purgefile )
    {
        Verbose ("Age:  ForcedPurge $tdir");
        return 1;
    }
 
    #
    #   Create the file ONCE
    #
    my $markerfile = catfile($tdir, '.lxrAge');
    unless (-f $markerfile)

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)`

Subversion Repositories DevTools

(root)/lxr_manager/trunk/src/jats_lxr.pl – Rev 5247 → 5252