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

Rev	Author	Line No.	Line
1038	dpurdie	1	`#! /usr/bin/perl`
		2	`########################################################################`
		3	`# Copyright (C) 2011 Vix-ERG Limited, All rights reserved`
		4	`#`
		5	`# Module name : blatDaemon.pl`
		6	`# Module type :`
		7	`# Compiler(s) : Perl`
		8	`# Environment(s):`
		9	`#`
		10	`# Description :`
		11	`#`
		12	`# Usage : ARGV[0] - Path to config file for this instance`
		13	`#`
		14	`#......................................................................#`
		15
		16	`require 5.008_002;`
		17	`use strict;`
		18	`use warnings;`
		19	`use Getopt::Long;`
		20	`use File::Basename;`
1040	dpurdie	21	`use Data::Dumper;`
		22	`use File::Spec::Functions;`
1038	dpurdie	23	`use POSIX ":sys_wait_h";`
		24	`use File::Temp qw/tempfile/;`
		25
		26	`use FindBin; # Determine the current directory`
		27	`use lib "$FindBin::Bin/lib"; # Allow local libraries`
		28
		29	`use Utils;`
		30	`use StdLogger; # Log to sdtout`
		31	`use Logger; # Log to file`
		32
		33	`#`
		34	`# Database interface`
		35	`# Pinched from jats and modified so that this software is not dependent on JATS`
		36	`#`
		37	`use IO::Handle;`
		38	`use JatsRmApi;`
		39	`use DBI;`
		40
		41	`#`
		42	`# Globals`
		43	`#`
		44	`my $logger = StdLogger->new(); # Stdout logger. Only during config`
		45	`my $name = basename( $ARGV[0]);`
		46	`$name =~ s~.conf$~~;`
		47	`my $now = 0;`
3515	dpurdie	48	`my $tar = 'tar';`
		49	`my $gzip = 'gzip';`
1038	dpurdie	50	`my $tagDirTime = 0;`
		51	`my $lastDirScan = 0;`
		52	`my $lastReleaseScan = 0;`
1040	dpurdie	53	`my $releaseScanMode = 0;`
		54	`my $lastTagListScan = 0;`
1038	dpurdie	55	`my $transferred;`
		56	`my $mtimeConfig = 0;`
		57	`my $conf;`
		58	`my $extraPkgs;`
1040	dpurdie	59	`my $excludePkgs;`
		60	`my %releaseData;`
3515	dpurdie	61	`my $comError = 0;`
1038	dpurdie	62
		63	`#`
		64	`# Describe config uration parameters`
		65	`#`
		66	`my %cdata = (`
		67	`'.ignore' => {'pkg\.(.+)' => 'pkgs' },`
1048	dpurdie	68	`'piddir' => {'mandatory' => 1 , 'fmt' => 'dir'},`
		69	`'sleep' => {'default' => 5 , 'fmt' => 'period'},`
		70	`'dpkg_archive' => {'mandatory' => 1 , 'fmt' => 'dir'},`
		71	`'logfile' => {'mandatory' => 1 , 'fmt' => 'vfile'},`
		72	`'logfile.size' => {'default' => '1M' , 'fmt' => 'size'},`
		73	`'logfile.count' => {'default' => 9 , 'fmt' => 'int'},`
		74	`'verbose' => {'default' => 0 , 'fmt' => 'int'},`
		75	`'user' => {'mandatory' => 1 , 'fmt' => 'text'},`
		76	`'hostname' => {'mandatory' => 1 , 'fmt' => 'text'},`
		77	`'identity' => {'mandatory' => 1 , 'fmt' => 'file'},`
		78	`'bindir' => {'mandatory' => 1 , 'fmt' => 'text'},`
		79	`'tagdir' => {'mandatory' => 1 , 'fmt' => 'dir'},`
		80	`'forcedirscan' => {'default' => 100 , 'fmt' => 'period'},`
		81	`'tagage' => {'default' => '10m' , 'fmt' => 'period'},`
		82	`'tagListUpdate' => {'default' => '1h' , 'fmt' => 'period'},`
		83	`'synctime' => {'default' => '2h' , 'fmt' => 'period'},`
		84	`'syncretry' => {'default' => '5m' , 'fmt' => 'period'},`
		85	`'allProjects' => {'default' => 0 , 'fmt' => 'bool'},`
		86	`'project' => {'mandatory' => 0 , 'fmt' => 'int_list'},`
		87	`'release' => {'mandatory' => 0 , 'fmt' => 'int_list'},`
		88	`'writewindow' => {'default' => '3h' , 'fmt' => 'period'},`
		89	`'maxpackages' => {'default' => 5 , 'fmt' => 'int'},`
		90	`'deletePackages' => {'default' => 0 , 'fmt' => 'bool'},`
		91	`'deleteImmediate' => {'default' => 0 , 'fmt' => 'bool'},`
		92	`'deleteAge' => {'default' => 0 , 'fmt' => 'period'},`
		93	`'packageFilter' => {'default' => undef , 'fmt' => 'text'},`
		94	`'active' => {'default' => 1 , 'fmt' => 'bool'},`
1038	dpurdie	95	`);`
		96
		97
		98	`#`
		99	`# Read in the configuration`
		100	`# Set up a logger`
		101	`# Write a pidfile - thats not used`
		102	`readConfig();`
		103	`Utils::writepid($conf);`
		104	`$logger->logmsg("Starting...");`
		105	`sighandlers($conf);`
		106
		107	`#`
		108	`# Main processing loop`
		109	`# Will exit when terminated by parent`
		110	`#`
		111	`while ( 1 )`
		112	`{`
		113	`$logger->verbose3("Processing");`
		114	`$now = time();`
1040	dpurdie	115
1038	dpurdie	116	`$transferred = {};`
		117	`readConfig();`
1048	dpurdie	118	`if ( $conf->{'active'} )`
		119	`{`
		120	`processReleaseList();`
		121	`processTags();`
		122	`maintainTagList();`
		123	`}`
1040	dpurdie	124	`%releaseData = ();`
		125
1038	dpurdie	126	`sleep( $conf->{'sleep'} );`
1050	dpurdie	127
		128	`#`
		129	`# Reap any and all dead children`
		130	`#`
		131	`my $kid;`
		132	`do {`
		133	`$kid = waitpid(-1, WNOHANG);`
		134	`} while ( $kid > 0 );`
