WebSVN – DevTools – Diff – /dpkg_blat/trunk/src/blat/blatDaemon.pl



my $tagDirTime = 0;
my $lastDirScan = 0;
my $lastReleaseScan = 0;
my $releaseScanMode = 0;
my $lastTagListScan = 0;
 
my $mtimeConfig = 0;
my $conf;
my $extraPkgs;
my $excludePkgs;
my %releaseData;
my $comError = 0;
my $yday = -1;
my $RemotePkgList = {};
 
#
#   Contain statisics maintained while operating
#       Can be dumped with a kill -USR2
#       List here for documentation

{
    $logger->verbose3("Processing");
    $statistics{Cycle}++;
    $now = time();
 
 
    $statistics{phase} = 'ReadConfig';
    readConfig();
    if ( $conf->{'active'} )
    {
        $statistics{phase} = 'ProcessReleaseList';

    #
    #   Get list of packages from Remote site
    #   Invoke a program on the remote site and parse the results
    #
    #   Returned data looks like:
    #       Metadata avail="140100452"
    #       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"
 
    #       time="1497954104" GMT="Tue Jun 20 10:21:44 2017" pname="ERGissaccounts" pver="1.0.7178.mas" deleted="0"
    #
    my $remotePkgList;
    my $remoteData;
    my $ph;
    my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";

            }
        }
    }
    close ($ph);
    $logger->verbose("processReleaseList:End: $?");
    $RemotePkgList = $remotePkgList; 
 
    LogTxError ($?);
    if ( $? != 0 )
    {
        $logger->warn("Cannot retrieve package list: $?");
        $statistics{state} = 'No Remote Package List';

            }
        }
 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
        {
            #
            #   Take care not to create an entry into $remotePkgList->{$pname}{$pver}
            #   if it does not exist. Existence of {$pname}{$pver} is used later
            #
            my $tmtime = 0;
            if (exists($remotePkgList->{$pname}) && exists ($remotePkgList->{$pname}{$pver}) && exists ($remotePkgList->{$pname}{$pver}{time})) {
                $tmtime = $remotePkgList->{$pname}{$pver}{time};
            }
            $packageVersionCount++;
 
            # Package is present in both list
            my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));
            if ( $mtime == 0 )

