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



    #
    #DebugDumpData("ReleaseData", \%ReleaseData);
    foreach my $rtagid ( sort ReleaseDataSort keys %ReleaseData )
    {
        my $entry = $ReleaseData{$rtagid};
        $entry->{release}{LXRSTATE} = 'D' unless (exists $entry->{release}{LXRSTATE});
        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);
        my $stateTxt = $entry->{release}{ACTIVE} ? 'Active' : 'InActive';
        #$stateTxt .= ' [' . $entry->{release}{ACTIVE} . ']';
 
 
        my $tfileName = 'lxr.tree.template';
        open( my $tf, '<', $tfileName) || Error ("Cannot open $tfileName. $!");
        while (my $line = <$tf>)
        {

            $line =~ s~\@CAPTION\@~$entry->{release}{Project}::$entry->{release}{Name}~g;
            $line =~ s~\@SHORT_NAME\@~$rtagid~g;
            $line =~ s~\@RELEASE_ROOT\@~$entry->{release}{root}~g;
            $line =~ s~\@VERSIONS_LIST\@~$entry->{release}{VersionsString}~g;
            $line =~ s~\@DBNAME\@~$entry->{release}{dbName}~g;
            $line =~ s~\@STATE\@~$stateTxt~g;
            push @lxrTreeText, $line
        }
        close $tf;
    }
 

    #   Use a customized shell script to do the hard work
    #
    foreach my $rtagid ( sort keys %ReleaseData )
    {
        my $entry = $ReleaseData{$rtagid};
        next if ($entry->{release}{LXRSTATE} eq 'D');
        Verbose("Database:$entry->{release}{Name}, $entry->{release}{dbName} ");
        System('--NoExit', '--NoShell', catfile($scriptDir, 'lxr.initdb.sh'), $entry->{release}{dbName});
    }
}
 