1038	dpurdie	135	`}`
		136	`$logger->logmsg("Child End");`
		137	`exit 0;`
		138
		139	`#-------------------------------------------------------------------------------`
		140	`# Function : readConfig`
		141	`#`
		142	`# Description : Re read the config file if it modification time has changed`
		143	`#`
		144	`# Inputs : Nothing`
		145	`#`
1289	dpurdie	146	`# Returns : 0 - Config not read`
		147	`# 1 - Config read`
		148	`# Config file has changed`
1038	dpurdie	149	`#`
		150	`sub readConfig`
		151	`{`
		152	`my ($mtime) = Utils::mtime($ARGV[0]);`
1289	dpurdie	153	`my $rv = 0;`
		154
1038	dpurdie	155	`if ( $mtimeConfig != $mtime )`
		156	`{`
		157	`$logger->logmsg("Reading config file: $ARGV[0]");`
		158	`$mtimeConfig = $mtime;`
		159	`my $errors;`
		160	`($conf, $errors) = Utils::readconf ( $ARGV[0], \%cdata );`
		161	`if ( scalar @{$errors} > 0 )`
		162	`{`
		163	`warn "$_\n" foreach (@{$errors});`
		164	`die ("Config contained errors\n");`
		165	`}`
		166
		167	`#`
		168	`# Reset some information`
		169	`# Create a new logger`
		170	`#`
		171	`$logger = Logger->new($conf);`
		172	`$conf->{logger} = $logger;`
		173	`$conf->{'pidfile'} = $conf->{'piddir'} . '/' . $name . '.pid';`
		174	`$logger->verbose("Log Levl: $conf->{verbose}");`
		175
		176	`#`
		177	`# Extract extra package config`
		178	`#`
		179	`$extraPkgs = {};`
1040	dpurdie	180	`$excludePkgs = {};`
1038	dpurdie	181	`while (my($key, $data) = each ( %{$conf->{pkgs}} ))`
		182	`{`
1040	dpurdie	183	`if ( $data eq 'EXCLUDE' )`
		184	`{`
		185	`$excludePkgs->{$key} = 1;`
		186	`$logger->verbose("Exclude Pkg: $key");`
		187	`}`
		188	`else`
		189	`{`
		190	`$extraPkgs->{$key}{$data} = 1;`
		191	`$logger->verbose("Extra Pkg: $key -> $data");`
		192	`}`
1038	dpurdie	193	`}`
1046	dpurdie	194
1048	dpurdie	195	`$logger->verbose("Filter Packages: " . $conf->{'packageFilter'})`
		196	`if ( defined $conf->{'packageFilter'} );`
		197
		198	`$logger->warn("Transfer session configured as not active")`
		199	`unless ( $conf->{'active'} );`
		200
		201	`$logger->warn("Transfer all projects packages")`
1050	dpurdie	202	`if ( $conf->{'allProjects'} );`
1048	dpurdie	203
1046	dpurdie	204	`#`
		205	`# When config is read force some actions`
		206	`# - Force tagList to be created`
1050	dpurdie	207	`# - Force release scan`
1048	dpurdie	208	`$lastTagListScan = 0;`
1050	dpurdie	209	`$lastReleaseScan = 0;`
1289	dpurdie	210	`$rv = 1;`
1038	dpurdie	211	`}`
1289	dpurdie	212	`return $rv;`
1038	dpurdie	213	`}`
		214
		215
		216	`#-------------------------------------------------------------------------------`
		217	`# Function : processReleaseList`
		218	`#`
		219	`# Description : Process the release list`
		220	`# Determine if its time to process release list`
		221	`# Determine release list`
		222	`# Determine release content`
		223	`# Determine new items`
		224	`#`
		225	`# Inputs : None`
		226	`#`
		227	`# Returns : Nothing`
		228	`#`
		229	`sub processReleaseList`
		230	`{`
		231	`#`
1044	dpurdie	232	`# Is Release List Processing active`
		233	`# Can configure blat to disable release sync`
		234	`# This will then allow 'new' packages to be sent`
		235	`#`
		236	`if ( $conf->{maxpackages} == 0 \|\| $conf->{'synctime'} <= 0)`
		237	`{`
		238	`$logger->verbose2("processReleaseList disabled");`
		239	`return;`
		240	`}`
		241
		242	`#`
1038	dpurdie	243	`# Time to perform the scan`
		244	`# Will do at startup and every time period there after`
		245	`#`
1040	dpurdie	246	`my $wtime = $releaseScanMode ? $conf->{'syncretry'} : $conf->{'synctime'};`
		247	`return unless ( $now > ($lastReleaseScan + $wtime ));`
1038	dpurdie	248	`$logger->verbose("processReleaseList");`
		249	`$lastReleaseScan = $now;`
1040	dpurdie	250	`$releaseScanMode = 1; # Assume error`
1038	dpurdie	251
		252	`#`
		253	`# Get list of packages from Remote site`
		254	`# Invoke a program on the remote site and parse the results`
		255	`#`
		256	`# Returned data looks like:`
1042	dpurdie	257	`# 1141792602 GMT(Wed Mar 8 04:36:42 2006) [DL] ishieldmodules/11.5.0.cots`
1038	dpurdie	258	`#`
		259	`#`
		260	`my $remotePkgList;`
		261	`my $ph;`
1040	dpurdie	262	`my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";`
3515	dpurdie	263	`my $ssh_cmd = sshCmd($tgt_cmd);`
1038	dpurdie	264
		265	`$logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");`
		266	`open ($ph, "$ssh_cmd \|");`
		267	`while ( <$ph> )`
		268	`{`
		269	`chomp;`
1042	dpurdie	270	`if ( parsePkgList($_, \%{$remotePkgList} ) )`
1038	dpurdie	271	`{`
		272	`$logger->verbose2("processReleaseList:Data: $_");`
		273	`}`
		274	`else`
		275	`{`
		276	`$logger->warn("processReleaseList:Bad Data: $_");`
		277	`}`
		278	`}`
		279	`close ($ph);`
		280	`$logger->verbose("processReleaseList:End: $?");`
3515	dpurdie	281	`LogTxError ($?);`
1038	dpurdie	282	`if ( $? != 0 )`
		283	`{`
		284	`$logger->warn("Cannot retrieve package list: $?");`
		285	`return;`
		286	`}`