sub transferPackage
{
    my ($pname, $pver, $plink ) = @_;
    my $rv = 0;
    $logger->logmsg("transferPackage: @_");
    my $startTime = time;
 
    #
    #   Do not transfer excluded files
    #
    if ( exists $excludePkgs->{$pname} )

    #   plink of 1 is not a symlink
    #
    $plink = undef if ( defined($plink) && $plink eq '1' );
 
    #
    #   If its known to be in the target archive, then we don't need to transfer it again
    #       It may have been transferred in this cycle
    #       It may have been in the archive anyway
    #
    if ( exists($RemotePkgList->{$pname}) && exists ($RemotePkgList->{$pname}{$pver})) {
 
        $logger->verbose("transferPackage: Already in archive");
	#$logger->logmsg("transferPackage: $pname, $pver : Already in archive");
        return 1;
    }
 
    my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
    unless ( -d $sfile )

        chomp;
        $logger->verbose2("transferPackage:Data: $_");
    }
    close ($ph);
    $logger->verbose("transferPackage:End: $?");
 
    #
    #   Display the size of the package
    #       Diagnostic use
    #
    #open ( $ph, "du -bs $sfile 2>/dev/null |" );
    #my $line = <$ph>;
    #$line =~ m/^([0-9]+)/;
    #$line = $1 || 0;
    #my $size = sprintf "%.3f", $line / 1024 / 1024 / 1024 ;
    #close $ph;
    #my $duration = time - $startTime;
    #$logger->logmsg("transferPackage:Stats: $pname, $pver, $size Gb, $duration Secs");
 
    if ( $? == 0 )
    {
        #
        #   Mark has having been transferred in the current cycle
        #
        $RemotePkgList->{$pname}{$pver}{transferred} = 1;
        $rv = 1;
        $statistics{txCount}++;
    }
    else
    {

    $logger->verbose("deletePackage:End: $?");
    if ( $? == 0 )
    {
        $rv = 1;
        $statistics{delCount}++;
        delete $RemotePkgList->{$pname}{$pver};
    }
    else
    {
        $logger->warn("deletePackage:Error: $pname, $pver, $?");
    }

#-------------------------------------------------------------------------------
# Function        : parsePkgList
#
# Description     : Parse one line from a pkgList
#                   Lines are multiple item="data" items
#                       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"
#
# Inputs          : $line                   - Line of data
#                   $hashp                  - Ref to hash to populate
#
# Returns         : A hash of data items

Rev 6098	Rev 6148
Line 51...	Line 51...
51	`my $tagDirTime = 0;`	51	`my $tagDirTime = 0;`
52	`my $lastDirScan = 0;`	52	`my $lastDirScan = 0;`
53	`my $lastReleaseScan = 0;`	53	`my $lastReleaseScan = 0;`
54	`my $releaseScanMode = 0;`	54	`my $releaseScanMode = 0;`
55	`my $lastTagListScan = 0;`	55	`my $lastTagListScan = 0;`
56	`my $transferred;`	-
57	`my $mtimeConfig = 0;`	56	`my $mtimeConfig = 0;`
58	`my $conf;`	57	`my $conf;`
59	`my $extraPkgs;`	58	`my $extraPkgs;`
60	`my $excludePkgs;`	59	`my $excludePkgs;`
61	`my %releaseData;`	60	`my %releaseData;`
62	`my $comError = 0;`	61	`my $comError = 0;`
63	`my $yday = -1;`	62	`my $yday = -1;`
-		63	`my $RemotePkgList = {};`
64		64
65	`#`	65	`#`
66	`# Contain statisics maintained while operating`	66	`# Contain statisics maintained while operating`
67	`# Can be dumped with a kill -USR2`	67	`# Can be dumped with a kill -USR2`
68	`# List here for documentation`	68	`# List here for documentation`
Line 165...	Line 165...
165	`{`	165	`{`
166	`$logger->verbose3("Processing");`	166	`$logger->verbose3("Processing");`
167	`$statistics{Cycle}++;`	167	`$statistics{Cycle}++;`
168	`$now = time();`	168	`$now = time();`
169		169
170	`$transferred = {};`	-
171	`$statistics{phase} = 'ReadConfig';`	170	`$statistics{phase} = 'ReadConfig';`
172	`readConfig();`	171	`readConfig();`
173	`if ( $conf->{'active'} )`	172	`if ( $conf->{'active'} )`
174	`{`	173	`{`
175	`$statistics{phase} = 'ProcessReleaseList';`	174	`$statistics{phase} = 'ProcessReleaseList';`
Line 337...	Line 336...
337	`#`	336	`#`
338	`# Get list of packages from Remote site`	337	`# Get list of packages from Remote site`
339	`# Invoke a program on the remote site and parse the results`	338	`# Invoke a program on the remote site and parse the results`
340	`#`	339	`#`
341	`# Returned data looks like:`	340	`# Returned data looks like:`
-		341	`# Metadata avail="140100452"`
342	`# 1141792602 GMT(Wed Mar 8 04:36:42 2006) [DL] ishieldmodules/11.5.0.cots`	342	`# time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"`
343	`#`	-
-		343	`# time="1497954104" GMT="Tue Jun 20 10:21:44 2017" pname="ERGissaccounts" pver="1.0.7178.mas" deleted="0"`
344	`#`	344	`#`
345	`my $remotePkgList;`	345	`my $remotePkgList;`
346	`my $remoteData;`	346	`my $remoteData;`
347	`my $ph;`	347	`my $ph;`
348	`my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";`	348	`my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";`
Line 369...	Line 369...
369	`}`	369	`}`
370	`}`	370	`}`
371	`}`	371	`}`
372	`close ($ph);`	372	`close ($ph);`
373	`$logger->verbose("processReleaseList:End: $?");`	373	`$logger->verbose("processReleaseList:End: $?");`
-		374	`$RemotePkgList = $remotePkgList;`
-		375
374	`LogTxError ($?);`	376	`LogTxError ($?);`
375	`if ( $? != 0 )`	377	`if ( $? != 0 )`
376	`{`	378	`{`
377	`$logger->warn("Cannot retrieve package list: $?");`	379	`$logger->warn("Cannot retrieve package list: $?");`
378	`$statistics{state} = 'No Remote Package List';`	380	`$statistics{state} = 'No Remote Package List';`
Line 578...	Line 580...
578	`}`	580	`}`
579	`}`	581	`}`
580		582
581	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`	583	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
582	`{`	584	`{`
-		585	`#`
-		586	`# Take care not to create an entry into $remotePkgList->{$pname}{$pver}`
-		587	`# if it does not exist. Existence of {$pname}{$pver} is used later`
-		588	`#`
-		589	`my $tmtime = 0;`
-		590	`if (exists($remotePkgList->{$pname}) && exists ($remotePkgList->{$pname}{$pver}) && exists ($remotePkgList->{$pname}{$pver}{time})) {`
583	`my $tmtime = $remotePkgList->{$pname}{$pver}{time} \|\| 0;`	591	`$tmtime = $remotePkgList->{$pname}{$pver}{time};`
-		592	`}`
584	`$packageVersionCount++;`	593	`$packageVersionCount++;`
585		594
586	`# Package is present in both list`	595	`# Package is present in both list`
587	`my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));`	596	`my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));`
588	`if ( $mtime == 0 )`	597	`if ( $mtime == 0 )`
Line 1200...	Line 1209...
1200	`sub transferPackage`	1209	`sub transferPackage`
1201	`{`	1210	`{`
1202	`my ($pname, $pver, $plink ) = @_;`	1211	`my ($pname, $pver, $plink ) = @_;`
1203	`my $rv = 0;`	1212	`my $rv = 0;`
1204	`$logger->logmsg("transferPackage: @_");`	1213	`$logger->logmsg("transferPackage: @_");`
-		1214	`my $startTime = time;`
1205		1215
1206	`#`	1216	`#`
1207	`# Do not transfer excluded files`	1217	`# Do not transfer excluded files`
1208	`#`	1218	`#`
1209	`if ( exists $excludePkgs->{$pname} )`	1219	`if ( exists $excludePkgs->{$pname} )`
Line 1228...	Line 1238...
1228	`# plink of 1 is not a symlink`	1238	`# plink of 1 is not a symlink`
1229	`#`	1239	`#`
1230	`$plink = undef if ( defined($plink) && $plink eq '1' );`	1240	`$plink = undef if ( defined($plink) && $plink eq '1' );`
1231		1241
1232	`#`	1242	`#`
-		1243	`# If its known to be in the target archive, then we don't need to transfer it again`
1233	`# If its been transferred in the current scan, then`	1244	`# It may have been transferred in this cycle`
1234	`# indicate that all is well`	1245	`# It may have been in the archive anyway`
1235	`#`	1246	`#`
1236	`if ( $transferred->{$pname}{$pver} )`	1247	`if ( exists($RemotePkgList->{$pname}) && exists ($RemotePkgList->{$pname}{$pver})) {`
1237	`{`	-
1238	`$logger->verbose("transferPackage: Already transferred");`	1248	`$logger->verbose("transferPackage: Already in archive");`
-		1249	`#$logger->logmsg("transferPackage: $pname, $pver : Already in archive");`
1239	`return 1;`	1250	`return 1;`
1240	`}`	1251	`}`
1241		1252
1242	`my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );`	1253	`my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );`
1243	`unless ( -d $sfile )`	1254	`unless ( -d $sfile )`
Line 1268...	Line 1279...
1268	`chomp;`	1279	`chomp;`
1269	`$logger->verbose2("transferPackage:Data: $_");`	1280	`$logger->verbose2("transferPackage:Data: $_");`
1270	`}`	1281	`}`
1271	`close ($ph);`	1282	`close ($ph);`
1272	`$logger->verbose("transferPackage:End: $?");`	1283	`$logger->verbose("transferPackage:End: $?");`
-		1284
-		1285	`#`
-		1286	`# Display the size of the package`
-		1287	`# Diagnostic use`
-		1288	`#`
-		1289	`#open ( $ph, "du -bs $sfile 2>/dev/null \|" );`
-		1290	`#my $line = <$ph>;`
-		1291	`#$line =~ m/^([0-9]+)/;`
-		1292	`#$line = $1 \|\| 0;`
-		1293	`#my $size = sprintf "%.3f", $line / 1024 / 1024 / 1024 ;`
-		1294	`#close $ph;`
-		1295	`#my $duration = time - $startTime;`
-		1296	`#$logger->logmsg("transferPackage:Stats: $pname, $pver, $size Gb, $duration Secs");`
-		1297
1273	`if ( $? == 0 )`	1298	`if ( $? == 0 )`
1274	`{`	1299	`{`
1275	`#`	1300	`#`
1276	`# Mark has having been transferred in the current cycle`	1301	`# Mark has having been transferred in the current cycle`
1277	`#`	1302	`#`
1278	`$transferred->{$pname}{$pver} = 1;`	1303	`$RemotePkgList->{$pname}{$pver}{transferred} = 1;`
1279	`$rv = 1;`	1304	`$rv = 1;`
1280	`$statistics{txCount}++;`	1305	`$statistics{txCount}++;`
1281	`}`	1306	`}`
1282	`else`	1307	`else`
1283	`{`	1308	`{`
Line 1327...	Line 1352...
1327	`$logger->verbose("deletePackage:End: $?");`	1352	`$logger->verbose("deletePackage:End: $?");`
1328	`if ( $? == 0 )`	1353	`if ( $? == 0 )`
1329	`{`	1354	`{`
1330	`$rv = 1;`	1355	`$rv = 1;`
1331	`$statistics{delCount}++;`	1356	`$statistics{delCount}++;`
-		1357	`delete $RemotePkgList->{$pname}{$pver};`
1332	`}`	1358	`}`
1333	`else`	1359	`else`
1334	`{`	1360	`{`
1335	`$logger->warn("deletePackage:Error: $pname, $pver, $?");`	1361	`$logger->warn("deletePackage:Error: $pname, $pver, $?");`
1336	`}`	1362	`}`
Line 1361...	Line 1387...
1361	`#-------------------------------------------------------------------------------`	1387	`#-------------------------------------------------------------------------------`
1362	`# Function : parsePkgList`	1388	`# Function : parsePkgList`
1363	`#`	1389	`#`
1364	`# Description : Parse one line from a pkgList`	1390	`# Description : Parse one line from a pkgList`
1365	`# Lines are multiple item="data" items`	1391	`# Lines are multiple item="data" items`
-		1392	`# time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"`
1366	`#`	1393	`#`
1367	`# Inputs : $line - Line of data`	1394	`# Inputs : $line - Line of data`
1368	`# $hashp - Ref to hash to populate`	1395	`# $hashp - Ref to hash to populate`
1369	`#`	1396	`#`
1370	`# Returns : A hash of data items`	1397	`# Returns : A hash of data items`

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatDaemon.pl – Rev 6098 → 6148