#                   
#                   Place a marker file in the 'version' directory when the
#                   index has been created
#
#                   Notes:
#                   The 'genxref' program needs to be run from the lxr install directory
#                   chdir to that directory for each invocation
#
#                   genxref uses DBI - and must find the proper PERL DBI and not the one
#                   within JATS.. Solution:
#                       Kill the PERL5LIB EnvVar

            #   Process each version within the Release
            #
            my $keepCount = 0;
            foreach my $entry ( getReleaseVersions($vdirName) )
            {
                #DebugDumpData("$rdirEntry, getReleaseVersions:Entry", $entry);
                $keepCount++;
                if ($keepCount > 5)
                {
                    #   Version is no longer needed - remove it
                    #   Remove glimpse data too
                    Message("Delete Version: $rdirEntry, $entry->{name}, $entry->{ctime}");
                    RmDirTree($entry->{path});
                    if ( defined $Config->{glimpseDir} )
                    {
                        my $glimpseEntry = catdir( $Config->{glimpseDir}, $rdirEntry, $entry->{name} );
                        RmDirTree($glimpseEntry);
                    }
                }
                else
                {
                    #   Note which versions we have
                    push @{$ReleaseData{$rdirEntry}{Versions}}, $entry->{name};

            #
            #   Have just deleted the entry
            #
            if ($rentry->{LXRSTATE} eq 'D')
            {
                unless ($rentry->{lxr_state} eq 'N') {
                    simpleSqlExecute('updateReleaseManager',"DELETE from release_manager.lxr_state where rtag_id = " . $rtagid);
                }
            }
            elsif ($rentry->{LXRSTATE} eq 'C')
            {
                my $state = 'C';
                simpleSqlExecute('updateReleaseManager',"begin insert into release_manager.lxr_state (rtag_id, lxrserver) values ($rtagid, '$state'); exception when dup_val_on_index then update release_manager.lxr_state set lxrserver = '$state' where  rtag_id = $rtagid; end; ");

{
    my ($tdir, $age) = @_;
    
    unless (-d $tdir) {
        Warning ("Expected directory not found: $tdir");
        return 1; 
    }
 
    #   A configured age of 0 implies delete immediatly
    if ($age == 0)
    {

Rev 5252	Rev 5359
Line 540...	Line 540...
540	`#`	540	`#`
541	`#DebugDumpData("ReleaseData", \%ReleaseData);`	541	`#DebugDumpData("ReleaseData", \%ReleaseData);`
542	`foreach my $rtagid ( sort ReleaseDataSort keys %ReleaseData )`	542	`foreach my $rtagid ( sort ReleaseDataSort keys %ReleaseData )`
543	`{`	543	`{`
544	`my $entry = $ReleaseData{$rtagid};`	544	`my $entry = $ReleaseData{$rtagid};`
-		545	`$entry->{release}{LXRSTATE} = 'D' unless (exists $entry->{release}{LXRSTATE});`
545	`Information("Entry: $entry->{release}{Project}, $entry->{release}{Name}, $entry->{release}{LXRSTATE}, $rtagid");`	546	`Information("Entry: $entry->{release}{Project}, $entry->{release}{Name}, $entry->{release}{LXRSTATE}, $rtagid");`
546	`next if ($entry->{release}{LXRSTATE} eq 'D');`	547	`next if ($entry->{release}{LXRSTATE} eq 'D');`
-		548
547	`$entry->{release}{VersionsString} = join( ',', map { '"' . $_ .'"'} @{$entry->{Versions}} );`	549	`$entry->{release}{VersionsString} = join( ',', map { '"' . $_ .'"'} @{$entry->{Versions}} );`
548	`$entry->{release}{dbName} = genDatabaseName($rtagid);`	550	`$entry->{release}{dbName} = genDatabaseName($rtagid);`
549	`$entry->{release}{root} = catdir($ReleaseStore, $rtagid );`	551	`$entry->{release}{root} = catdir($ReleaseStore, $rtagid );`
550	`#DebugDumpData("ENTRY", \$entry);`	552	`#DebugDumpData("ENTRY", \$entry);`
-		553	`my $stateTxt = $entry->{release}{ACTIVE} ? 'Active' : 'InActive';`
-		554	`#$stateTxt .= ' [' . $entry->{release}{ACTIVE} . ']';`
-		555
551		556
552	`my $tfileName = 'lxr.tree.template';`	557	`my $tfileName = 'lxr.tree.template';`
553	`open( my $tf, '<', $tfileName) \|\| Error ("Cannot open $tfileName. $!");`	558	`open( my $tf, '<', $tfileName) \|\| Error ("Cannot open $tfileName. $!");`
554	`while (my $line = <$tf>)`	559	`while (my $line = <$tf>)`
555	`{`	560	`{`
Line 560...	Line 565...
560	`$line =~ s~\@CAPTION\@~$entry->{release}{Project}::$entry->{release}{Name}~g;`	565	`$line =~ s~\@CAPTION\@~$entry->{release}{Project}::$entry->{release}{Name}~g;`
561	`$line =~ s~\@SHORT_NAME\@~$rtagid~g;`	566	`$line =~ s~\@SHORT_NAME\@~$rtagid~g;`
562	`$line =~ s~\@RELEASE_ROOT\@~$entry->{release}{root}~g;`	567	`$line =~ s~\@RELEASE_ROOT\@~$entry->{release}{root}~g;`
563	`$line =~ s~\@VERSIONS_LIST\@~$entry->{release}{VersionsString}~g;`	568	`$line =~ s~\@VERSIONS_LIST\@~$entry->{release}{VersionsString}~g;`
564	`$line =~ s~\@DBNAME\@~$entry->{release}{dbName}~g;`	569	`$line =~ s~\@DBNAME\@~$entry->{release}{dbName}~g;`
-		570	`$line =~ s~\@STATE\@~$stateTxt~g;`
565	`push @lxrTreeText, $line`	571	`push @lxrTreeText, $line`
566	`}`	572	`}`
567	`close $tf;`	573	`close $tf;`
568	`}`	574	`}`
569		575
Line 613...	Line 619...
613	`# Use a customized shell script to do the hard work`	619	`# Use a customized shell script to do the hard work`
614	`#`	620	`#`
615	`foreach my $rtagid ( sort keys %ReleaseData )`	621	`foreach my $rtagid ( sort keys %ReleaseData )`
616	`{`	622	`{`
617	`my $entry = $ReleaseData{$rtagid};`	623	`my $entry = $ReleaseData{$rtagid};`
-		624	`next if ($entry->{release}{LXRSTATE} eq 'D');`
618	`Verbose("Database:$entry->{release}{Name}, $entry->{release}{dbName} ");`	625	`Verbose("Database:$entry->{release}{Name}, $entry->{release}{dbName} ");`
619	`System('--NoExit', '--NoShell', catfile($scriptDir, 'lxr.initdb.sh'), $entry->{release}{dbName});`	626	`System('--NoExit', '--NoShell', catfile($scriptDir, 'lxr.initdb.sh'), $entry->{release}{dbName});`
620	`}`	627	`}`
621	`}`	628	`}`
622		629
Line 628...	Line 635...
628	`#`	635	`#`
629	`# Place a marker file in the 'version' directory when the`	636	`# Place a marker file in the 'version' directory when the`
630	`# index has been created`	637	`# index has been created`
631	`#`	638	`#`
632	`# Notes:`	639	`# Notes:`
633	`# The 'genxref' program needs to be run from the lxr insatll directory`	640	`# The 'genxref' program needs to be run from the lxr install directory`
634	`# chdir to that directory for each invocation`	641	`# chdir to that directory for each invocation`
635	`#`	642	`#`
636	`# genxref uses DBI - and must find the proper PERL DBI and not the one`	643	`# genxref uses DBI - and must find the proper PERL DBI and not the one`
637	`# within JATS.. Solution:`	644	`# within JATS.. Solution:`
638	`# Kill the PERL5LIB EnvVar`	645	`# Kill the PERL5LIB EnvVar`
Line 762...	Line 769...
762	`# Process each version within the Release`	769	`# Process each version within the Release`
763	`#`	770	`#`
764	`my $keepCount = 0;`	771	`my $keepCount = 0;`
765	`foreach my $entry ( getReleaseVersions($vdirName) )`	772	`foreach my $entry ( getReleaseVersions($vdirName) )`
766	`{`	773	`{`
767	`#DebugDumpData("Entry", $entry);`	774	`#DebugDumpData("$rdirEntry, getReleaseVersions:Entry", $entry);`
768	`$keepCount++;`	775	`$keepCount++;`
769	`if ($keepCount > 5)`	776	`if ($keepCount > 5)`
770	`{`	777	`{`
771	`# Version is no longer needed - remove it`	778	`# Version is no longer needed - remove it`
-		779	`# Remove glimpse data too`
772	`Message("Delete Version: $rdirEntry, $entry->{name}, $entry->{ctime}");`	780	`Message("Delete Version: $rdirEntry, $entry->{name}, $entry->{ctime}");`
773	`RmDirTree($entry->{path});`	781	`RmDirTree($entry->{path});`
-		782	`if ( defined $Config->{glimpseDir} )`
-		783	`{`
-		784	`my $glimpseEntry = catdir( $Config->{glimpseDir}, $rdirEntry, $entry->{name} );`
-		785	`RmDirTree($glimpseEntry);`
-		786	`}`
774	`}`	787	`}`
775	`else`	788	`else`
776	`{`	789	`{`
777	`# Note which versions we have`	790	`# Note which versions we have`
778	`push @{$ReleaseData{$rdirEntry}{Versions}}, $entry->{name};`	791	`push @{$ReleaseData{$rdirEntry}{Versions}}, $entry->{name};`
Line 1169...	Line 1182...
1169	`#`	1182	`#`
1170	`# Have just deleted the entry`	1183	`# Have just deleted the entry`
1171	`#`	1184	`#`
1172	`if ($rentry->{LXRSTATE} eq 'D')`	1185	`if ($rentry->{LXRSTATE} eq 'D')`
1173	`{`	1186	`{`
-		1187	`unless ($rentry->{lxr_state} eq 'N') {`
1174	`simpleSqlExecute('updateReleaseManager',"DELETE from release_manager.lxr_state where rtag_id = " . $rtagid);`	1188	`simpleSqlExecute('updateReleaseManager',"DELETE from release_manager.lxr_state where rtag_id = " . $rtagid);`
-		1189	`}`
1175	`}`	1190	`}`
1176	`elsif ($rentry->{LXRSTATE} eq 'C')`	1191	`elsif ($rentry->{LXRSTATE} eq 'C')`
1177	`{`	1192	`{`
1178	`my $state = 'C';`	1193	`my $state = 'C';`
1179	`simpleSqlExecute('updateReleaseManager',"begin insert into release_manager.lxr_state (rtag_id, lxrserver) values ($rtagid, '$state'); exception when dup_val_on_index then update release_manager.lxr_state set lxrserver = '$state' where rtag_id = $rtagid; end; ");`	1194	`simpleSqlExecute('updateReleaseManager',"begin insert into release_manager.lxr_state (rtag_id, lxrserver) values ($rtagid, '$state'); exception when dup_val_on_index then update release_manager.lxr_state set lxrserver = '$state' where rtag_id = $rtagid; end; ");`
Line 1368...	Line 1383...
1368	`{`	1383	`{`
1369	`my ($tdir, $age) = @_;`	1384	`my ($tdir, $age) = @_;`
1370		1385
1371	`unless (-d $tdir) {`	1386	`unless (-d $tdir) {`
1372	`Warning ("Expected directory not found: $tdir");`	1387	`Warning ("Expected directory not found: $tdir");`
1373	`return 0;`	1388	`return 1;`
1374	`}`	1389	`}`
1375		1390
1376	`# A configured age of 0 implies delete immediatly`	1391	`# A configured age of 0 implies delete immediatly`
1377	`if ($age == 0)`	1392	`if ($age == 0)`
1378	`{`	1393	`{`

Subversion Repositories DevTools

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