3515	dpurdie	287
1042	dpurdie	288	`#Utils::DebugDumpData ("remotePkgList", $remotePkgList);`
		289
1038	dpurdie	290
		291	`#`
		292	`# Determine the set of packages in the releases to be transferred`
		293	`# Examine`
		294	`#`
		295	`my @rlist = getReleaseList();`
1040	dpurdie	296	`unless ( @rlist )`
		297	`{`
		298	`$logger->verbose2("No Releases to Process");`
		299	`return;`
		300	`}`
1038	dpurdie	301	`my $pkgList = getPkgList(@rlist);`
		302
		303	`#`
		304	`# Append extra packages`
		305	`# These are packages that are specifically named by the user`
		306	`#`
		307	`# Note: If there are symbolic links, then the target of the`
		308	`# link is treated used as the package name`
		309	`#`
		310	`# Symlink MUST be within the same directory`
		311	`#`
		312	`# Used to transfer jats2_current`
		313	`#`
		314	`my $pkgLink;`
		315	`while ( (my ($pname, $pvers)) = each %{$extraPkgs} ) {`
		316	`while ( (my ($pver, $pdata) ) = each %{$pvers} ) {`
		317
1040	dpurdie	318	`my $epath = catfile( $conf->{'dpkg_archive'} , $pname, $pver );`
1038	dpurdie	319	`if ( -l $epath )`
		320	`{`
		321	`my $lver = readlink( $epath );`
		322	`if ( ! defined $lver )`
		323	`{`
		324	`$logger->warn("Cant resolve symlink: $pname, $pver");`
		325	`next;`
		326	`}`
		327
		328	`if ( $lver =~ m ~/~ )`
		329	`{`
		330	`$logger->warn("Won't resolve symlink: $pname, $pver, $lver");`
		331	`next;`
		332	`}`
		333	`$pkgLink->{$pname}{$pver} = $lver;`
		334	`$pdata = $pver;`
		335	`$pver = $lver;`
		336	`}`
		337
		338	`$logger->verbose2("Add extra package: $pname, $pver, $pdata");`
		339	`$pkgList->{$pname}{$pver} = $pdata;`
		340	`}`
		341	`}`
		342
1040	dpurdie	343	`#`
		344	`# If there are no packages to process, then assume that this is an error`
		345	`# condition. Retry the operation soon.`
		346	`#`
		347	`unless ( keys %{$pkgList} )`
		348	`{`
		349
		350	`$logger->verbose2("No packages to process");`
		351	`return;`
		352	`}`
		353
1038	dpurdie	354	`# while ( (my ($pname, $pvers)) = each %{$pkgList} )`
		355	`# {`
		356	`# while ( (my ($pver, $ptime) ) = each %{$pvers} )`
		357	`# {`
		358	`# print "L-- $pname, $pver, $ptime \n";`
		359	`#`
		360	`# }`
		361	`# }`
		362
		363	`#`
1040	dpurdie	364	`# Delete Excess Packages`
1038	dpurdie	365	`# Packages not required on the target`
1042	dpurdie	366	`# KLUDGE: Don't delete links to packages`
		367	`# Don't delete packages marked for deletion`
1038	dpurdie	368	`#`
		369	`my $excessPkgList;`
1048	dpurdie	370	`my $excessPkgListCount = 0;`
1038	dpurdie	371	`if ( $conf->{deletePackages} )`
		372	`{`
		373	`while ( (my ($pname, $pvers)) = each %{$remotePkgList} )`
		374	`{`
		375	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		376	`{`
		377	`if ( !exists $pkgList->{$pname}{$pver} )`
		378	`{`
		379	`if ( exists $pkgLink->{$pname}{$pver} )`
		380	`{`
		381	`$logger->verbose2("Keep Excess package-link: ${pname}/${pver}");`
		382	`next;`
		383	`}`
1040	dpurdie	384
		385	`if ( exists $excludePkgs->{$pname} )`
		386	`{`
		387	`$logger->verbose2("Keep Excluded package: ${pname}");`
		388	`next;`
		389	`}`
		390
1042	dpurdie	391	`if ( exists $pdata->{deleted} )`
		392	`{`
		393	`if ( $conf->{deleteAge} )`
		394	`{`
		395	`if ( $pdata->{deleted} <= $conf->{deleteAge} )`
		396	`{`
		397	`$logger->verbose2("Already marked for future age deletion: ${pname}/${pver}, $pdata->{deleted}");`
		398	`next;`
		399	`}`
		400	`$pdata->{FORCEDELETE} = 1;`
		401	`}`
		402
		403	`if ( !$conf->{deleteImmediate} )`
		404	`{`
		405	`$logger->verbose2("Already marked for deletion: ${pname}/${pver}");`
		406	`next;`
		407	`}`
		408	`}`
		409
		410	`#`
		411	`# Force deletion`
		412	`# deleteImmediate mode`
		413	`# target is a broken link`
		414	`#`
		415	`$pdata->{FORCEDELETE} = 1`
		416	`if ($conf->{deleteImmediate} \|\| $pdata->{broken});`
		417
1038	dpurdie	418	`$excessPkgList->{$pname}{$pver} = $pdata;`
1048	dpurdie	419	`$excessPkgListCount++;`
1038	dpurdie	420	`$logger->verbose("Excess package: ${pname}/${pver}");`
		421	`}`
1050	dpurdie	422	`# else`
		423	`# {`
		424	`# $logger->verbose3("Retain package: ${pname}/${pver}");`
		425	`# }`
1038	dpurdie	426	`}`
		427	`}`
		428	`}`
		429
		430	`#`
		431	`# Process the remote list and the local list`
		432	`# The remote time-stamp is the modification time of the packages descpkg file`
		433	`#`
		434	`# Mark for transfer packages that`
1040	dpurdie	435	`# Are in the local set but not the remote set`
1038	dpurdie	436	`# Have a different time stamp`
		437	`#`
		438	`# Ignore packages not in the local archive`
		439	`# Ignore packages that don't have a descpkg`
		440	`# Ignore packages that are writable - still being formed`
		441	`#`
		442	`my $needPkgList;`
1048	dpurdie	443	`my $needPkgListCount = 0;`
		444	`my $filteredCount = 0;`
		445	`my $missingCount = 0;`
		446	`my $writableCount = 0;`
		447	`my $excludeCount = 0;`
1038	dpurdie	448	`while ( (my ($pname, $pvers)) = each %{$pkgList} )`
		449	`{`
1040	dpurdie	450	`#`
		451	`# Ignore excluded packages`
		452	`#`
1048	dpurdie	453	`if ( exists $excludePkgs->{$pname} )`
		454	`{`
		455	`$excludeCount++;`
		456	`next;`
		457	`}`
1040	dpurdie	458
1048	dpurdie	459	`#`
		460	`# Ignore packages that are filtered out`
		461	`#`
		462	`if ( defined $conf->{'packageFilter'} )`
		463	`{`
		464	`unless ( $pname =~ m~$conf->{'packageFilter'}~ )`
		465	`{`
		466	`$logger->verbose3("Filtering out: ${pname}");`
		467	`$filteredCount++;`
		468	`next;`
		469	`}`
		470	`}`
		471
1038	dpurdie	472	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		473	`{`
1042	dpurdie	474	`my $tmtime = $remotePkgList->{$pname}{$pver}{time} \|\| 0;`
1038	dpurdie	475
		476	`# Package is present in both list`
1040	dpurdie	477	`my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));`
1038	dpurdie	478	`if ( $mtime == 0 )`
		479	`{`
		480	`# PackageVersion not in local archive (at least the descpkg file is not)`
		481	`# Skip now - will pick it up later`
		482	`$logger->verbose("Package not in dpkg_archive: $pname, $pver");`
1048	dpurdie	483	`$missingCount++;`
1038	dpurdie	484	`next;`
		485	`}`
		486
		487	`if ( $mode & 0222 )`
		488	`{`
		489	`# Descpkg file is writable`
		490	`# Package may be in the process of being created`
1048	dpurdie	491	`# If the package has been writable for a long time, then`
1038	dpurdie	492	`# consider for transfer`
		493	`my $age = $now - $mtime;`
		494	`if ( $age < ($conf->{'writewindow '} \|\| 600) )`
		495	`{`
		496	`$logger->verbose("Package is writable: $pname, $pver, ", $now - $mtime);`
1048	dpurdie	497	`$writableCount++;`
1038	dpurdie	498	`next;`
		499	`}`
		500	`}`
		501
		502	`if ( $mtime != $tmtime )`
		503	`{`
		504	`# Package not present on target, or timestamps differ`
		505	`$logger->verbose("Package Needs to be transferred: $pname, $pver, $mtime, $tmtime");`
		506	`$needPkgList->{$pname}{$pver} = $pdata;`
1048	dpurdie	507	`$needPkgListCount++;`
1038	dpurdie	508	`next;`
		509	`}`
		510	`}`
		511	`}`
		512
1048	dpurdie	513
1038	dpurdie	514	`#`
		515	`# Debug output only`
		516	`# Display what we need to transfer`
		517	`#`
		518	`if ( $conf->{verbose} > 2 )`
		519	`{`
		520	`while ( (my ($pname, $pvers)) = each %{$needPkgList} )`
		521	`{`
		522	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		523	`{`
		524	`$logger->verbose("Need to transfer: $pname, $pver, $pdata");`
		525	`}`
		526	`}`
		527	`}`
1048	dpurdie	528	`if ( $conf->{verbose} )`
		529	`{`
		530	`$logger->verbose("Packages to transfer: $needPkgListCount");`
		531	`$logger->verbose("Packages to delete: $excessPkgListCount");`
		532	`$logger->verbose("Packages filtered out: $filteredCount");`
		533	`$logger->verbose("Packages missing: $missingCount");`
		534	`$logger->verbose("Packages still writable: $writableCount");`
		535	`$logger->verbose("Packages excluded: $excludeCount");`
		536	`}`
1038	dpurdie	537
		538	`#`
		539	`# Time to do the real work`
		540	`# Transfer packages and delete excess packages`
		541	`# Note: Perform the transfers first`
		542	`# Limit the number of packages processed in one pass`
		543	`#`
		544	`my $txcount = $conf->{maxpackages};`
		545
		546	`#`
		547	`# Transfer packages that we have identified`
		548	`#`
		549	`send_pkgs:`
		550	`while ( (my ($pname, $pvers)) = each %{$needPkgList} )`
		551	`{`
		552	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		553	`{`
		554	`if ( --$txcount <= 0 )`
		555	`{`
1050	dpurdie	556	`$logger->warn("Max transfer count exceeded: $needPkgListCount transfer remaining");`
1038	dpurdie	557	`$lastReleaseScan = 0;`
		558	`last send_pkgs;`
		559	`}`
1289	dpurdie	560
		561	`if ( readConfig() )`
		562	`{`
		563	`$logger->warn("Config file changed");`
		564	`$lastReleaseScan = 0;`
		565	`$txcount = 0;`
		566	`last send_pkgs;`
		567	`}`
		568
1044	dpurdie	569	`transferPackage ($pname, $pver, $pdata);`
1048	dpurdie	570	`$needPkgListCount--;`
1038	dpurdie	571	`}`
		572	`}`
		573
		574	`#`
		575	`# Delete packages that have been identified as excess`
		576	`#`
		577	`delete_pkgs:`
		578	`while ( (my ($pname, $pvers)) = each %{$excessPkgList} )`
		579	`{`
		580	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		581	`{`
		582	`if ( --$txcount <= 0 )`
		583	`{`
1050	dpurdie	584	`$logger->warn("Max transfer count exceeded: $excessPkgListCount deletion remaining");`
1038	dpurdie	585	`$lastReleaseScan = 0;`
		586	`last delete_pkgs;`
		587	`}`
1289	dpurdie	588
		589	`if ( readConfig() )`
		590	`{`
		591	`$logger->warn("Config file changed");`
		592	`$lastReleaseScan = 0;`
		593	`$txcount = 0;`
		594	`last send_pkgs;`
		595	`}`
		596
1044	dpurdie	597	`deletePackage ($pname, $pver, $pdata);`
1048	dpurdie	598	`$excessPkgListCount--;`
1038	dpurdie	599	`}`
		600	`}`
		601
		602	`#`
		603	`# Send package list to the target`
		604	`#`
		605	`sendPackageList ($pkgList);`
1040	dpurdie	606
		607	`#`
		608	`# On a successful transfer`
		609	`# Force tag processing`
		610	`# Set scan Mode to normal`
		611	`#`
		612	`$tagDirTime = 0;`
		613	`$releaseScanMode = 0;`
1038	dpurdie	614	`}`
		615
		616	`#-------------------------------------------------------------------------------`
		617	`# Function : sendPackageList`
		618	`#`
		619	`# Description : Transfer package list to the target`
		620	`#`
		621	`# Inputs : $pkgList - Ref to hash of package names and versions`
		622	`#`
1040	dpurdie	623	`# Returns : Nothing`
		624	`# Don't really care about any errors from this process`
		625	`# Its not essential`
1038	dpurdie	626	`#`
		627	`sub sendPackageList`
		628	`{`
		629	`my ($pkgList) = @_;`
		630	`my ($fh, $filename) = tempfile( "/tmp/blat.$$.XXXX", SUFFIX => '.txt');`
		631	`$logger->verbose("sendPackageList:TmpFile: $filename");`
		632
		633	`#`
		634	`# Create a temp file with data`
		635	`#`
		636	`foreach my $pname ( sort keys %{$pkgList} )`
		637	`{`
		638	`foreach my $pver ( sort keys %{$pkgList->{$pname}} )`
		639	`{`
		640	`print $fh "$pname/$pver\n";`
		641	`}`
		642	`}`
		643	`close $fh;`
		644
		645	`#`
		646	`# Transfer to target`
		647	`# Create the process pipe to transfer the file`
		648	`# gzip the file and pipe the result through a ssh session to the target machine`
3515	dpurdie	649	`# gzip -c filename \| ssh ... "./receive_file filename"`
1038	dpurdie	650	`#`
		651	`my $ph;`
3515	dpurdie	652	`my $gzip_cmd = "$gzip --no-name -c \"$filename\"";`
1040	dpurdie	653	`my $tgt_cmd = "$conf->{'bindir'}/receive_file \"ArchiveList\"";`
3515	dpurdie	654	`my $ssh_cmd = sshCmd($tgt_cmd);`
1038	dpurdie	655
		656	`$logger->verbose2("sendPackageList:gzip_cmd:$gzip_cmd");`
		657	`$logger->verbose2("sendPackageList:tgt_cmd:$tgt_cmd");`
		658	`$logger->verbose2("sendPackageList:ssh_cmd:$ssh_cmd");`
		659
		660	`open ($ph, "$gzip_cmd \| $ssh_cmd \|");`
		661	`while ( <$ph> )`
		662	`{`
		663	`chomp;`
		664	`$logger->verbose2("sendPackageList:Data: $_");`
		665	`}`
		666	`close ($ph);`
3515	dpurdie	667	`unlink $filename;`
1038	dpurdie	668	`$logger->verbose("sendPackageList:End: $?");`
3515	dpurdie	669	`LogTxError ($?);`
1038	dpurdie	670	`}`
		671
		672
		673	`#-------------------------------------------------------------------------------`
		674	`# Function : getPkgList`
		675	`#`
		676	`# Description : Determine a set of package versions within the list`
		677	`# of provided releases`
		678	`#`
		679	`# Inputs : @rlist - A list of releases to examine`
		680	`#`
		681	`# Returns : Ref to a hask of package versions`
		682	`#`
		683	`sub getPkgList`
		684	`{`
		685	`my %pdata;`
		686	`my $RM_DB;`
		687	`connectRM(\$RM_DB);`
		688	`$logger->verbose("getPkgList");`
		689
		690	`#`
		691	`# Determine the releases that are in this project`
		692	`# Build up an sql query`
		693	`#`
		694	`my @m_rlist;`
		695	`push @m_rlist,"rc.RTAG_ID=$_" foreach ( @_ );`
		696	`my $m_rlist = join ' OR ', @m_rlist;`
1048	dpurdie	697	`my $m_sqlstr = "SELECT DISTINCT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.IS_DEPLOYABLE" .`
1038	dpurdie	698	`" FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .`
		699	`" WHERE ( $m_rlist ) AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .`
		700	`" ORDER by PKG_NAME DESC";`
		701	`$logger->verbose3("getPkgList:Sql:$m_sqlstr");`
		702
		703	`my $sth = $RM_DB->prepare($m_sqlstr);`
		704	`if ( defined($sth) )`
		705	`{`
		706	`if ( $sth->execute( ) )`
		707	`{`
		708	`if ( $sth->rows )`
		709	`{`
		710	`while (my @row = $sth->fetchrow_array )`
		711	`{`
		712	`$logger->verbose2("getPkgList:Data:@row");`
		713	`$pdata{$row[1]}{$row[2]} = 1;`
		714	`}`
		715	`}`
		716	`$sth->finish();`
		717	`}`
		718	`}`
		719	`else`
		720	`{`
		721	`$logger->warn("getPkgList: SQL Prepare failure");`
		722	`}`
1050	dpurdie	723
		724	`disconnectRM(\$RM_DB);`
1038	dpurdie	725	`return \%pdata;`
		726	`}`
		727
		728
		729	`#-------------------------------------------------------------------------------`
		730	`# Function : getReleaseList`
		731	`#`
		732	`# Description : Determine the list of releases to be proccessed`
1040	dpurdie	733	`# From:`
		734	`# Convert projects to a list of releases`
		735	`# Configured list of releases`
1038	dpurdie	736	`#`
		737	`# Inputs : None`
		738	`#`
		739	`# Returns : A list of releases to be processed`
		740	`#`
		741	`sub getReleaseList`
		742	`{`
		743	`my $RM_DB;`
		744	`my %rlist;`
1048	dpurdie	745	`my $m_sqlstr;`
1038	dpurdie	746	`$logger->verbose("getReleaseList");`
		747
		748	`#`
1040	dpurdie	749	`# Cache data`
		750	`# Only for one cycle of the main loop`
		751	`#`
		752	`if ( exists $releaseData{getReleaseList} )`
		753	`{`
		754	`$logger->verbose3("getReleaseList:Cache hit");`
		755	`return @{$releaseData{getReleaseList}};`
		756	`}`
		757
		758	`#`
1048	dpurdie	759	`# All projects`
1038	dpurdie	760	`#`
1048	dpurdie	761	`if ( $conf->{'allProjects'} )`
1038	dpurdie	762	`{`
1048	dpurdie	763	`$m_sqlstr = "SELECT rt.RTAG_ID" .`
		764	`" FROM RELEASE_MANAGER.RELEASE_TAGS rt" .`
1050	dpurdie	765	`" WHERE rt.OFFICIAL != 'A'";`
		766	`#" AND rt.OFFICIAL != 'Y'";`
1048	dpurdie	767	`}`
		768	`else`
		769	`{`
1038	dpurdie	770	`#`
1048	dpurdie	771	`# Convert list of projects into a list of releases`
1038	dpurdie	772	`#`
1048	dpurdie	773	`my @plist = split /[,\s]+/, $conf->{'project'} \|\| '';`
		774	`if ( @plist )`
		775	`{`
		776	`#`
		777	`# Determine the releases that are in this project`
		778	`# Build up an sql query`
		779	`#`
		780	`my @m_plist;`
		781	`push @m_plist,"PROJ_ID=$_" foreach ( @plist );`
		782	`my $m_plist = join ' OR ', @m_plist;`
		783	`$m_sqlstr = "SELECT rt.RTAG_ID" .`
		784	`" FROM RELEASE_MANAGER.RELEASE_TAGS rt" .`
		785	`" WHERE ( $m_plist ) AND rt.OFFICIAL != 'A' AND rt.OFFICIAL != 'Y'";`
		786	`}`
		787	`}`
1038	dpurdie	788
1048	dpurdie	789	`if ( defined $m_sqlstr )`
		790	`{`
1038	dpurdie	791	`$logger->verbose3("getReleaseList:Sql:$m_sqlstr");`
1048	dpurdie	792	`connectRM(\$RM_DB);`
1038	dpurdie	793	`my $sth = $RM_DB->prepare($m_sqlstr);`
		794	`if ( defined($sth) )`
		795	`{`
		796	`if ( $sth->execute( ) )`
		797	`{`
		798	`if ( $sth->rows )`
		799	`{`
		800	`while (my @row = $sth->fetchrow_array )`
		801	`{`
		802	`$logger->verbose2("getReleaseList:Data:@row");`
		803	`$rlist{$row[0]} = 1;`
		804	`}`
		805	`}`
		806	`$sth->finish();`
		807	`}`
		808	`}`
		809	`else`
		810	`{`
		811	`$logger->warn("getReleaseList: SQL Prepare failure");`
		812	`}`
1050	dpurdie	813	`disconnectRM(\$RM_DB);`
1038	dpurdie	814	`}`
		815
		816	`#`
		817	`# Add in the user specified list of releases`
		818	`#`
		819	`my @rlist = split /[,\s]+/, $conf->{'release'} \|\| '';`
		820	`$rlist{$_} = 1 foreach(@rlist);`
		821
		822	`#`
		823	`# Sort for pretty display only`
		824	`#`
1040	dpurdie	825	`@{$releaseData{getReleaseList}} = sort {$a <=> $b} keys %rlist;`
		826
		827	`return @{$releaseData{getReleaseList}};`
1038	dpurdie	828	`}`
		829
1040	dpurdie	830	`#-------------------------------------------------------------------------------`
		831	`# Function : maintainTagList`
		832	`#`
		833	`# Description : Maintain a data structure for the maintenance of the`
		834	`# tags directory`
		835	`#`
		836	`# Inputs : None`
		837	`#`
		838	`# Returns : Nothing`
		839	`#`
		840	`sub maintainTagList`
		841	`{`
		842	`#`
		843	`# Time to perform the scan`
		844	`# Will do at startup and every time period there after`
		845	`#`
		846	`return unless ( $now > ($lastTagListScan + $conf->{tagListUpdate} ));`
		847	`$logger->verbose("maintainTagList");`
		848	`$lastTagListScan = $now;`
1038	dpurdie	849
1040	dpurdie	850	`#`
		851	`# Get list of things`
		852	`#`
		853	`my %config;`
		854	`%{$config{projects}} = map { $_ => 1 } split (/[,\s]+/, $conf->{'project'} \|\| '');`
		855	`%{$config{releases}} = map { $_ => 1 } getReleaseList();`
		856
		857	`#`
		858	`# Save data`
		859	`#`
		860	`my $dump = Data::Dumper->new([\%config], [qw(*config)]);`
		861	`#print $dump->Dump;`
		862	`#$dump->Reset;`
		863
		864	`#`
		865	`# Save config data`
		866	`#`
		867	`my $conf_file = catfile( $conf->{'tagdir'},'.config' );`
		868	`$logger->verbose3("maintainTagList: Writting $conf_file");`
		869
		870	`my $fh;`
		871	`open ( $fh, '>', $conf_file ) or $logger->err("Can't create $conf_file: $!");`
		872	`print $fh $dump->Dump;`
		873	`close $fh;`
		874	`}`
		875
		876
1038	dpurdie	877	`#-------------------------------------------------------------------------------`
		878	`# Function : processTags`
		879	`#`
		880	`# Description : Process tags and send marked package versions to the target`
		881	`# Determine if new tags are present`
		882	`# Process each tag`
		883	`#`
		884	`# Inputs : None`
		885	`#`
		886	`# Returns : Nothing`
		887	`#`
		888	`sub processTags`
		889	`{`
		890	`#`
		891	`# Determine if new tags are present by examining the time`
		892	`# that the directory was last modified.`
		893	`#`
		894	`# Allow for a forced scan to catch packages that did not transfer`
		895	`# on the first attempt`
		896	`#`
		897	`my ($mtime) = Utils::mtime($conf->{'tagdir'} );`
		898	`if ( ($mtime > $tagDirTime) \|\| ($now > ($lastDirScan + $conf->{'forcedirscan'})) )`
		899	`{`
1042	dpurdie	900	`$logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);`
1038	dpurdie	901	`$tagDirTime = $mtime;`
		902	`$lastDirScan = $now;`
		903
		904	`my $dh;`
		905	`unless (opendir($dh, $conf->{'tagdir'}))`
		906	`{`
		907	`$logger->warn ("can't opendir $conf->{'tagdir'}: $!");`
		908	`return;`
		909	`}`
		910
		911	`#`
		912	`# Process each entry`
		913	`# Ignore those that start with a .`
		914	`#`
		915	`while (my $tag = readdir($dh) )`
		916	`{`
		917	`next if ( $tag =~ m~^\.~ );`
		918	`my $file = "$conf->{'tagdir'}/$tag";`
1042	dpurdie	919	`$logger->verbose3("processTags: $file");`
		920
1038	dpurdie	921	`next unless ( -f $file );`
		922	`next if ( $tag eq 'ReleaseList' );`
		923
		924	`if ( $tag =~ m~(.+)::(.+)~ )`
		925	`{`
		926	`my $package = $1;`
		927	`my $version = $2;`
		928	`if ( transferPackage( $package, $version ))`
		929	`{`
		930	`unlink $file;`
		931	`}`
		932	`else`
		933	`{`
		934	`my ($mtime) = Utils::mtime( $file );`
		935	`if ( $now - $mtime > $conf->{'tagage'} )`
		936	`{`
		937	`$logger->warn ("Delete unsatisfied tag: $tag");`
		938	`unlink $file;`
		939	`}`
		940	`}`
		941	`}`
		942	`}`
		943	`closedir $dh;`
		944	`}`
		945	`}`
		946
		947	`#-------------------------------------------------------------------------------`
		948	`# Function : transferPackage`
		949	`#`
		950	`# Description : Transfer specified package to target system`
		951	`#`
		952	`# Inputs : $pname - Name of the package`
		953	`# $pver - Package version`
		954	`# $plink - (optional) Symlink in same package`
		955	`#`
		956	`# Returns : true - Package transferred`
		957	`# false - Package not transferred`
		958	`#`
		959	`sub transferPackage`
		960	`{`
		961	`my ($pname, $pver, $plink ) = @_;`
		962	`my $rv = 0;`
		963	`$logger->logmsg("transferPackage: @_");`
		964
		965	`#`
1040	dpurdie	966	`# Do not transfer excluded files`
		967	`#`
		968	`if ( exists $excludePkgs->{$pname} )`
		969	`{`
1048	dpurdie	970	`$logger->warn("transferPackage: Excluded package not transferred: $pname, $pver");`
1040	dpurdie	971	`return 1;`
		972	`}`
1048	dpurdie	973
1040	dpurdie	974	`#`
1048	dpurdie	975	`# Apply package filter`
		976	`#`
		977	`if ( defined $conf->{'packageFilter'} )`
		978	`{`
		979	`unless ( $pname =~ m~$conf->{'packageFilter'}~ )`
		980	`{`
		981	`$logger->warn("transferPackage: Filtered out package not transferred: $pname, $pver");`
		982	`return 1;`
		983	`}`
		984	`}`
		985
		986	`#`
1038	dpurdie	987	`# plink of 1 is not a symlink`
		988	`#`
		989	`$plink = undef if ( defined($plink) && $plink eq '1' );`
		990
		991	`#`
		992	`# If its been transferred in the current scan, then`
		993	`# indicate that all is well`
		994	`#`
		995	`if ( $transferred->{$pname}{$pver} )`
		996	`{`
		997	`$logger->verbose("transferPackage: Already transferred");`
		998	`return 1;`
		999	`}`
		1000
1040	dpurdie	1001	`my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );`
1038	dpurdie	1002	`unless ( -d $sfile )`
		1003	`{`
		1004	`$logger->warn("transferPackage:Package not found: $pname, $pver");`
		1005	`return $rv;`
		1006	`}`
		1007
		1008	`#`
		1009	`# Create the process piple to transfer the package`
		1010	`# Tar the directory and pipe the result through a ssh session to`
		1011	`# the target machine`
3515	dpurdie	1012	`# $tar -czf - -C "$dpkg/${pname}/${pver}" . \| ssh ... "./receive_package pname pver"`
1038	dpurdie	1013	`#`
		1014	`my $ph;`
3515	dpurdie	1015	`my $tar_cmd = "$tar -czf - -C \"$sfile\" .";`
1038	dpurdie	1016	`my $tgt_opts = defined($plink) ? "\"-L$plink\"" : '';`
1040	dpurdie	1017	`my $tgt_cmd = "$conf->{'bindir'}/receive_package $tgt_opts \"$pname\" \"$pver\"";`
3515	dpurdie	1018	`my $ssh_cmd = sshCmd($tgt_cmd);`
1038	dpurdie	1019
		1020	`$logger->verbose2("transferPackage:tar_cmd:$tar_cmd");`
		1021	`$logger->verbose2("transferPackage:tgt_cmd:$tgt_cmd");`
		1022	`$logger->verbose2("transferPackage:ssh_cmd:$ssh_cmd");`
		1023
		1024	`open ($ph, "$tar_cmd \| $ssh_cmd \|");`
		1025	`while ( <$ph> )`
		1026	`{`
		1027	`chomp;`
		1028	`$logger->verbose2("transferPackage:Data: $_");`
		1029	`}`
		1030	`close ($ph);`
		1031	`$logger->verbose("transferPackage:End: $?");`
		1032	`if ( $? == 0 )`
		1033	`{`
		1034	`#`
		1035	`# Mark has having been transferred in the current cycle`
		1036	`#`
		1037	`$transferred->{$pname}{$pver} = 1;`
		1038	`$rv = 1;`
		1039	`}`
		1040	`else`
		1041	`{`
		1042	`$logger->warn("transferPackage:Transfer Error: $pname, $pver, $?");`
		1043	`}`
3515	dpurdie	1044	`LogTxError ($?);`
1038	dpurdie	1045	`return $rv;`
		1046	`}`
		1047
		1048	`#-------------------------------------------------------------------------------`
		1049	`# Function : deletePackage`
		1050	`#`
		1051	`# Description : Delete specified package to target system`
		1052	`#`
		1053	`# Inputs : $pname - Name of the package`
		1054	`# $pver - Package version`
1042	dpurdie	1055	`# $pdata - Hash of extra data`
1038	dpurdie	1056	`#`
		1057	`# Returns : true - Package transferred`
		1058	`# false - Package not transferred`
		1059	`#`
		1060	`sub deletePackage`
		1061	`{`
1042	dpurdie	1062	`my ($pname, $pver, $pdata ) = @_;`
1038	dpurdie	1063	`my $rv = 0;`
1042	dpurdie	1064	`$logger->logmsg("deletePackage: $pname, $pver");`
1038	dpurdie	1065
		1066	`#`
		1067	`# Create the process pipe to delete the package`
3515	dpurdie	1068	`# ssh ... "./delete_package ${rx_opts} \"$pname\" \"$pver\""`
1038	dpurdie	1069	`#`
		1070	`my $ph;`
1042	dpurdie	1071	`my $flags = $pdata->{FORCEDELETE} ? '' : ' -T';`
		1072	`my $tgt_cmd = "$conf->{'bindir'}/delete_package $flags \"$pname\" \"$pver\"";`
3515	dpurdie	1073	`my $ssh_cmd = sshCmd($tgt_cmd);`
1038	dpurdie	1074
1040	dpurdie	1075	`$logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");`
		1076	`$logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");`
1038	dpurdie	1077
		1078	`open ($ph, "$ssh_cmd \|");`
		1079	`while ( <$ph> )`
		1080	`{`
		1081	`chomp;`
		1082	`$logger->verbose2("deletePackage:Data: $_");`
		1083	`}`
		1084	`close ($ph);`
		1085	`$logger->verbose("deletePackage:End: $?");`
		1086	`if ( $? == 0 )`
		1087	`{`
		1088	`$rv = 1;`
		1089	`}`
		1090	`else`
		1091	`{`
		1092	`$logger->warn("deletePackage:Error: $pname, $pver, $?");`
		1093	`}`
3515	dpurdie	1094	`LogTxError ($?);`
1038	dpurdie	1095	`return $rv;`
		1096	`}`
		1097
3515	dpurdie	1098	`#-------------------------------------------------------------------------------`
		1099	`# Function : sshCmd`
		1100	`#`
		1101	`# Description : Generate a ssh based command`
		1102	`#`
		1103	`# Inputs : Target command`
		1104	`#`
		1105	`# Returns : An shh command string`
		1106	`#`
		1107	`sub sshCmd`
		1108	`{`
		1109	`my ($tgt_cmd) = @_;`
		1110	`return "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";`
		1111	`}`
1038	dpurdie	1112
3515	dpurdie	1113
1038	dpurdie	1114	`#-------------------------------------------------------------------------------`
1042	dpurdie	1115	`# Function : parsePkgList`
		1116	`#`
		1117	`# Description : Parse one line from a pkgList`
		1118	`# Lines are multiple item="data" items`
		1119	`#`
		1120	`# Inputs : $line - Line of data`
		1121	`# $hashp - Ref to hash to populate`
		1122	`#`
		1123	`# Returns : A hash of data items`
		1124	`#`
		1125	`sub parsePkgList`
		1126	`{`
		1127	`my ($line, $hashp) = @_;`
		1128	`my $rv;`
		1129
		1130	`while ( $line =~ m~\s*(.+?)="(.+?)"~ )`
		1131	`{`
		1132	`$rv->{$1} = $2;`
		1133	`$line = $';`
		1134	`}`
		1135	`#Utils::DebugDumpData ("parsePkgList", $rv);`
		1136
		1137	`my $pname = $rv->{pname};`
		1138	`my $pver = $rv->{pver};`
		1139	`return undef unless ( $pname && $pver );`
		1140
		1141	`delete $rv->{pname};`
		1142	`delete $rv->{pver};`
		1143	`delete $rv->{GMT};`
		1144
		1145	`$hashp->{$pname}{$pver} = $rv;`
		1146	`return $hashp;`
		1147	`}`
		1148
		1149
		1150	`#-------------------------------------------------------------------------------`
1038	dpurdie	1151	`# Function : sighandlers`
		1152	`#`
		1153	`# Description : Install signal handlers`
		1154	`#`
		1155	`# Inputs : $conf - System config`
		1156	`#`
		1157	`# Returns : Nothing`
		1158	`#`
		1159	`sub sighandlers`
		1160	`{`
		1161	`my $conf = shift;`
		1162	`my $logger = $conf->{logger};`
		1163
		1164	`$SIG{TERM} = sub {`
		1165	`# On shutdown`
		1166	`$logger->logmsg('Received SIGTERM. Shutting down....' );`
		1167	`unlink $conf->{'pidfile'} if (-f $conf->{'pidfile'});`
		1168	`exit 0;`
		1169	`};`
		1170
		1171	`$SIG{HUP} = sub {`
		1172	`# On logrotate`
		1173	`$logger->logmsg('Received SIGHUP.');`
		1174	`$logger->rotatelog();`
		1175	`};`
		1176
		1177	`$SIG{USR1} = sub {`
		1178	`# On Force Archive Sync`
		1179	`$logger->logmsg('Received SIGUSR1.');`
1046	dpurdie	1180	`$lastReleaseScan = 0;`
		1181	`$lastTagListScan = 0;`
1038	dpurdie	1182	`};`
		1183
		1184	`$SIG{__WARN__} = sub { $logger->warn("@_") };`
		1185	`$SIG{__DIE__} = sub { $logger->err("@_") };`
		1186
		1187
		1188	`}`
		1189
		1190	`#-------------------------------------------------------------------------------`
3515	dpurdie	1191	`# Function : LogTxError`
		1192	`#`
		1193	`# Description : Detect restoration of communication and log such`
		1194	`# Don't log failures as the user will do that`
		1195	`#`
		1196	`# Inputs : $state - 0 - All is well`
		1197	`# !0 - Error`
		1198	`#`
		1199	`# Returns : Nothing`
		1200	`#`
		1201	`sub LogTxError`
		1202	`{`
		1203	`my ($state) = $@;`
		1204	`if ( $state )`
		1205	`{`
		1206	`$comError++;`
		1207	`}`
		1208	`elsif ( $comError )`
		1209	`{`
		1210	`$logger->warn("Communication Restored");`
		1211	`$comError = 0;`
		1212	`}`
		1213	`}`
		1214
		1215
		1216	`#-------------------------------------------------------------------------------`
1038	dpurdie	1217	`# Function : Error, Verbose, Warning`
		1218	`#`
		1219	`# Description : Support for JatsRmApi`
		1220	`#`
		1221	`# Inputs : Message`
		1222	`#`
		1223	`# Returns : Nothing`
		1224	`#`
		1225	`sub Error`
		1226	`{`
		1227	`$logger->err("@_");`
		1228	`}`
		1229
		1230	`sub Verbose`
		1231	`{`
1042	dpurdie	1232	`$logger->verbose2("@_");`
1038	dpurdie	1233	`}`
		1234
		1235	`sub Warning`
		1236	`{`
		1237	`$logger->warn("@_");`
		1238	`}`
		1239
		1240
		1241
		1242

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatDaemon.pl – Rev 3515