Branch 'errata-date' - 7 commits - java/code utils/cloneByDate.py utils/depsolver.py utils/spacewalk-clone-by-date utils/spacewalk-clone-by-date.sgml
by Justin Sherrill
java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml | 4
java/code/src/com/redhat/rhn/domain/errata/ErrataFactory.java | 207 +++++-----
java/code/src/com/redhat/rhn/domain/errata/test/ErrataFactoryTest.java | 6
java/code/src/com/redhat/rhn/frontend/xmlrpc/errata/ErrataHandler.java | 142 +++---
java/code/src/com/redhat/rhn/manager/channel/ChannelEditor.java | 4
java/code/src/com/redhat/rhn/manager/channel/test/ChannelManagerTest.java | 8
java/code/src/com/redhat/rhn/manager/errata/test/ErrataManagerTest.java | 5
utils/cloneByDate.py | 129 +++---
utils/depsolver.py | 3
utils/spacewalk-clone-by-date | 25 -
utils/spacewalk-clone-by-date.sgml | 162 +++++++
11 files changed, 458 insertions(+), 237 deletions(-)
New commits:
commit b7baf0795687a808492b07be90821f002ba9b85e
Author: Justin Sherrill <jsherril(a)redhat.com>
Date: Tue Jan 31 13:30:48 2012 -0500
errata date clone - adding proper logging
diff --git a/utils/cloneByDate.py b/utils/cloneByDate.py
index 25eddf8..50927cd 100644
--- a/utils/cloneByDate.py
+++ b/utils/cloneByDate.py
@@ -24,12 +24,15 @@ import copy
import shutil
import tempfile
import xmlrpclib
+import pprint
from depsolver import DepSolver
try:
from spacewalk.common.rhnConfig import CFG, initCFG
+ from spacewalk.common import rhnLog
+ from spacewalk.common.rhnLog import log_debug, log_clean
from spacewalk.satellite_tools.progress_bar import ProgressBar
from spacewalk.server import rhnSQL
except:
@@ -37,10 +40,14 @@ except:
if _LIBPATH not in sys.path:
sys.path.append(_LIBPATH)
from server import rhnSQL
- from common import CFG, initCFG
+ from common import rhnLog
+ from common.rhnLog import log_debug, log_clean
+ from common.rhnConfig import CFG, initCFG
from satellite_tools.progress_bar import ProgressBar
+LOG_LOCATION = '/var/log/rhn/errata-clone.log'
+
def confirm(txt, options):
if not options.assumeyes:
confirm = raw_input(txt)
@@ -55,7 +62,12 @@ def main(options):
xmlrpc = RemoteApi(options.server, options.username, options.password)
db = DBApi()
initCFG('server')
-
+ rhnLog.initLOG(LOG_LOCATION)
+
+ cleansed = vars(options)
+ cleansed["password"] = "*****"
+ log_debug(0, "Started spacewalk-clone-by-date")
+ log_clean(0, pprint.pformat(cleansed))
cloners = []
needed_channels = []
@@ -144,7 +156,7 @@ class ChannelTreeCloner:
nvreas = []
#clone the destination parent if it doesn't exist
- if dest_parent in to_create.values():
+ if dest_parent in to_create.values():
self.remote_api.clone_channel(self.src_parent, dest_parent, None)
del to_create[self.src_parent]
cloner = self.find_cloner(self.src_parent)
@@ -207,7 +219,11 @@ class ChannelTreeCloner:
added_pkgs = []
for cloner in self.cloners:
cloner.process()
- added_pkgs += cloner.pkg_diff()
+ pkg_diff = cloner.pkg_diff()
+ added_pkgs += pkg_diff
+ log_clean(0, "")
+ log_clean(0, "%i packages were added to %s as a result of clone:" % (len(pkg_diff), cloner.dest_label()))
+ log_clean(0, "\n".join([pkg['nvrea'] for pkg in pkg_diff]))
self.dep_solve([pkg['nvrea'] for pkg in added_pkgs])
@@ -321,15 +337,21 @@ class ChannelCloner:
def process_deps(self, needed_pkgs):
needed_ids = []
+ needed_names = []
unsolved_deps = []
for pkg in needed_pkgs:
found = self.src_pkg_exist([pkg])
if found:
needed_ids.append(found['id'])
+ needed_names.append(found['nvrea'])
else:
unsolved_deps.append(pkg)
- if len(needed_ids) > 0:
+ if len(needed_ids) > 0:
+ log_clean(0, "")
+ log_clean(0, "Adding %i needed dependencies to %l" % (len(needed_ids), self.to_label))
+ for name in needed_names:
+ log_clean(0, name)
self.remote_api.add_packages(self.to_label, needed_ids)
@@ -375,7 +397,13 @@ class ChannelCloner:
if len(errata_ids) == 0:
return
- print 'Cloning Errata into %s (%i):' % (self.to_label, len(errata_ids))
+ msg = 'Cloning Errata into %s (%i):' % (self.to_label, len(errata_ids))
+ print msg
+ log_clean(0, "")
+ log_clean(0, msg)
+ for e in self.errata_to_clone:
+ log_clean(0, "%s - %s" % (e['advisory_name'], e['synopsis']))
+
pb = ProgressBar(prompt="", endTag=' - complete',
finalSize=len(errata_ids), finalBarLength=40, stream=sys.stdout)
pb.printAll(1);
@@ -401,9 +429,16 @@ class ChannelCloner:
def remove_blacklisted(self, pkg_names):
found_ids = []
+ found_names = []
for pkg in self.reset_new_pkgs().values():
if pkg['name'] in pkg_names:
- found_ids.append(pkg['id'])
+ found_ids.append(pkg['id'])
+ found_names.append(pkg['nvrea'])
+
+ log_clean(0, "")
+ log_clean(0, "Removing %i packages from %s." (len(found_ids), self.to_label))
+ log_clean(0, "\n".join(found_names))
+
if len(found_ids) > 0:
print "Removing %i packages from %s" % (len(found_ids), self.to_label)
self.remote_api.remove_packages(self.to_label, found_ids)
@@ -466,7 +501,7 @@ class RemoteApi:
del package_ids[:20]
self.client.channel.software.addPackages(self.auth_token, label, set)
- def remove_packages(self, label, package_ids):
+ def remove_packages(self, label, package_ids):
while(len(package_ids) > 0):
set = package_ids[:20]
del package_ids[:20]
@@ -475,8 +510,12 @@ class RemoteApi:
def clone_channel(self, original_label, new_label, parent):
details = {'name': new_label, 'label':new_label, 'summary': new_label}
if parent and parent != '':
- details['parent_label'] = parent
- print "Cloning %s to %s with original package set." % (original_label, new_label)
+ details['parent_label'] = parent
+
+ msg = "Cloning %s to %s with original package set." % (original_label, new_label)
+ log_clean(0, "")
+ log_clean(0, msg)
+ print(msg)
self.client.channel.software.clone(self.auth_token, original_label, details, True)
@@ -496,7 +535,7 @@ class DBApi:
"""list of errata that is applicable to be cloned, used db because we
need to exclude cloned errata too"""
h = rhnSQL.prepare("""
- select e.id, e.advisory_name, e.advisory_type, e.issue_date
+ select e.id, e.advisory_name, e.advisory_type, e.issue_date, e.synopsis
from rhnErrata e inner join
rhnChannelErrata ce on e.id = ce.errata_id inner join
rhnChannel c on c.id = ce.channel_id
commit a700123e605c7862e6dbe7c8e015b4641a1385b5
Author: Justin Sherrill <jsherril(a)redhat.com>
Date: Tue Jan 31 10:47:06 2012 -0500
errata date clone - improving use on terminal with a smaller width
diff --git a/utils/cloneByDate.py b/utils/cloneByDate.py
index d3af3ff..25eddf8 100644
--- a/utils/cloneByDate.py
+++ b/utils/cloneByDate.py
@@ -224,8 +224,9 @@ class ChannelTreeCloner:
def process_deps(self, deps):
needed_list = dict((label, []) for label in self.channel_map.values())
unsolved_deps = []
-
- pb = ProgressBar(prompt="Processing Dependencies: ", endTag=' - complete',
+
+ print('Processing Dependencies:')
+ pb = ProgressBar(prompt="", endTag=' - complete',
finalSize=len(deps), finalBarLength=40, stream=sys.stdout)
pb.printAll(1);
@@ -374,8 +375,8 @@ class ChannelCloner:
if len(errata_ids) == 0:
return
- msg = 'Cloning Errata into %s (%i): ' % (self.to_label, len(errata_ids))
- pb = ProgressBar(prompt=msg, endTag=' - complete',
+ print 'Cloning Errata into %s (%i):' % (self.to_label, len(errata_ids))
+ pb = ProgressBar(prompt="", endTag=' - complete',
finalSize=len(errata_ids), finalBarLength=40, stream=sys.stdout)
pb.printAll(1);
while(len(errata_ids) > 0):
diff --git a/utils/depsolver.py b/utils/depsolver.py
index 7de4bed..0a1d3cb 100644
--- a/utils/depsolver.py
+++ b/utils/depsolver.py
@@ -124,7 +124,8 @@ class DepSolver:
results = {}
regex_filename_match = re.compile('[/*?]|\[[^]]*/[^]]*\]').match
- pb = ProgressBar(prompt="Solving Dependencies (%i): " % len(pkgs), endTag=' - complete',
+ print("Solving Dependencies (%i): " % len(pkgs))
+ pb = ProgressBar(prompt='', endTag=' - complete',
finalSize=len(pkgs), finalBarLength=40, stream=sys.stdout)
pb.printAll(1);
commit 83ed6ed3287e5301f0242fb0d20c87b73452cadb
Author: Justin Sherrill <jsherril(a)redhat.com>
Date: Tue Jan 31 10:33:59 2012 -0500
errata date clone - prompting for password if not supplied
diff --git a/utils/spacewalk-clone-by-date b/utils/spacewalk-clone-by-date
index e6ef745..0f7056f 100755
--- a/utils/spacewalk-clone-by-date
+++ b/utils/spacewalk-clone-by-date
@@ -20,6 +20,7 @@
import sys
import datetime
+import getpass
from optparse import OptionParser
import simplejson as json
@@ -114,10 +115,15 @@ def parse_args():
options = merge_config(options)
+ if not options.username:
+ raise UserError("Username not specified")
if options.channels == None or len(options.channels) == 0:
raise UserError("No channels specified. See --help for details.")
+ if not options.password:
+ options.password = getpass.getpass()
+
options.to_date = parse_time(options.to_date)
return options
commit 026d77602bacdbb6e7aab930edb30fefb4c5e26a
Author: Justin Sherrill <jsherril(a)redhat.com>
Date: Tue Jan 31 10:01:49 2012 -0500
adding man page for spacewalk-clone-by-date
diff --git a/utils/spacewalk-clone-by-date.sgml b/utils/spacewalk-clone-by-date.sgml
new file mode 100644
index 0000000..b179451
--- /dev/null
+++ b/utils/spacewalk-clone-by-date.sgml
@@ -0,0 +1,162 @@
+<!DOCTYPE refentry PUBLIC "-//OASIS//DTD DocBook V3.1//EN" [
+<!ENTITY RHNSAT "RHN Management Satellite Server" >
+<!ENTITY RHNSAT "RHN Satellite system Migration Tool" >
+]>
+<refentry>
+
+<RefMeta>
+<RefEntryTitle>spacewalk-clone-by-date</RefEntryTitle><manvolnum>8</manvolnum>
+<RefMiscInfo>Version 1.0</RefMiscInfo>
+</RefMeta>
+
+<RefNameDiv>
+<RefName><command>spacewalk-clone-by-date</command></RefName>
+<RefPurpose>
+Script to clone software channels and errata up to specific dates ensuring any added packages have their
+dependencies satisifed. Any destination channels that do not exist will be created.
+
+By specifying channels on the command line, only a single channel tree (a base channel and its children)
+can be cloned with a single command. If you would like to specify multiple trees within a single command,
+simply use a configuration file. See --sample-config for a sample.
+
+All options can either be specified in the configuration file or via command line. Any option specified via
+command line will override a configuration file value with the exception of channels. If a configuration file is
+specified, --channels is not a valid command line argument.
+
+</RefPurpose>
+</RefNameDiv>
+
+<RefSynopsisDiv>
+<Synopsis>
+ <cmdsynopsis>
+ <command>spacewalk-clone-by-date</command>
+ <arg>options <replaceable>...</replaceable></arg>
+ </cmdsynopsis>
+ <cmdsynopsis>
+ <arg> -c <replaceable>CONFIGFILE</replaceable></arg>
+ <arg> --config=<replaceable>CONFIGFILE</replaceable></arg>
+ </cmdsynopsis>
+ <cmdsynopsis>
+ <arg> -m </arg><arg> --sample-config</arg>
+ </cmdsynopsis>
+ <cmdsynopsis>
+ <arg>-u<replaceable>USERNAME</replaceable></arg>
+ <arg>--username=<replaceable>USERNAME</replaceable></arg>
+ </cmdsynopsis>
+ <cmdsynopsis>
+ <arg>-p<replaceable>PASSWORD</replaceable></arg>
+ <arg>--password=<replaceable>PASSWORD</replaceable></arg>
+ </cmdsynopsis>
+ <cmdsynopsis>
+ <arg>-c<replaceable>SRC DEST</replaceable></arg>
+ <arg>--channels=<replaceable>SRC DEST</replaceable></arg>
+ </cmdsynopsis>
+ <cmdsynopsis>
+ <arg> -d=<replaceable>YYYY-MM-DD</replaceable></arg>
+ <arg> --to_date=<replaceable>YYYY-MM-DD</replaceable></arg>
+ </cmdsynopsis>
+ <cmdsynopsis>
+ <arg>-b<replaceable>PKG1,PKG2,PKG3</replaceable></arg>
+ <arg>--blacklist=<replaceable>PKG1,PKG2,PKG3</replaceable></arg>
+ </cmdsynopsis>
+ <cmdsynopsis>
+ <arg>-y</arg><arg> --assumeyes </arg>
+ </cmdsynopsis>
+ <cmdsynopsis>
+ <arg>-h</arg><arg>--help</arg>
+ </cmdsynopsis>
+</Synopsis>
+</RefSynopsisDiv>
+
+<RefSect1><Title>Description</Title>
+ <para>
+ <emphasis>spacewalk-clone-by-date</emphasis> clones a channel with errata to a specific date.
+ </para>
+</RefSect1>
+
+<RefSect1><Title>Options</Title>
+<variablelist>
+ <varlistentry>
+ <term>-h, --help</term>
+ <listitem>
+ <para>Display the help screen with a list of options.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>-c <replaceable>FILE</replaceable>
+ --config=<replaceable>FILE</replaceable></term>
+ <listitem>
+ <para>Configuration file holding parameters, see --sample-config for an example.
+ Any commandline parameters override those in specified config file.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>-m --sample-config</term>
+ <listitem>
+ <para>Generate a sample configuration file.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>-u<replaceable>USERNAME</replaceable>
+ --username=<replaceable>USERNAME</replaceable></term>
+ <listitem>
+ <para>username of user that has administrative access.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term>-p<replaceable>PASSWORD</replaceable>
+ --password=<replaceable>PASSWORD</replaceable></term>
+ <listitem>
+ <para>password of user that has administrative access.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term> -c <replaceable>SRC_LABEL DEST_LABEL</replaceable>
+ --channels=<replaceable>SRC_LABEL DEST_LABEL</replaceable></term>
+ <listitem>
+ <para>Space seperated list of source channel and destination channel. Can be
+ specified multiple times to provide base channel and child channel pairs of a
+ single channel tree. To specify more than one channel tree, specify a config file.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term> -y --assumeyes
+ <listitem>
+ <para>Instead of asking for confirmation before cloning a channel or errata,
+ continue uninterrupted.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term> -b <replaceable>PKG1,PKG2,PKG3</replaceable>
+ --blacklist=<replaceable>PKG1,PKG2,PKG3</replaceable> </term>
+ <listitem>
+ <para>Comma seperated list of package names to be removed after cloning.
+ Dependency resolution is not ensured on resulting repository.</para>
+ </listitem>
+ </varlistentry>
+</variablelist>
+</RefSect1>
+
+
+<RefSect1><Title>Examples</Title>
+<example>
+ <title>Clone a base channel and child channel to 2008-12-20 with a small blacklist.</title>
+ spacewalk-clone-by-date --channel=rhel-x86_64-server-5 clone-rhel --channel=rhn-tools-rhel-x86_64-server-5 clone-tools --username admin --password redhat --to_date=2008-12-20 --blacklist=sendmail,squid
+</example>
+<example>
+ <title>Clone with options completely from a config file.</title>
+ spacewalk-clone-by-date --config=/etc/clone.conf
+</example>
+<example>
+ <title>Clone while overriding some options from the commandline.</title>
+ spacewalk-clone-by-date --config=/etc/clone.conf --username rocky --password squirrel --to_date=2010-10-09
+</example>
+</RefSect1>
+
+<RefSect1><Title>Authors</Title>
+<simplelist>
+ <member>Justin Sherrill <email>jsherrill(a)redhat.com</email></member>
+</simplelist>
+</RefSect1>
+</RefEntry>
+
commit 97a9f02838622a1dc2f3c6c7c7e8e1648e225d2c
Author: Justin Sherrill <jsherril(a)redhat.com>
Date: Tue Jan 31 10:01:34 2012 -0500
errata date clone - a few fixes
diff --git a/utils/cloneByDate.py b/utils/cloneByDate.py
index 9434a9c..d3af3ff 100644
--- a/utils/cloneByDate.py
+++ b/utils/cloneByDate.py
@@ -86,7 +86,7 @@ def main(options):
confirm("\nContinue with clone (y/n)?", options)
for cloner in cloners:
- cloner.clone()
+ cloner.clone()
cloner.remove_blacklisted()
@@ -257,9 +257,10 @@ class ChannelTreeCloner:
if len(needed) > 0:
cloner.process_deps(needed)
- def remove_blacklisted(self):
- for cloner in self.cloners:
- cloner.remove_blacklisted(self.blacklist)
+ def remove_blacklisted(self):
+ if self.blacklist:
+ for cloner in self.cloners:
+ cloner.remove_blacklisted(self.blacklist)
def repodata(self, label):
return "%s/rhn/repodata/%s" % ( CFG.REPOMD_CACHE_MOUNT_POINT, label)
diff --git a/utils/spacewalk-clone-by-date b/utils/spacewalk-clone-by-date
index f369b44..e6ef745 100755
--- a/utils/spacewalk-clone-by-date
+++ b/utils/spacewalk-clone-by-date
@@ -36,6 +36,7 @@ SAMPLE_CONFIG = """
"password":"redhat",
"assumeyes":true,
"to_date": "2011-10-01",
+ "blacklist": ["foo", "bar"],
"channels":[
{
"rhel-x86_64-server-5":"my-rhel5-x86_64-clone",
@@ -50,9 +51,12 @@ SAMPLE_CONFIG = """
def merge_config(options):
- if not options.config:
+ if options.channels:
options.channels = transform_arg_channels(options.channels)
return options
+ elif not options.config:
+ return options
+
try:
config = json.load(open(options.config))
except:
@@ -90,7 +94,7 @@ def parse_args():
parser.add_option("-u", "--username", dest="username", help="Username")
parser.add_option("-p", "--password", dest="password", help="Password")
parser.add_option("-s", "--server", dest="server", help="Server URL to use for api connections (defaults to https://localhost/rpc/api)", default="https://localhost/rpc/api")
- parser.add_option("-l", "--channels", dest="channels", nargs=2, action="append", help="Original channel and clone channel labels space seperated (e.g. --channels=rhel-i386-server-5 myclone)")
+ parser.add_option("-l", "--channels", dest="channels", nargs=2, action="append", help="Original channel and clone channel labels space seperated (e.g. --channels=rhel-i386-server-5 myclone). Can be specified multiple times.")
parser.add_option("-b", "--blacklist", dest="blacklist", help="Comman separated list of package names")
parser.add_option("-d", "--to_date", dest="to_date", help="Clone errata to the specified date (YYYY-MM-DD)")
parser.add_option("-y", "--assumeyes", dest='assumeyes', action='store_true', help="Assume yes for any prompts (unattended).")
@@ -109,10 +113,12 @@ def parse_args():
options.blacklist = options.blacklist.split(",")
options = merge_config(options)
- options.to_date = parse_time(options.to_date)
+
if options.channels == None or len(options.channels) == 0:
- raise UserError("No channels specified.")
+ raise UserError("No channels specified. See --help for details.")
+
+ options.to_date = parse_time(options.to_date)
return options
commit e17c4364b267c4549ed77335ccea1384ba52bdff
Author: Justin Sherrill <jsherril(a)redhat.com>
Date: Mon Jan 30 16:38:24 2012 -0500
errata date clone - some general cleanup
diff --git a/utils/cloneByDate.py b/utils/cloneByDate.py
index 90a0590..9434a9c 100644
--- a/utils/cloneByDate.py
+++ b/utils/cloneByDate.py
@@ -23,14 +23,10 @@ import time
import copy
import shutil
import tempfile
-from depsolver import DepSolver
+import xmlrpclib
-try:
- import json
-except ImportError:
- import simplejson as json
-import xmlrpclib
+from depsolver import DepSolver
try:
from spacewalk.common.rhnConfig import CFG, initCFG
@@ -58,6 +54,8 @@ def confirm(txt, options):
def main(options):
xmlrpc = RemoteApi(options.server, options.username, options.password)
db = DBApi()
+ initCFG('server')
+
cloners = []
needed_channels = []
@@ -96,7 +94,7 @@ def main(options):
class ChannelTreeCloner:
"""Usage:
- a = ChannelTreeCloner(channel_hash, xmlrpc, db, to_date)
+ a = ChannelTreeCloner(channel_hash, xmlrpc, db, to_date, blacklist)
a.create_channels()
a.prepare()
a.clone()
@@ -107,14 +105,15 @@ class ChannelTreeCloner:
self.channel_map = channels
self.to_date = to_date
self.cloners = []
- self.blacklist = blacklist
+ self.blacklist = blacklist
- self.validate_source_channels()
-
+ self.validate_source_channels()
for from_label in self.ordered_labels():
to_label = self.channel_map[from_label]
cloner = ChannelCloner(from_label, to_label, self.to_date, self.remote_api, self.db_api)
- self.cloners.append(cloner)
+ self.cloners.append(cloner)
+
+
#returns a trimmed down version of channel_map where the value needs creating
def needing_create(self):
@@ -212,7 +211,6 @@ class ChannelTreeCloner:
self.dep_solve([pkg['nvrea'] for pkg in added_pkgs])
-
def dep_solve(self, nvrea_list, labels=None):
if not labels:
labels = self.channel_map.keys()
@@ -264,14 +262,8 @@ class ChannelTreeCloner:
cloner.remove_blacklisted(self.blacklist)
def repodata(self, label):
- repo_dir = "/var/cache/rhn/repodata/%s" % label
- tmp_dir = tempfile.mkdtemp(suffix="clone-by-date")
- try:
- shutil.copytree(repo_dir, tmp_dir + "/repodata/")
- except:
- raise UserError("Could not find repodata for %s in %s" % (label, repo_dir))
- return tmp_dir
-
+ return "%s/rhn/repodata/%s" % ( CFG.REPOMD_CACHE_MOUNT_POINT, label)
+
@@ -340,10 +332,8 @@ class ChannelCloner:
def list_to_hash(self, pkg_list, key):
- pkg_hash = {}
- for pkg in pkg_list:
- pkg_hash[pkg[key]] = pkg
- return pkg_hash
+ return dict((pkg[key], pkg) for pkg in pkg_list)
+
def src_pkg_exist(self, needed_list):
if not self.from_pkg_hash:
@@ -379,7 +369,7 @@ class ChannelCloner:
def clone(self):
bunch_size = 10
- errata_ids = self.collect(self.errata_to_clone, "advisory_name")
+ errata_ids = [ e["advisory_name"] for e in self.errata_to_clone]
if len(errata_ids) == 0:
return
@@ -394,19 +384,7 @@ class ChannelCloner:
pb.addTo(bunch_size)
pb.printIncrement()
pb.printComplete()
-
- def collect(self, items, attribute):
- to_ret = []
- for item in items:
- to_ret.append(item[attribute])
- return to_ret
-
- def repodata(self, label):
- repo_dir = "/var/cache/rhn/repodata/%s" % label
- tmp_dir = tempfile.mkdtemp(suffix="clone-by-date")
- shutil.copytree(repo_dir, tmp_dir + "/repodata/")
- return tmp_dir
-
+
def get_errata(self):
""" Returns tuple of all available for cloning, and what falls in the date range"""
available_errata = self.db_api.applicable_errata(self.from_label, self.to_label)
diff --git a/utils/spacewalk-clone-by-date b/utils/spacewalk-clone-by-date
index b40d94b..f369b44 100755
--- a/utils/spacewalk-clone-by-date
+++ b/utils/spacewalk-clone-by-date
@@ -53,7 +53,10 @@ def merge_config(options):
if not options.config:
options.channels = transform_arg_channels(options.channels)
return options
- config = json.load(open(options.config))
+ try:
+ config = json.load(open(options.config))
+ except:
+ raise UserError("Configuration file is invalid, please check syntax.")
#if soemthing is in the config and not passed in as an argument
# add it to options
commit f72e4d7e0549723da9c648a08d539d297219f153
Author: Justin Sherrill <jsherril(a)redhat.com>
Date: Fri Jan 20 09:59:21 2012 -0500
improving speed of errata cloning within the spacewalk api
diff --git a/java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml b/java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml
index d04f5f5..ef3e251 100644
--- a/java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml
+++ b/java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml
@@ -20,7 +20,9 @@ DELETE
<write-mode name="add_channel_packages">
<query params="cid">
INSERT INTO rhnChannelPackage (channel_id, package_id)
- select :cid, P.id from rhnPackage P where P.id in (%s)
+ select :cid, P.id from rhnPackage P
+ where P.id in (%s) and
+ P.id not in (select package_id from rhnChannelPackage where channel_id = :cid)
</query>
</write-mode>
diff --git a/java/code/src/com/redhat/rhn/domain/errata/ErrataFactory.java b/java/code/src/com/redhat/rhn/domain/errata/ErrataFactory.java
index 555c0a2..b090228 100644
--- a/java/code/src/com/redhat/rhn/domain/errata/ErrataFactory.java
+++ b/java/code/src/com/redhat/rhn/domain/errata/ErrataFactory.java
@@ -268,106 +268,125 @@ public class ErrataFactory extends HibernateFactory {
* @param inheritPackages include only original channel packages
* @return the publsihed errata
*/
- public static Errata publishToChannel(Errata errata, Channel chan, User user,
+ public static List<Errata> publishToChannel(List<Errata> errataList, Channel chan, User user,
boolean inheritPackages) {
- if (!errata.isPublished()) {
- errata = publish(errata);
- }
- errata.addChannel(chan);
- errata.addChannelNotification(chan, new Date());
-
- Set<Package> packagesToPush = new HashSet<Package>();
- DataResult<PackageOverview> packs;
- if (inheritPackages) {
- if (!chan.isCloned()) {
- throw new InvalidChannelException("Cloned channel expected: " +
- chan.getLabel());
- }
- Channel original = ((ClonedChannel) chan).getOriginal();
- packs = ErrataManager.listErrataChannelPacks(original, errata, user);
- }
- else {
- packs = ErrataManager.lookupPacksFromErrataForChannel(chan, errata, user);
- }
- for (PackageOverview packOver : packs) {
- //lookup the Package object
- Package pack = PackageFactory.lookupByIdAndUser(
- packOver.getId().longValue(), user);
- packagesToPush.add(pack);
- }
- return publishErrataPackagesToChannel(errata, chan, user, packagesToPush);
- }
-
- /**
- * Publish an errata to a channel but only push a small set of packages along with it
- * @param errata errata to publish
- * @param chan channel to publish it into.
- * @param user the user doing the pushing
- * @param packages the packages to push
- * @return the published errata
- */
- public static Errata publishToChannel(Errata errata, Channel chan, User user,
- Set<Package> packages) {
- if (!errata.isPublished()) {
- errata = publish(errata);
- }
- errata.addChannel(chan);
- return publishErrataPackagesToChannel(errata, chan, user, packages);
+ List<com.redhat.rhn.domain.errata.Errata> toReturn = new ArrayList<Errata>();
+ for (Errata errata : errataList) {
+ if (!errata.isPublished()) {
+ errata = publish(errata);
+ }
+ errata.addChannel(chan);
+ errata.addChannelNotification(chan, new Date());
+
+ Set<Package> packagesToPush = new HashSet<Package>();
+ DataResult<PackageOverview> packs;
+ if (inheritPackages) {
+
+ if (!chan.isCloned()) {
+ throw new InvalidChannelException("Cloned channel expected: " +
+ chan.getLabel());
+ }
+ Channel original = ((ClonedChannel) chan).getOriginal();
+ packs = ErrataManager.listErrataChannelPacks(original, errata, user);
+ }
+ else {
+ packs = ErrataManager.lookupPacksFromErrataForChannel(chan, errata, user);
+ }
+
+ for (PackageOverview packOver : packs) {
+ //lookup the Package object
+ Package pack = PackageFactory.lookupByIdAndUser(
+ packOver.getId().longValue(), user);
+ packagesToPush.add(pack);
+ }
+
+ Errata e = publishErrataPackagesToChannel(errata, chan, user, packagesToPush);
+ toReturn.add(e);
+ }
+ postPublishActions(chan, user);
+ return toReturn;
}
-
+
+
+ /**
+ * Publish an errata to a channel but only push a small set of packages
+ * along with it
+ *
+ * @param errata errata to publish
+ * @param chan channel to publish it into.
+ * @param user the user doing the pushing
+ * @param packages the packages to push
+ * @return the published errata
+ */
+ public static Errata publishToChannel(Errata errata, Channel chan,
+ User user, Set<Package> packages) {
+ if (!errata.isPublished()) {
+ errata = publish(errata);
+ }
+ errata.addChannel(chan);
+ errata = publishErrataPackagesToChannel(errata, chan, user, packages);
+ postPublishActions(chan, user);
+ return errata;
+ }
+
+
+ private static void postPublishActions(Channel chan, User user) {
+ ChannelManager.refreshWithNewestPackages(chan, "web.errata_push");
+ ChannelManager.queueChannelChange(chan.getLabel(),
+ "java::publishErrataPackagesToChannel", user.getLogin());
+ }
+
+
/**
* Private helper method that pushes errata packages to a channel
*/
- private static Errata publishErrataPackagesToChannel(Errata errata, Channel chan,
- User user, Set<Package> packages) {
- for (Package pack : packages) {
-
- //push the package to the approrpiate channel
- chan.addPackage(pack);
-
- List<ErrataFile> publishedFiles = ErrataFactory.lookupErrataFile(errata, pack);
- Map<String, ErrataFile> toAdd = new HashMap();
- if (publishedFiles.size() == 0) {
- //Now create the appropriate ErrataFile object
- ErrataFile publishedFile = ErrataFactory.createPublishedErrataFile(
- ErrataFactory.lookupErrataFileType("RPM"),
- pack.getChecksum().getChecksum(), pack.getNameEvra());
- publishedFile.addPackage(pack);
- publishedFile.setErrata(errata);
- publishedFile.setModified(new Date());
- ((PublishedErrataFile) publishedFile).addChannel(chan);
- singleton.saveObject(publishedFile);
- }
- else {
- for (ErrataFile publishedFile : publishedFiles) {
- String fileName = publishedFile.getFileName().substring(
- publishedFile.getFileName().lastIndexOf("/") + 1);
- if (!toAdd.containsKey(fileName)) {
- toAdd.put(fileName, publishedFile);
- ((PublishedErrataFile) publishedFile).addChannel(chan);
- singleton.saveObject(publishedFile);
- }
- }
- }
-
- }
-
- ChannelFactory.save(chan);
-
- List chanList = new ArrayList();
- chanList.add(chan.getId());
- //ErrataCacheManager.updateErrataCacheForChannelsAsync(chanList, user.getOrg());
- ErrataCacheManager.insertCacheForChannelErrataAsync(chanList, errata);
- ChannelManager.refreshWithNewestPackages(chan, "web.errata_push");
-
- // Mark the affected channel to have it's metadata evaluated, where necessary
- // (RHEL5+, mostly)
- ChannelManager.queueChannelChange(chan.getLabel(),
- "java::publishErrataPackagesToChannel", user.getLogin());
-
- return errata;
- }
+ private static Errata publishErrataPackagesToChannel(Errata errata,
+ Channel chan, User user, Set<Package> packages) {
+ // Much quicker to push all packages at once
+ List<Long> pids = new ArrayList<Long>();
+ for (Package pack : packages) {
+ pids.add(pack.getId());
+ }
+ ChannelManager.addPackages(chan, pids, user);
+
+ for (Package pack : packages) {
+ List<ErrataFile> publishedFiles = ErrataFactory.lookupErrataFile(
+ errata, pack);
+ Map<String, ErrataFile> toAdd = new HashMap();
+ if (publishedFiles.size() == 0) {
+ // Now create the appropriate ErrataFile object
+ ErrataFile publishedFile = ErrataFactory
+ .createPublishedErrataFile(ErrataFactory
+ .lookupErrataFileType("RPM"), pack
+ .getChecksum().getChecksum(), pack
+ .getNameEvra());
+ publishedFile.addPackage(pack);
+ publishedFile.setErrata(errata);
+ publishedFile.setModified(new Date());
+ ((PublishedErrataFile) publishedFile).addChannel(chan);
+ singleton.saveObject(publishedFile);
+ } else {
+ for (ErrataFile publishedFile : publishedFiles) {
+ String fileName = publishedFile.getFileName().substring(
+ publishedFile.getFileName().lastIndexOf("/") + 1);
+ if (!toAdd.containsKey(fileName)) {
+ toAdd.put(fileName, publishedFile);
+ ((PublishedErrataFile) publishedFile).addChannel(chan);
+ singleton.saveObject(publishedFile);
+ }
+ }
+ }
+
+ }
+ ChannelFactory.save(chan);
+ List chanList = new ArrayList();
+ chanList.add(chan.getId());
+
+ ErrataCacheManager.insertCacheForChannelErrataAsync(chanList, errata);
+
+ return errata;
+ }
/**
* @param org Org performing the cloning
diff --git a/java/code/src/com/redhat/rhn/domain/errata/test/ErrataFactoryTest.java b/java/code/src/com/redhat/rhn/domain/errata/test/ErrataFactoryTest.java
index deaa3d4..d91f5ec 100644
--- a/java/code/src/com/redhat/rhn/domain/errata/test/ErrataFactoryTest.java
+++ b/java/code/src/com/redhat/rhn/domain/errata/test/ErrataFactoryTest.java
@@ -42,6 +42,7 @@ import com.redhat.rhn.testing.ChannelTestUtils;
import com.redhat.rhn.testing.TestUtils;
import com.redhat.rhn.testing.UserTestUtils;
+import java.util.ArrayList;
import java.util.Date;
import java.util.HashMap;
import java.util.HashSet;
@@ -138,7 +139,10 @@ public class ErrataFactoryTest extends BaseTestCaseWithUser {
channel.addPackage(chanPack);
e.addPackage(errataPack);
- Errata published = ErrataFactory.publishToChannel(e, channel, user, false);
+ List<Errata> errataList = new ArrayList<Errata>();
+ errataList.add(e);
+ List<Errata> publishedList = ErrataFactory.publishToChannel(errataList, channel, user, false);
+ Errata published = publishedList.get(0);
assertTrue(channel.getPackages().contains(errataPack));
List<PublishedErrataFile> errataFile =
ErrataFactory.lookupErrataFilesByErrataAndFileType(published.getId(), "RPM");
diff --git a/java/code/src/com/redhat/rhn/frontend/xmlrpc/errata/ErrataHandler.java b/java/code/src/com/redhat/rhn/frontend/xmlrpc/errata/ErrataHandler.java
index e9e8c72..93d63e3 100644
--- a/java/code/src/com/redhat/rhn/frontend/xmlrpc/errata/ErrataHandler.java
+++ b/java/code/src/com/redhat/rhn/frontend/xmlrpc/errata/ErrataHandler.java
@@ -36,6 +36,7 @@ import com.redhat.rhn.domain.org.Org;
import com.redhat.rhn.domain.rhnpackage.Package;
import com.redhat.rhn.domain.rhnpackage.PackageFactory;
import com.redhat.rhn.domain.user.User;
+import com.redhat.rhn.frontend.action.channel.manage.PublishErrataHelper;
import com.redhat.rhn.frontend.dto.CVE;
import com.redhat.rhn.frontend.dto.PackageDto;
import com.redhat.rhn.frontend.xmlrpc.BaseHandler;
@@ -58,8 +59,10 @@ import com.redhat.rhn.manager.user.UserManager;
import org.apache.commons.collections.IteratorUtils;
import org.apache.commons.lang.StringUtils;
+import org.apache.log4j.Logger;
import java.util.ArrayList;
+import java.util.Calendar;
import java.util.Date;
import java.util.HashMap;
import java.util.HashSet;
@@ -68,6 +71,7 @@ import java.util.List;
import java.util.Map;
import java.util.Set;
+
/**
* ErrataHandler - provides methods to access errata information.
* @version $Rev$
@@ -871,8 +875,16 @@ public class ErrataHandler extends BaseHandler {
*/
public Object[] clone(String sessionKey, String channelLabel,
List advisoryNames) throws InvalidChannelRoleException {
- User loggedInUser = getLoggedInUser(sessionKey);
+ return clone(sessionKey, channelLabel, advisoryNames, false);
+ }
+
+ private Object[] clone(String sessionKey, String channelLabel,
+ List<String> advisoryNames, boolean inheritAllPackages){
+ User loggedInUser = getLoggedInUser(sessionKey);
+
+ Logger log = Logger.getLogger(ErrataFactory.class);
+
Channel channel = ChannelFactory.lookupByLabelAndUser(channelLabel,
loggedInUser);
@@ -880,32 +892,61 @@ public class ErrataHandler extends BaseHandler {
throw new NoSuchChannelException();
}
- if (!UserManager.verifyChannelAdmin(loggedInUser, channel)) {
- throw new PermissionCheckFailureException();
+ if (!channel.isCloned()) {
+ throw new InvalidChannelException("Cloned channel expected: " +
+ channel.getLabel());
}
- List errataToClone = new ArrayList();
- List toReturn = new ArrayList();
+ Channel original = ChannelFactory.lookupOriginalChannel(channel);
- //We loop through once, making sure all the errata exist
- for (Iterator itr = advisoryNames.iterator(); itr.hasNext();) {
- Errata toClone = lookupErrata((String)itr.next(), loggedInUser.getOrg());
- errataToClone.add(toClone);
+ if (original == null) {
+ throw new InvalidChannelException("Cannot access original " +
+ "of the channel: " + channel.getLabel());
}
- //now that we know its all valid, we clone everything.
- for (Iterator itr = errataToClone.iterator(); itr.hasNext();) {
- Errata cloned = ErrataManager.createClone(loggedInUser, (Errata)itr.next());
- Errata publishedClone = ErrataManager.publish(cloned);
- publishedClone = ErrataFactory.publishToChannel(publishedClone, channel,
- loggedInUser, false);
- ErrataFactory.save(publishedClone);
+ // check access to the original
+ if (ChannelFactory.lookupByIdAndUser(original.getId(), loggedInUser) == null) {
+ throw new LookupException("User " + loggedInUser.getLogin() +
+ " does not have access to channel " + original.getLabel());
+ }
- toReturn.add(publishedClone);
+ if (!UserManager.verifyChannelAdmin(loggedInUser, channel)) {
+ throw new PermissionCheckFailureException();
}
- return toReturn.toArray();
- }
+
+ List<Errata> errataToClone = new ArrayList<Errata>();
+ List<Errata> errataToPublish = new ArrayList<Errata>();
+ List<Errata> toReturn = new ArrayList<Errata>();
+ //We loop through once, making sure all the errata exist
+ for (String advisory : advisoryNames) {
+ Errata toClone = lookupErrata(advisory, loggedInUser.getOrg());
+ errataToClone.add(toClone);
+ }
+
+ //For each errata look up existing clones, or manually clone it
+ for (Errata toClone : errataToClone) {
+ List<Errata> clones = ErrataManager.lookupPublishedByOriginal(
+ loggedInUser, toClone);
+ if (clones.isEmpty()) {
+ errataToPublish.add(PublishErrataHelper.cloneErrataFast(toClone, loggedInUser.getOrg()));
+ }
+ else {
+ errataToPublish.add(clones.get(0));
+ }
+ }
+
+ //Now publish them all to the channel in a single shot
+ List<Errata> published = ErrataFactory.publishToChannel(errataToPublish, channel,
+ loggedInUser, true);
+ for (Errata e : published) {
+ ErrataFactory.save(e);
+ }
+
+ return toReturn.toArray();
+ }
+
+
/**
* Clones a list of errata into a specified cloned channel
* according the original erratas
@@ -929,61 +970,13 @@ public class ErrataHandler extends BaseHandler {
* #array_end()
*/
public Object[] cloneAsOriginal(String sessionKey, String channelLabel,
- List advisoryNames) throws InvalidChannelRoleException {
- User loggedInUser = getLoggedInUser(sessionKey);
-
- Channel channel = ChannelFactory.lookupByLabelAndUser(channelLabel,
- loggedInUser);
-
- if (channel == null) {
- throw new NoSuchChannelException();
- }
-
- if (!channel.isCloned()) {
- throw new InvalidChannelException("Cloned channel expected: " +
- channel.getLabel());
- }
-
- Channel original = ChannelFactory.lookupOriginalChannel(channel);
-
- if (original == null) {
- throw new InvalidChannelException("Cannot access original " +
- "of the channel: " + channel.getLabel());
- }
-
- // check access to the original
- if (ChannelFactory.lookupByIdAndUser(original.getId(), loggedInUser) == null) {
- throw new LookupException("User " + loggedInUser.getLogin() +
- " does not have access to channel " + original.getLabel());
- }
-
- if (!UserManager.verifyChannelAdmin(loggedInUser, channel)) {
- throw new PermissionCheckFailureException();
- }
-
- List errataToClone = new ArrayList();
- List toReturn = new ArrayList();
-
- //We loop through once, making sure all the errata exist
- for (Iterator itr = advisoryNames.iterator(); itr.hasNext();) {
- Errata toClone = lookupErrata((String)itr.next(), loggedInUser.getOrg());
- errataToClone.add(toClone);
- }
- //now that we know its all valid, we clone everything.
- for (Iterator itr = errataToClone.iterator(); itr.hasNext();) {
- Errata cloned = ErrataManager.createClone(loggedInUser, (Errata)itr.next());
- Errata publishedClone = ErrataManager.publish(cloned);
-
- publishedClone = ErrataFactory.publishToChannel(publishedClone, channel,
- loggedInUser, true);
- ErrataFactory.save(publishedClone);
-
- toReturn.add(publishedClone);
- }
- return toReturn.toArray();
+ List<String> advisoryNames) throws InvalidChannelRoleException {
+ return clone(sessionKey, channelLabel, advisoryNames, true);
}
+
+
private Object getRequiredAttribute(Map map, String attribute) {
Object value = map.get(attribute);
if (value == null || StringUtils.isEmpty(value.toString())) {
@@ -1329,8 +1322,11 @@ public class ErrataHandler extends BaseHandler {
boolean inheritPackages) {
Errata published = ErrataFactory.publish(errata);
for (Channel chan : channels) {
- published = ErrataFactory.publishToChannel(published, chan, user,
- inheritPackages);
+ List<Errata> list = new ArrayList<Errata>();
+ list.add(published);
+ published = ErrataFactory.publishToChannel(list, chan, user,
+ inheritPackages).get(0);
+
}
return published;
}
diff --git a/java/code/src/com/redhat/rhn/manager/channel/ChannelEditor.java b/java/code/src/com/redhat/rhn/manager/channel/ChannelEditor.java
index ef14bbe..748145d 100644
--- a/java/code/src/com/redhat/rhn/manager/channel/ChannelEditor.java
+++ b/java/code/src/com/redhat/rhn/manager/channel/ChannelEditor.java
@@ -100,10 +100,6 @@ public class ChannelEditor {
longPackageIds.add(new Long(((Number)it.next()).longValue()));
}
- List<Long> existingPids = ChannelFactory.getPackageIds(channel.getId());
- if (add) {
- longPackageIds.removeAll(existingPids);
- }
PackageManager.verifyPackagesChannelArchCompatAndOrgAccess(user,
channel, longPackageIds, add);
diff --git a/java/code/src/com/redhat/rhn/manager/channel/test/ChannelManagerTest.java b/java/code/src/com/redhat/rhn/manager/channel/test/ChannelManagerTest.java
index 3ffc957..4c92285 100644
--- a/java/code/src/com/redhat/rhn/manager/channel/test/ChannelManagerTest.java
+++ b/java/code/src/com/redhat/rhn/manager/channel/test/ChannelManagerTest.java
@@ -292,7 +292,9 @@ public class ChannelManagerTest extends BaseTestCaseWithUser {
public void testListErrata() throws Exception {
Channel c = ChannelFactoryTest.createTestChannel(user);
Errata e = ErrataFactoryTest.createTestErrata(user.getOrg().getId());
- ErrataFactory.publishToChannel(e, c, user, false);
+ List<Errata> errataList = new ArrayList<Errata>();
+ errataList.add(e);
+ ErrataFactory.publishToChannel(errataList, c, user, false);
e = (Errata) TestUtils.saveAndReload(e);
@@ -828,8 +830,10 @@ public class ChannelManagerTest extends BaseTestCaseWithUser {
public void testRemoveErrata() throws Exception {
Channel c = ChannelFactoryTest.createTestChannel(user);
+ List<Errata> errataList = new ArrayList<Errata>();
Errata e = ErrataFactoryTest.createTestErrata(user.getOrg().getId());
- ErrataFactory.publishToChannel(e, c, user, false);
+ errataList.add(e);
+ ErrataFactory.publishToChannel(errataList, c, user, false);
e = (Errata) TestUtils.saveAndReload(e);
diff --git a/java/code/src/com/redhat/rhn/manager/errata/test/ErrataManagerTest.java b/java/code/src/com/redhat/rhn/manager/errata/test/ErrataManagerTest.java
index 959d930..e35ff11 100644
--- a/java/code/src/com/redhat/rhn/manager/errata/test/ErrataManagerTest.java
+++ b/java/code/src/com/redhat/rhn/manager/errata/test/ErrataManagerTest.java
@@ -173,7 +173,10 @@ public class ErrataManagerTest extends RhnBaseTestCase {
e.addPackage(p);
Channel baseChannel = ChannelTestUtils.createBaseChannel(user);
- Errata publish = ErrataFactory.publishToChannel(e, baseChannel, user, false);
+ List<Errata> errataList = new ArrayList<Errata>();
+ errataList.add(e);
+ List<Errata> publishedList = ErrataFactory.publishToChannel(errataList, baseChannel, user, false);
+ Errata publish = publishedList.get(0);
assertTrue(publish instanceof PublishedErrata);
List eids = new ArrayList();
11 years, 4 months
Changes to 'refs/tags/spacewalk-java-1.7.15-1'
by Tomas Lestach
Tag 'spacewalk-java-1.7.15-1' created by Tomas Lestach <tlestach(a)redhat.com> at 2012-01-31 16:49 +0000
Tagging package [spacewalk-java] version [1.7.15-1] in directory [java/].
Changes since spacewalk-web-1.7.13-1:
Tomas Lestach (2):
prevent having unsued idle PG transaction/session
Automatic commit of package [spacewalk-java] release [1.7.15-1].
---
java/code/src/com/redhat/rhn/taskomatic/TaskoJob.java | 1 +
java/spacewalk-java.spec | 5 ++++-
rel-eng/packages/spacewalk-java | 2 +-
3 files changed, 6 insertions(+), 2 deletions(-)
---
11 years, 4 months
java/spacewalk-java.spec rel-eng/packages
by Tomas Lestach
java/spacewalk-java.spec | 5 ++++-
rel-eng/packages/spacewalk-java | 2 +-
2 files changed, 5 insertions(+), 2 deletions(-)
New commits:
commit 09baa24f8489323b905abfa8b0f5eacfed08c63d
Author: Tomas Lestach <tlestach(a)redhat.com>
Date: Tue Jan 31 17:49:09 2012 +0100
Automatic commit of package [spacewalk-java] release [1.7.15-1].
diff --git a/java/spacewalk-java.spec b/java/spacewalk-java.spec
index b4636a8..08e7d0a 100644
--- a/java/spacewalk-java.spec
+++ b/java/spacewalk-java.spec
@@ -17,7 +17,7 @@ Name: spacewalk-java
Summary: Spacewalk Java site packages
Group: Applications/Internet
License: GPLv2
-Version: 1.7.14
+Version: 1.7.15
Release: 1%{?dist}
URL: https://fedorahosted.org/spacewalk
Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz
@@ -555,6 +555,9 @@ fi
%{jardir}/postgresql-jdbc.jar
%changelog
+* Tue Jan 31 2012 Tomas Lestach <tlestach(a)redhat.com> 1.7.15-1
+- prevent having unsued idle PG transaction/session (tlestach(a)redhat.com)
+
* Tue Jan 31 2012 Jan Pazdziora 1.7.14-1
- Removing the web.debug_disable_database option -- it is not supported beyond
RHN::DB anyway.
diff --git a/rel-eng/packages/spacewalk-java b/rel-eng/packages/spacewalk-java
index 92b5f86..b63b014 100644
--- a/rel-eng/packages/spacewalk-java
+++ b/rel-eng/packages/spacewalk-java
@@ -1 +1 @@
-1.7.14-1 java/
+1.7.15-1 java/
11 years, 4 months
java/code
by Tomas Lestach
java/code/src/com/redhat/rhn/taskomatic/TaskoJob.java | 1 +
1 file changed, 1 insertion(+)
New commits:
commit 7908442ccc93e497fe2419439d5a2e7b4e88f98c
Author: Tomas Lestach <tlestach(a)redhat.com>
Date: Tue Jan 31 17:19:30 2012 +0100
prevent having unsued idle PG transaction/session
diff --git a/java/code/src/com/redhat/rhn/taskomatic/TaskoJob.java b/java/code/src/com/redhat/rhn/taskomatic/TaskoJob.java
index 1915156..4d47c11 100644
--- a/java/code/src/com/redhat/rhn/taskomatic/TaskoJob.java
+++ b/java/code/src/com/redhat/rhn/taskomatic/TaskoJob.java
@@ -49,6 +49,7 @@ public class TaskoJob implements Job {
locks.put(task.getName(), new Object());
lastStatus.put(task.getName(), TaskoRun.STATUS_FINISHED);
}
+ TaskoFactory.closeSession();
}
/**
11 years, 4 months
Changes to 'refs/tags/spacewalk-web-1.7.13-1'
by Miroslav Suchý
Tag 'spacewalk-web-1.7.13-1' created by Miroslav Suchý <msuchy(a)redhat.com> at 2012-01-31 15:37 +0000
Tagging package [spacewalk-web] version [1.7.13-1] in directory [web/].
Changes since perl-NOCpulse-OracleDB-1.28.25-1:
Jan Pazdziora (1):
Purging old NOT-USED stuff.
Michael Mraka (2):
removing non-working debugging scripts
Purging old NOT-USED stuff.
Miroslav Suchý (21):
rewrite rhn_repo_regen_queue_id_seq.nextval to sequence_nextval('rhn_repo_regen_queue_id_seq')
rewrite rhn_template_str_id_seq.nextval to sequence_nextval('rhn_template_str_id_seq')
rewrite rhn_server_id_seq.nextval to sequence_nextval('rhn_server_id_seq')
rewrite rhn_server_loc_id_seq.nextval to sequence_nextval('rhn_server_loc_id_seq')
rewrite rhn_act_p_id_seq.nextval to sequence_nextval('rhn_act_p_id_seq')
rewrite rhn_actioncr_id_seq.nextval to sequence_nextval('rhn_actioncr_id_seq')
rewrite rhn_packagedelta_id_seq.nextval to sequence_nextval('rhn_packagedelta_id_seq')
code cleanup - callback rhn:sync_server_cb is not used
rewrite rhn_server_profile_id_seq.nextval to sequence_nextval('rhn_server_profile_id_seq')
code cleanup - sequence rhn_org_id_seq is not defined
use sequence_nextval rather then .nextval
rewrite rhn_ks_session_id_seq.nextval to sequence_nextval('rhn_ks_session_id_seq')
rewrite rhn_ks_id_seq.nextval to sequence_nextval('rhn_ks_id_seq')
rewrite rhn_ksscript_id_seq.nextval to sequence_nextval('rhn_ksscript_id_seq')
rewrite rhn_kstree_id_seq.nextval to sequence_nextval('rhn_kstree_id_seq')
rewrite rhn_filelist_id_seq.nextval to sequence_nextval('rhn_filelist_id_seq')
rewrite rhn_cdatakey_id_seq.nextval to sequence_nextval('rhn_cdatakey_id_seq')
use sequence_nextval rather then .nextval
rewrite rhn_confcontent_id_seq.nextval to sequence_nextval('rhn_confcontent_id_seq')
rewrite rhn_wcon_disabled_seq.nextval to sequence_nextval('rhn_wcon_disabled_seq')
Automatic commit of package [spacewalk-web] release [1.7.13-1].
---
monitoring/NOT-USED/README | 6
monitoring/NOT-USED/scdb_accessor_perl/BUILD | 46
monitoring/NOT-USED/scdb_accessor_perl/BUILD.spec | 116
monitoring/NOT-USED/scdb_accessor_perl/NOCpulse/SCDB/Accessor.pm | 350 -
monitoring/NOT-USED/scdb_accessor_perl/README | 112
monitoring/NOT-USED/scdb_accessor_perl/version | 1
monitoring/NOT-USED/tsdb_accessor_perl/BUILD | 47
monitoring/NOT-USED/tsdb_accessor_perl/BUILD.spec | 117
monitoring/NOT-USED/tsdb_accessor_perl/NOCpulse/TSDB/Accessor.pm | 375 -
monitoring/NOT-USED/tsdb_accessor_perl/README | 111
monitoring/NOT-USED/tsdb_accessor_perl/version | 1
monitoring/PerlModules/NP/NOT-USED/DocGen/CustomPod.pm | 224
monitoring/PerlModules/NP/NOT-USED/DocGen/pod.css | 78
monitoring/PerlModules/NP/NOT-USED/Getresuid/BUILD | 45
monitoring/PerlModules/NP/NOT-USED/Getresuid/Changes | 6
monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.pm | 82
monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.xs | 48
monitoring/PerlModules/NP/NOT-USED/Getresuid/MANIFEST | 7
monitoring/PerlModules/NP/NOT-USED/Getresuid/Makefile.PL | 10
monitoring/PerlModules/NP/NOT-USED/Getresuid/README | 27
monitoring/PerlModules/NP/NOT-USED/Getresuid/test.pl | 33
monitoring/PerlModules/NP/NOT-USED/Handlers/BUILD | 59
monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheLog.pm | 96
monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheRequest.pm | 47
monitoring/PerlModules/NP/NOT-USED/Handlers/handle.pl | 29
monitoring/PerlModules/NP/NOT-USED/Handlers/handler.pm | 53
monitoring/PerlModules/NP/NOT-USED/KudzuDevice/BUILD | 39
monitoring/PerlModules/NP/NOT-USED/KudzuDevice/KudzuDevice.pm | 55
monitoring/PerlModules/NP/NOT-USED/KudzuDevice/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/KudzuDevice/devdump | 5
monitoring/PerlModules/NP/NOT-USED/NP_CVS/BUILD | 47
monitoring/PerlModules/NP/NOT-USED/NP_CVS/CVS.pm | 68
monitoring/PerlModules/NP/NOT-USED/NP_CVS/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/NP_CVS/TestCVS.pl | 12
monitoring/PerlModules/NP/NOT-USED/NP_RPM/BUILD | 45
monitoring/PerlModules/NP/NOT-USED/NP_RPM/MANIFEST | 6
monitoring/PerlModules/NP/NOT-USED/NP_RPM/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/NP_RPM/README | 35
monitoring/PerlModules/NP/NOT-USED/NP_RPM/RPM.pm | 111
monitoring/PerlModules/NP/NOT-USED/NP_RPM/test.pl | 17
monitoring/PerlModules/NP/NOT-USED/NP_RPM/test/TestRPM.pl | 12
monitoring/PerlModules/NP/NOT-USED/PackingList/BUILD | 41
monitoring/PerlModules/NP/NOT-USED/PackingList/MANIFEST | 93
monitoring/PerlModules/NP/NOT-USED/PackingList/PackingList.pm | 163
monitoring/PerlModules/NP/NOT-USED/PackingList/testPackingList.pl | 19
monitoring/PerlModules/NP/NOT-USED/PlugFrame/BUILD | 44
monitoring/PerlModules/NP/NOT-USED/PlugFrame/MANIFEST | 11
monitoring/PerlModules/NP/NOT-USED/PlugFrame/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/PlugFrame/Metric.pm | 38
monitoring/PerlModules/NP/NOT-USED/PlugFrame/Plugin.pm | 569 --
monitoring/PerlModules/NP/NOT-USED/PlugFrame/PortableShellProbe.pm | 178
monitoring/PerlModules/NP/NOT-USED/PlugFrame/Probe.pm | 772 ---
monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeGenerator.pm | 44
monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeState.pm | 92
monitoring/PerlModules/NP/NOT-USED/PlugFrame/README | 24
monitoring/PerlModules/NP/NOT-USED/PlugFrame/ShellProbe.pm | 238
monitoring/PerlModules/NP/NOT-USED/PlugFrame/test.pl | 23
monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/TestSwitches.pm | 111
monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/run.pl | 27
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/BUILD | 50
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/ReleaseDB.pm | 1513 -----
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/TO_DO | 20
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/UTILITIES | 151
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/test/TestRelease.pm | 1000 ---
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/tst | 20
monitoring/PerlModules/NP/NOT-USED/Spread/BUILD | 51
monitoring/PerlModules/NP/NOT-USED/Spread/Filters.pm | 112
monitoring/PerlModules/NP/NOT-USED/Spread/SpreadNetwork.pm | 944 ---
monitoring/PerlModules/NP/NOT-USED/Spread/SpreadServers.pm | 296 -
monitoring/PerlModules/NP/NOT-USED/Spread/blitzcom.pl | 25
monitoring/PerlModules/NP/NOT-USED/Spread/cmdserv.pl | 46
monitoring/PerlModules/NP/NOT-USED/Spread/com.pl | 25
monitoring/PerlModules/NP/NOT-USED/Spread/memcli.pl | 30
monitoring/PerlModules/NP/NOT-USED/Spread/memserv.pl | 63
monitoring/PerlModules/NP/NOT-USED/Spread/ootest.pl | 23
monitoring/PerlModules/NP/NOT-USED/Spread/scheduler.pl | 27
monitoring/PerlModules/NP/NOT-USED/Spread/spkernel.pl | 30
monitoring/PerlModules/NP/NOT-USED/Spread/sputnik | 62
monitoring/PerlModules/NP/NOT-USED/TelAlert/BUILD | 52
monitoring/PerlModules/NP/NOT-USED/TelAlert/SQLtest.pl | 208
monitoring/PerlModules/NP/NOT-USED/TelAlert/TelAlert.pm | 2562 ----------
monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD | 52
monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD.spec | 59
monitoring/PerlModules/NP/NOT-USED/Time-System/Changes | 6
monitoring/PerlModules/NP/NOT-USED/Time-System/MANIFEST | 7
monitoring/PerlModules/NP/NOT-USED/Time-System/Makefile.PL | 17
monitoring/PerlModules/NP/NOT-USED/Time-System/README | 35
monitoring/PerlModules/NP/NOT-USED/Time-System/System.pm | 112
monitoring/PerlModules/NP/NOT-USED/Time-System/System.xs | 35
monitoring/PerlModules/NP/NOT-USED/Time-System/test.pl | 29
monitoring/PerlModules/NP/NOT-USED/Time-System/version | 1
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/BUILD | 48
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/MANIFEST | 5
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/README | 17
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/TroubleTicket.pm | 703 --
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test.pl | 17
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test/test-TroubleTicket.pl | 14
monitoring/scdb/fetch_state_changes | 57
monitoring/tsdb/fetch_time_series | 57
rel-eng/packages/spacewalk-web | 2
schema/util/disable-user.sql | 2
schema/util/enable-user.sql | 2
web/modules/rhn/RHN/DB/Channel.pm | 4
web/modules/rhn/RHN/DB/ChannelEditor.pm | 6
web/modules/rhn/RHN/DB/ConfigRevision.pm | 2
web/modules/rhn/RHN/DB/ContactGroup.pm | 2
web/modules/rhn/RHN/DB/CustomInfoKey.pm | 4
web/modules/rhn/RHN/DB/FileList.pm | 2
web/modules/rhn/RHN/DB/KSTree.pm | 2
web/modules/rhn/RHN/DB/Kickstart.pm | 4
web/modules/rhn/RHN/DB/Kickstart/Session.pm | 2
web/modules/rhn/RHN/DB/Notes.pm | 2
web/modules/rhn/RHN/DB/Org.pm | 12
web/modules/rhn/RHN/DB/Profile.pm | 2
web/modules/rhn/RHN/DB/Scheduler.pm | 22
web/modules/rhn/RHN/DB/Server.pm | 6
web/modules/rhn/RHN/DB/TemplateString.pm | 2
web/modules/sniglets/Sniglets/ListView/PackageList.pm | 2
web/modules/sniglets/Sniglets/Profiles.pm | 2
web/spacewalk-web.spec | 5
121 files changed, 40 insertions(+), 13750 deletions(-)
---
11 years, 4 months
rel-eng/packages web/spacewalk-web.spec
by Miroslav Suchý
rel-eng/packages/spacewalk-web | 2 +-
web/spacewalk-web.spec | 5 ++++-
2 files changed, 5 insertions(+), 2 deletions(-)
New commits:
commit ab57c802bf8702f79ae7bfdd6dbfae0c6f67eb6c
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 16:37:58 2012 +0100
Automatic commit of package [spacewalk-web] release [1.7.13-1].
diff --git a/rel-eng/packages/spacewalk-web b/rel-eng/packages/spacewalk-web
index 0bee191..106880f 100644
--- a/rel-eng/packages/spacewalk-web
+++ b/rel-eng/packages/spacewalk-web
@@ -1 +1 @@
-1.7.12-1 web/
+1.7.13-1 web/
diff --git a/web/spacewalk-web.spec b/web/spacewalk-web.spec
index db74530..45155e4 100644
--- a/web/spacewalk-web.spec
+++ b/web/spacewalk-web.spec
@@ -2,7 +2,7 @@ Name: spacewalk-web
Summary: Spacewalk Web site - Perl modules
Group: Applications/Internet
License: GPLv2
-Version: 1.7.12
+Version: 1.7.13
Release: 1%{?dist}
URL: https://fedorahosted.org/spacewalk/
Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz
@@ -254,6 +254,9 @@ rm -rf $RPM_BUILD_ROOT
# $Id$
%changelog
+* Tue Jan 31 2012 Miroslav Suchý 1.7.13-1
+- port usage of sequences to PostgreSQL
+
* Tue Jan 31 2012 Jan Pazdziora 1.7.12-1
- code cleanup: users are not created in web any more (msuchy(a)redhat.com)
- The RHN::DB::connect does not accept any arguments anymore.
11 years, 4 months
20 commits - schema/util web/modules
by Miroslav Suchý
schema/util/disable-user.sql | 2 -
schema/util/enable-user.sql | 2 -
web/modules/rhn/RHN/DB/Channel.pm | 4 +--
web/modules/rhn/RHN/DB/ChannelEditor.pm | 6 ++--
web/modules/rhn/RHN/DB/ConfigRevision.pm | 2 -
web/modules/rhn/RHN/DB/ContactGroup.pm | 2 -
web/modules/rhn/RHN/DB/CustomInfoKey.pm | 4 +--
web/modules/rhn/RHN/DB/FileList.pm | 2 -
web/modules/rhn/RHN/DB/KSTree.pm | 2 -
web/modules/rhn/RHN/DB/Kickstart.pm | 4 +--
web/modules/rhn/RHN/DB/Kickstart/Session.pm | 2 -
web/modules/rhn/RHN/DB/Notes.pm | 2 -
web/modules/rhn/RHN/DB/Org.pm | 12 ---------
web/modules/rhn/RHN/DB/Profile.pm | 2 -
web/modules/rhn/RHN/DB/Scheduler.pm | 22 +++++++++---------
web/modules/rhn/RHN/DB/Server.pm | 6 ++--
web/modules/rhn/RHN/DB/TemplateString.pm | 2 -
web/modules/sniglets/Sniglets/ListView/PackageList.pm | 2 -
web/modules/sniglets/Sniglets/Profiles.pm | 2 -
19 files changed, 35 insertions(+), 47 deletions(-)
New commits:
commit 3d092050bcc07f852acdd7e93bed053dbbcc5115
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 15:42:06 2012 +0100
rewrite rhn_wcon_disabled_seq.nextval to sequence_nextval('rhn_wcon_disabled_seq')
diff --git a/schema/util/disable-user.sql b/schema/util/disable-user.sql
index 6c710ba..e86e300 100644
--- a/schema/util/disable-user.sql
+++ b/schema/util/disable-user.sql
@@ -1,7 +1,7 @@
insert into rhnWebContactChangeLog
(id, web_contact_id, web_contact_from_id, change_state_id, date_completed)
values
-(rhn_wcon_disabled_seq.nextval,
+(sequence_nextval('rhn_wcon_disabled_seq'),
(select id from web_contact where login_uc = upper('$i')),
null,
(select id from rhnWebContactChangeState where label = 'disabled'),
diff --git a/schema/util/enable-user.sql b/schema/util/enable-user.sql
index ecca947..a048c90 100644
--- a/schema/util/enable-user.sql
+++ b/schema/util/enable-user.sql
@@ -1,7 +1,7 @@
insert into rhnWebContactChangeLog
(id, web_contact_id, web_contact_from_id, change_state_id, date_completed)
values
-(rhn_wcon_disabled_seq.nextval,
+(sequence_nextval('rhn_wcon_disabled_seq'),
(select id from web_contact where login_uc = upper('&login')),
null,
(select id from rhnWebContactChangeState where label = 'enabled'),
commit e55983b18015a4b5c00a441711eb51eca41115af
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 16:12:26 2012 +0100
rewrite rhn_confcontent_id_seq.nextval to sequence_nextval('rhn_confcontent_id_seq')
diff --git a/web/modules/rhn/RHN/DB/ConfigRevision.pm b/web/modules/rhn/RHN/DB/ConfigRevision.pm
index 786b24e..d6f28fc 100644
--- a/web/modules/rhn/RHN/DB/ConfigRevision.pm
+++ b/web/modules/rhn/RHN/DB/ConfigRevision.pm
@@ -109,7 +109,7 @@ sub create_config_contents {
INSERT INTO rhnConfigContent
(id, checksum_id, file_size, contents, delim_start, delim_end)
VALUES
- (rhn_confcontent_id_seq.nextval, lookup_checksum('md5', :md5sum), :file_size, :contents, :delim_start, :delim_end)
+ (sequence_nextval('rhn_confcontent_id_seq'), lookup_checksum('md5', :md5sum), :file_size, :contents, :delim_start, :delim_end)
RETURNING id INTO :ccid
EOS
commit 09989c78f930a628d51bd15a473b10a8ebe59f6c
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 15:42:06 2012 +0100
use sequence_nextval rather then .nextval
diff --git a/web/modules/rhn/RHN/DB/ContactGroup.pm b/web/modules/rhn/RHN/DB/ContactGroup.pm
index f7d7f52..ed93042 100644
--- a/web/modules/rhn/RHN/DB/ContactGroup.pm
+++ b/web/modules/rhn/RHN/DB/ContactGroup.pm
@@ -176,7 +176,7 @@ sub commit {
my $dbh = RHN::DB->connect;
# Get the next recid from the sequence and set it as the id for this instance.
- my $sth = $dbh->prepare("SELECT " . $self->get_sequence . ".nextval FROM DUAL");
+ my $sth = $dbh->prepare("SELECT sequence_nextval('" . $self->get_sequence . "') FROM DUAL");
$sth->execute;
my ($pk_value) = $sth->fetchrow;
die "No new $type $pk from seq " . $self->get_sequence . " (possible error: " . $sth->errstr . ")" unless $pk_value;
commit 4abe94b01d7445b0f59f177513b4fa6b133f4889
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 16:04:21 2012 +0100
rewrite rhn_cdatakey_id_seq.nextval to sequence_nextval('rhn_cdatakey_id_seq')
diff --git a/web/modules/rhn/RHN/DB/CustomInfoKey.pm b/web/modules/rhn/RHN/DB/CustomInfoKey.pm
index a7f28c4..3a0e922 100644
--- a/web/modules/rhn/RHN/DB/CustomInfoKey.pm
+++ b/web/modules/rhn/RHN/DB/CustomInfoKey.pm
@@ -68,10 +68,10 @@ sub commit {
if ($self->id == -1) {
my $dbh = $transaction || RHN::DB->connect;
- my $sth = $dbh->prepare("SELECT rhn_cdatakey_id_seq.nextval FROM DUAL");
+ my $sth = $dbh->prepare("SELECT sequence_nextval('rhn_cdatakey_id_seq') FROM DUAL");
$sth->execute;
my ($id) = $sth->fetchrow;
- die "No new channel id from seq rhn_cdatakey_id_seq.nextval (possible error: " . $sth->errstr . ")" unless $id;
+ die "No new channel id from seq rhn_cdatakey_id_seq (possible error: " . $sth->errstr . ")" unless $id;
$sth->finish;
$self->{":modified:"}->{id} = 1;
commit bf50a431f937b92ad7389c9a81defca6fc0f287c
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 16:02:28 2012 +0100
rewrite rhn_filelist_id_seq.nextval to sequence_nextval('rhn_filelist_id_seq')
diff --git a/web/modules/rhn/RHN/DB/FileList.pm b/web/modules/rhn/RHN/DB/FileList.pm
index 51c9e6b..8255b7b 100644
--- a/web/modules/rhn/RHN/DB/FileList.pm
+++ b/web/modules/rhn/RHN/DB/FileList.pm
@@ -98,7 +98,7 @@ sub commit {
if ($self->id == -1) {
my $dbh = RHN::DB->connect;
- my $sth = $dbh->prepare("SELECT rhn_filelist_id_seq.nextval FROM DUAL");
+ my $sth = $dbh->prepare("SELECT sequence_nextval('rhn_filelist_id_seq') FROM DUAL");
$sth->execute;
my ($id) = $sth->fetchrow;
die "No new file list id from seq rhn_filelist_id_seq (possible error: " . $sth->errstr . ")" unless $id;
commit 7037fce33c7efdd0e4d4423f12578746111931d2
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 16:00:22 2012 +0100
rewrite rhn_kstree_id_seq.nextval to sequence_nextval('rhn_kstree_id_seq')
diff --git a/web/modules/rhn/RHN/DB/KSTree.pm b/web/modules/rhn/RHN/DB/KSTree.pm
index 75f1562..5ec27d9 100644
--- a/web/modules/rhn/RHN/DB/KSTree.pm
+++ b/web/modules/rhn/RHN/DB/KSTree.pm
@@ -109,7 +109,7 @@ sub create_tree {
INSERT INTO rhnKickstartableTree
(id, label, base_path, channel_id, boot_image, org_id, kstree_type, install_type)
VALUES
- (rhn_kstree_id_seq.nextval, :label, :path, :channel_id, :boot_image, :org_id,
+ (sequence_nextval('rhn_kstree_id_seq'), :label, :path, :channel_id, :boot_image, :org_id,
(SELECT id FROM rhnKSTreeType WHERE label = :tree_type),
(SELECT id FROM rhnKSInstallType WHERE label = :install_type_label)
)
commit 3cd054f4347b7777abf18040fdbecf1d56ae5e7c
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 15:47:07 2012 +0100
rewrite rhn_ksscript_id_seq.nextval to sequence_nextval('rhn_ksscript_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Kickstart.pm b/web/modules/rhn/RHN/DB/Kickstart.pm
index e3a41ed..cddfed3 100644
--- a/web/modules/rhn/RHN/DB/Kickstart.pm
+++ b/web/modules/rhn/RHN/DB/Kickstart.pm
@@ -380,7 +380,7 @@ INSERT
, script_type
, interpreter
, data)
- VALUES (rhn_ksscript_id_seq.nextval
+ VALUES (sequence_nextval('rhn_ksscript_id_seq')
, :ksid
, :position
, :stype
commit b5a7e6d4051b0243e78e7731ada30f5c70f25f3f
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 15:45:44 2012 +0100
rewrite rhn_ks_id_seq.nextval to sequence_nextval('rhn_ks_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Kickstart.pm b/web/modules/rhn/RHN/DB/Kickstart.pm
index 7645bc7..e3a41ed 100644
--- a/web/modules/rhn/RHN/DB/Kickstart.pm
+++ b/web/modules/rhn/RHN/DB/Kickstart.pm
@@ -107,7 +107,7 @@ sub commit {
my $mode = 'update';
if (not $self->id) {
- my $sth = $dbh->prepare("SELECT rhn_ks_id_seq.nextval FROM DUAL");
+ my $sth = $dbh->prepare("SELECT sequence_nextval('rhn_ks_id_seq') FROM DUAL");
$sth->execute;
my ($id) = $sth->fetchrow;
die "No new id from seq rhn_ks_id_seq (possible error: " . $sth->errstr . ")" unless $id;
commit 0f2d10ec30d5b8de45dad843b3fff45d12171a02
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 15:43:53 2012 +0100
rewrite rhn_ks_session_id_seq.nextval to sequence_nextval('rhn_ks_session_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Kickstart/Session.pm b/web/modules/rhn/RHN/DB/Kickstart/Session.pm
index 694da68..94261c5 100644
--- a/web/modules/rhn/RHN/DB/Kickstart/Session.pm
+++ b/web/modules/rhn/RHN/DB/Kickstart/Session.pm
@@ -188,7 +188,7 @@ sub commit {
my $mode = 'update';
if ($self->id == -1) {
- my $sth = $dbh->prepare("SELECT rhn_ks_session_id_seq.nextval FROM DUAL");
+ my $sth = $dbh->prepare("SELECT sequence_nextval('rhn_ks_session_id_seq') FROM DUAL");
$sth->execute;
my ($id) = $sth->fetchrow;
die "No new kickstart session id from seq rhn_ks_session_id_seq (possible error: " . $sth->errstr . ")" unless $id;
commit 8d7216eb70c042546d0699f52d5dc96bd51e8c80
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 15:42:06 2012 +0100
use sequence_nextval rather then .nextval
diff --git a/web/modules/rhn/RHN/DB/Notes.pm b/web/modules/rhn/RHN/DB/Notes.pm
index bbd4de3..131c593 100644
--- a/web/modules/rhn/RHN/DB/Notes.pm
+++ b/web/modules/rhn/RHN/DB/Notes.pm
@@ -115,7 +115,7 @@ sub commit {
if ($self->id == -1)
{
$mode = 'insert';
- $query = "SELECT ". $self->sequence . ".nextval FROM DUAL";
+ $query = "SELECT sequence_nextval('". $self->sequence . "') FROM DUAL";
$sth = $dbh->prepare($query);
$sth->execute;
commit c6cdf7c83c49a60d80d93513b110245b4ef38199
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 15:37:20 2012 +0100
code cleanup - sequence rhn_org_id_seq is not defined
since it is not defined, it could not be used. And since no one was in this section of broken code for years, no one will miss it
diff --git a/web/modules/rhn/RHN/DB/Org.pm b/web/modules/rhn/RHN/DB/Org.pm
index a675cd4..0839361 100644
--- a/web/modules/rhn/RHN/DB/Org.pm
+++ b/web/modules/rhn/RHN/DB/Org.pm
@@ -157,17 +157,7 @@ sub commit {
my $mode = 'update';
if ($self->id == -1) {
- my $dbh = RHN::DB->connect;
-
- my $sth = $dbh->prepare("SELECT rhn_org_id_seq.nextval FROM DUAL");
- $sth->execute;
- my ($id) = $sth->fetchrow;
- die "No new org id from seq rhn_org_id_seq (possible error: " . $sth->errstr . ")" unless $id;
- $sth->finish;
-
- $self->{":modified:"}->{id} = 1;
- $self->{__id__} = $id;
- $mode = 'insert';
+ die "dead code - how did you get here?";
}
die "$self->commit called on org without valid id" unless $self->id and $self->id > 0;
commit b3c74222f068ed0a97d65708940879b0357b1c71
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 15:19:53 2012 +0100
rewrite rhn_server_profile_id_seq.nextval to sequence_nextval('rhn_server_profile_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Profile.pm b/web/modules/rhn/RHN/DB/Profile.pm
index 485020c..6504117 100644
--- a/web/modules/rhn/RHN/DB/Profile.pm
+++ b/web/modules/rhn/RHN/DB/Profile.pm
@@ -129,7 +129,7 @@ sub commit {
my $dbh = $transaction || RHN::DB->connect;
if ($self->id == -1) {
- my $sth = $dbh->prepare("SELECT rhn_server_profile_id_seq.nextval FROM DUAL");
+ my $sth = $dbh->prepare("SELECT sequence_nextval('rhn_server_profile_id_seq') FROM DUAL");
$sth->execute;
my ($id) = $sth->fetchrow;
$sth->finish;
commit aa5c6a399aea91b7edeea138a05d5f6af10cda90
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 14:59:39 2012 +0100
code cleanup - callback rhn:sync_server_cb is not used
the body of this callback is used from web/modules/sniglets/Sniglets/ListView/PackageList.pm: Sniglets::Profiles::sync_server_cb($pxt, $label);
diff --git a/web/modules/sniglets/Sniglets/Profiles.pm b/web/modules/sniglets/Sniglets/Profiles.pm
index 54f08d7..6057cfb 100644
--- a/web/modules/sniglets/Sniglets/Profiles.pm
+++ b/web/modules/sniglets/Sniglets/Profiles.pm
@@ -27,8 +27,6 @@ use PXT::Utils;
sub register_callbacks {
my $class = shift;
my $pxt = shift;
-
- $pxt->register_callback('rhn:sync_server_cb' => \&sync_server_cb);
}
sub sync_server_cb {
commit 9d97154d7e5930c2a802f2d2b4fa8c817d9c51aa
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 14:47:11 2012 +0100
rewrite rhn_packagedelta_id_seq.nextval to sequence_nextval('rhn_packagedelta_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Scheduler.pm b/web/modules/rhn/RHN/DB/Scheduler.pm
index d237003..59e863a 100644
--- a/web/modules/rhn/RHN/DB/Scheduler.pm
+++ b/web/modules/rhn/RHN/DB/Scheduler.pm
@@ -1240,7 +1240,7 @@ sub schedule_package_sync {
my $sth;
$sth = $dbh->prepare(<<EOS);
-SELECT rhn_packagedelta_id_seq.nextval FROM DUAL
+SELECT sequence_nextval('rhn_packagedelta_id_seq') FROM DUAL
EOS
$sth->execute_h();
my ($delta_id) = $sth->fetchrow;
commit ef52911e00b875243626238b59c015d9a1e4e052
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 14:43:42 2012 +0100
rewrite rhn_actioncr_id_seq.nextval to sequence_nextval('rhn_actioncr_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Scheduler.pm b/web/modules/rhn/RHN/DB/Scheduler.pm
index 4e34bb4..d237003 100644
--- a/web/modules/rhn/RHN/DB/Scheduler.pm
+++ b/web/modules/rhn/RHN/DB/Scheduler.pm
@@ -1411,7 +1411,7 @@ sub schedule_config_action {
INSERT
INTO rhnActionConfigRevision
(id, action_id, server_id, config_revision_id)
-VALUES (rhn_actioncr_id_seq.nextval, :aid, :server_id, :revision_id)
+VALUES (sequence_nextval('rhn_actioncr_id_seq'), :aid, :server_id, :revision_id)
EOQ
$sth = $dbh->prepare($query);
commit b2bd80fb5f3714ddcafd6b050def84f812671649
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 14:41:09 2012 +0100
rewrite rhn_act_p_id_seq.nextval to sequence_nextval('rhn_act_p_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Scheduler.pm b/web/modules/rhn/RHN/DB/Scheduler.pm
index e47187a..4e34bb4 100644
--- a/web/modules/rhn/RHN/DB/Scheduler.pm
+++ b/web/modules/rhn/RHN/DB/Scheduler.pm
@@ -379,7 +379,7 @@ EOQ
$query = <<EOQ;
INSERT INTO rhnActionPackage (id, action_id, name_id, evr_id)
-SELECT rhn_act_p_id_seq.nextval,
+SELECT sequence_nextval('rhn_act_p_id_seq'),
:action_id,
P.name_id,
P.evr_id
@@ -477,7 +477,7 @@ EOQ
$query = <<EOQ;
INSERT INTO rhnActionPackage (id, action_id, name_id, evr_id)
(
-SELECT rhn_act_p_id_seq.nextval, ?, SP.name_id, SP.evr_id
+SELECT sequence_nextval('rhn_act_p_id_seq'), ?, SP.name_id, SP.evr_id
FROM rhnServerPackage SP, rhnSet PACKAGE_LIST
WHERE PACKAGE_LIST.user_id = ?
AND PACKAGE_LIST.label = '$label'
@@ -575,7 +575,7 @@ EOQ
$sth = $dbh->prepare(<<EOQ);
INSERT
INTO rhnActionPackage (id, action_id, name_id, evr_id)
-VALUES (rhn_act_p_id_seq.nextval, :aid, :name_id, :evr_id)
+VALUES (sequence_nextval('rhn_act_p_id_seq'), :aid, :name_id, :evr_id)
EOQ
foreach my $package (@packages) {
@@ -699,7 +699,7 @@ EOQ
if ($package_set) {
$query = <<EOQ;
INSERT INTO rhnActionPackage (id, action_id, name_id, evr_id)
-(SELECT rhn_act_p_id_seq.nextval, ?, element, element_two FROM rhnSet WHERE user_id = ? AND label = ?)
+(SELECT sequence_nextval('rhn_act_p_id_seq'), ?, element, element_two FROM rhnSet WHERE user_id = ? AND label = ?)
EOQ
$sth = $dbh->prepare($query);
# warn "ins query: $query\n$id, $user_id, ".$packages->label;
@@ -717,7 +717,7 @@ EOQ
elsif ($package_ids) {
$query =<<EOQ;
INSERT INTO rhnActionPackage (id, action_id, name_id, evr_id)
-(SELECT rhn_act_p_id_seq.nextval, ?, P.name_id, P.evr_id FROM rhnPackage P WHERE P.id = ?)
+(SELECT sequence_nextval('rhn_act_p_id_seq'), ?, P.name_id, P.evr_id FROM rhnPackage P WHERE P.id = ?)
EOQ
$sth = $dbh->prepare($query);
@@ -842,7 +842,7 @@ EOQ
($label eq 'patchset_installable_list')) {
$query = <<EOQ;
INSERT INTO rhnActionPackage (id, action_id, name_id, evr_id, package_arch_id)
-SELECT rhn_act_p_id_seq.nextval,
+SELECT sequence_nextval('rhn_act_p_id_seq'),
:action_id,
P.name_id,
P.evr_id,
@@ -868,7 +868,7 @@ EOQ
} else {
$query = <<EOQ;
INSERT INTO rhnActionPackage (id, action_id, name_id, evr_id, package_arch_id)
-SELECT rhn_act_p_id_seq.nextval,
+SELECT sequence_nextval('rhn_act_p_id_seq'),
:action_id,
P.name_id,
P.evr_id,
@@ -952,7 +952,7 @@ EOQ
if ($package_set) {
$sth = $dbh->prepare(<<EOQ);
INSERT INTO rhnActionPackage (id, action_id, name_id, evr_id)
-(SELECT rhn_act_p_id_seq.nextval, ?, element, element_two FROM rhnSet WHERE user_id = ? AND label = ?)
+(SELECT sequence_nextval('rhn_act_p_id_seq'), ?, element, element_two FROM rhnSet WHERE user_id = ? AND label = ?)
EOQ
$sth->execute($id, $user_id, $package_set->label);
}
@@ -965,7 +965,7 @@ EOQ
INSERT
INTO rhnActionPackage
(id, action_id, name_id, evr_id)
-VALUES (rhn_act_p_id_seq.nextval, ?, ?, ?)
+VALUES (sequence_nextval('rhn_act_p_id_seq'), ?, ?, ?)
EOQ
foreach my $pid_combo (@{$package_id_combos}) {
commit 84f84070cc392267526723f481b0474e38038ed9
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 14:34:12 2012 +0100
rewrite rhn_server_loc_id_seq.nextval to sequence_nextval('rhn_server_loc_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Server.pm b/web/modules/rhn/RHN/DB/Server.pm
index a9ba073..0b60b0a 100644
--- a/web/modules/rhn/RHN/DB/Server.pm
+++ b/web/modules/rhn/RHN/DB/Server.pm
@@ -1224,7 +1224,7 @@ sub commit {
$self->{":modified:"}->{id} = 1;
$self->{__id__} = $id;
- $sth = $dbh->prepare("SELECT rhn_server_loc_id_seq.nextval FROM DUAL");
+ $sth = $dbh->prepare("SELECT sequence_nextval('rhn_server_loc_id_seq') FROM DUAL");
$sth->execute;
my ($location_id) = $sth->fetchrow;
die "No new location id from seq rhn_server_loc_id_seq (possible error: " . $sth->errstr . ")" unless $id;
@@ -1268,7 +1268,7 @@ sub commit {
$sth->finish;
if (not $exists) {
- my $sth = $dbh->prepare('INSERT INTO rhnServerLocation (id, server_id) VALUES (rhn_server_loc_id_seq.nextval, ?)');
+ my $sth = $dbh->prepare('INSERT INTO rhnServerLocation (id, server_id) VALUES (sequence_nextval('rhn_server_loc_id_seq'), ?)');
$sth->execute($self->id);
}
}
commit 3da5eba4929ef23d9e4ae97572c759a7530e2b7c
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 14:31:47 2012 +0100
rewrite rhn_server_id_seq.nextval to sequence_nextval('rhn_server_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Server.pm b/web/modules/rhn/RHN/DB/Server.pm
index 70ac71f..a9ba073 100644
--- a/web/modules/rhn/RHN/DB/Server.pm
+++ b/web/modules/rhn/RHN/DB/Server.pm
@@ -1215,7 +1215,7 @@ sub commit {
if ($self->{__newly_created__}) {
croak "$self->commit called on newly created object when id != -1\nid == $self->{__id__}" unless $self->{__id__} == -1;
- $sth = $dbh->prepare("SELECT rhn_server_id_seq.nextval FROM DUAL");
+ $sth = $dbh->prepare("SELECT sequence_nextval('rhn_server_id_seq') FROM DUAL");
$sth->execute;
my ($id) = $sth->fetchrow;
die "No new server id from seq rhn_server_id_seq (possible error: " . $sth->errstr . ")" unless $id;
commit da168275169bde1dda34cd185b70eaf7cbfdc878
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 14:27:52 2012 +0100
rewrite rhn_template_str_id_seq.nextval to sequence_nextval('rhn_template_str_id_seq')
diff --git a/web/modules/rhn/RHN/DB/TemplateString.pm b/web/modules/rhn/RHN/DB/TemplateString.pm
index 5e20803..eb6845e 100644
--- a/web/modules/rhn/RHN/DB/TemplateString.pm
+++ b/web/modules/rhn/RHN/DB/TemplateString.pm
@@ -157,7 +157,7 @@ sub commit {
my $mode = 'update';
if ($self->id == -1) {
- my $sth = $dbh->prepare("SELECT rhn_template_str_id_seq.nextval FROM DUAL");
+ my $sth = $dbh->prepare("SELECT sequence_nextval('rhn_template_str_id_seq') FROM DUAL");
$sth->execute;
my ($id) = $sth->fetchrow;
die "No id from rhn_template_str_id_seq (possible error: " . $sth->errstr . ")" unless $id;
commit 815dd7c3be175eb28d3ceb00bbd5e1ff5137b899
Author: Miroslav Suchý <msuchy(a)redhat.com>
Date: Tue Jan 31 14:24:07 2012 +0100
rewrite rhn_repo_regen_queue_id_seq.nextval to sequence_nextval('rhn_repo_regen_queue_id_seq')
diff --git a/web/modules/rhn/RHN/DB/Channel.pm b/web/modules/rhn/RHN/DB/Channel.pm
index e424d58..b3b798c 100644
--- a/web/modules/rhn/RHN/DB/Channel.pm
+++ b/web/modules/rhn/RHN/DB/Channel.pm
@@ -920,7 +920,7 @@ EOQ
INSERT
INTO rhnRepoRegenQueue
(id, channel_label, client, reason, force, bypass_filters, next_action, created, modified)
-VALUES (rhn_repo_regen_queue_id_seq.nextval,
+VALUES (sequence_nextval('rhn_repo_regen_queue_id_seq'),
:label, 'perl-web::remove_packages_in_set', NULL, 'N', 'N', sysdate, sysdate, sysdate)
EOQ
@@ -956,7 +956,7 @@ EOQ
INSERT
INTO rhnRepoRegenQueue
(id, channel_label, client, reason, force, bypass_filters, next_action, created, modified)
-VALUES (rhn_repo_regen_queue_id_seq.nextval,
+VALUES (sequence_nextval('rhn_repo_regen_queue_id_seq'),
:label, 'perl-web::add_packages_in_set', NULL, 'N', 'N', sysdate, sysdate, sysdate)
EOQ
diff --git a/web/modules/rhn/RHN/DB/ChannelEditor.pm b/web/modules/rhn/RHN/DB/ChannelEditor.pm
index 1d2d7e9..011324c 100644
--- a/web/modules/rhn/RHN/DB/ChannelEditor.pm
+++ b/web/modules/rhn/RHN/DB/ChannelEditor.pm
@@ -252,7 +252,7 @@ EOQ
INSERT
INTO rhnRepoRegenQueue
(id, channel_label, client, reason, force, bypass_filters, next_action, created, modified)
-VALUES (rhn_repo_regen_queue_id_seq.nextval,
+VALUES (sequence_nextval('rhn_repo_regen_queue_id_seq'),
:label, 'perl-web::remove_channel_packages', NULL, 'N', 'N', sysdate, sysdate, sysdate)
EOQ
@@ -579,7 +579,7 @@ EOQ
INSERT
INTO rhnRepoRegenQueue
(id, channel_label, client, reason, force, bypass_filters, next_action, created, modified)
-VALUES (rhn_repo_regen_queue_id_seq.nextval,
+VALUES (sequence_nextval('rhn_repo_regen_queue_id_seq'),
:label, 'perl-web::remove_errata_from_channel', NULL, 'N', 'N', sysdate, sysdate, sysdate)
EOQ
@@ -648,7 +648,7 @@ EOQ
INSERT
INTO rhnRepoRegenQueue
(id, channel_label, client, reason, force, bypass_filters, next_action, created, modified)
-VALUES (rhn_repo_regen_queue_id_seq.nextval,
+VALUES (sequence_nextval('rhn_repo_regen_queue_id_seq'),
:label, 'perl-web::add_errata_to_channel', NULL, 'N', 'N', sysdate, sysdate, sysdate)
EOQ
diff --git a/web/modules/sniglets/Sniglets/ListView/PackageList.pm b/web/modules/sniglets/Sniglets/ListView/PackageList.pm
index f5b1d25..5b5fece 100644
--- a/web/modules/sniglets/Sniglets/ListView/PackageList.pm
+++ b/web/modules/sniglets/Sniglets/ListView/PackageList.pm
@@ -1162,7 +1162,7 @@ sub delete_packages_cb {
INSERT
INTO rhnRepoRegenQueue
(id, channel_label, client, reason, force, bypass_filters, next_action, created, modified)
-VALUES (rhn_repo_regen_queue_id_seq.nextval,
+VALUES (sequence_nextval('rhn_repo_regen_queue_id_seq'),
:label, 'perl-web::delete_packages_cb', NULL, 'N', 'N', sysdate, sysdate, sysdate)
EOQ
11 years, 4 months
monitoring/PerlModules
by Michael Mraka
monitoring/PerlModules/NP/NOT-USED/DocGen/CustomPod.pm | 224
monitoring/PerlModules/NP/NOT-USED/DocGen/pod.css | 78
monitoring/PerlModules/NP/NOT-USED/Getresuid/BUILD | 45
monitoring/PerlModules/NP/NOT-USED/Getresuid/Changes | 6
monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.pm | 82
monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.xs | 48
monitoring/PerlModules/NP/NOT-USED/Getresuid/MANIFEST | 7
monitoring/PerlModules/NP/NOT-USED/Getresuid/Makefile.PL | 10
monitoring/PerlModules/NP/NOT-USED/Getresuid/README | 27
monitoring/PerlModules/NP/NOT-USED/Getresuid/test.pl | 33
monitoring/PerlModules/NP/NOT-USED/Handlers/BUILD | 59
monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheLog.pm | 96
monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheRequest.pm | 47
monitoring/PerlModules/NP/NOT-USED/Handlers/handle.pl | 29
monitoring/PerlModules/NP/NOT-USED/Handlers/handler.pm | 53
monitoring/PerlModules/NP/NOT-USED/KudzuDevice/BUILD | 39
monitoring/PerlModules/NP/NOT-USED/KudzuDevice/KudzuDevice.pm | 55
monitoring/PerlModules/NP/NOT-USED/KudzuDevice/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/KudzuDevice/devdump | 5
monitoring/PerlModules/NP/NOT-USED/NP_CVS/BUILD | 47
monitoring/PerlModules/NP/NOT-USED/NP_CVS/CVS.pm | 68
monitoring/PerlModules/NP/NOT-USED/NP_CVS/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/NP_CVS/TestCVS.pl | 12
monitoring/PerlModules/NP/NOT-USED/NP_RPM/BUILD | 45
monitoring/PerlModules/NP/NOT-USED/NP_RPM/MANIFEST | 6
monitoring/PerlModules/NP/NOT-USED/NP_RPM/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/NP_RPM/README | 35
monitoring/PerlModules/NP/NOT-USED/NP_RPM/RPM.pm | 111
monitoring/PerlModules/NP/NOT-USED/NP_RPM/test.pl | 17
monitoring/PerlModules/NP/NOT-USED/NP_RPM/test/TestRPM.pl | 12
monitoring/PerlModules/NP/NOT-USED/PackingList/BUILD | 41
monitoring/PerlModules/NP/NOT-USED/PackingList/MANIFEST | 93
monitoring/PerlModules/NP/NOT-USED/PackingList/PackingList.pm | 163
monitoring/PerlModules/NP/NOT-USED/PackingList/testPackingList.pl | 19
monitoring/PerlModules/NP/NOT-USED/PlugFrame/BUILD | 44
monitoring/PerlModules/NP/NOT-USED/PlugFrame/MANIFEST | 11
monitoring/PerlModules/NP/NOT-USED/PlugFrame/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/PlugFrame/Metric.pm | 38
monitoring/PerlModules/NP/NOT-USED/PlugFrame/Plugin.pm | 569 --
monitoring/PerlModules/NP/NOT-USED/PlugFrame/PortableShellProbe.pm | 178
monitoring/PerlModules/NP/NOT-USED/PlugFrame/Probe.pm | 772 ---
monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeGenerator.pm | 44
monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeState.pm | 92
monitoring/PerlModules/NP/NOT-USED/PlugFrame/README | 24
monitoring/PerlModules/NP/NOT-USED/PlugFrame/ShellProbe.pm | 238
monitoring/PerlModules/NP/NOT-USED/PlugFrame/test.pl | 23
monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/TestSwitches.pm | 111
monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/run.pl | 27
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/BUILD | 50
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/ReleaseDB.pm | 1513 -----
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/TO_DO | 20
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/UTILITIES | 151
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/test/TestRelease.pm | 1000 ---
monitoring/PerlModules/NP/NOT-USED/ReleaseDB/tst | 20
monitoring/PerlModules/NP/NOT-USED/Spread/BUILD | 51
monitoring/PerlModules/NP/NOT-USED/Spread/Filters.pm | 112
monitoring/PerlModules/NP/NOT-USED/Spread/SpreadNetwork.pm | 944 ---
monitoring/PerlModules/NP/NOT-USED/Spread/SpreadServers.pm | 296 -
monitoring/PerlModules/NP/NOT-USED/Spread/blitzcom.pl | 25
monitoring/PerlModules/NP/NOT-USED/Spread/cmdserv.pl | 46
monitoring/PerlModules/NP/NOT-USED/Spread/com.pl | 25
monitoring/PerlModules/NP/NOT-USED/Spread/memcli.pl | 30
monitoring/PerlModules/NP/NOT-USED/Spread/memserv.pl | 63
monitoring/PerlModules/NP/NOT-USED/Spread/ootest.pl | 23
monitoring/PerlModules/NP/NOT-USED/Spread/scheduler.pl | 27
monitoring/PerlModules/NP/NOT-USED/Spread/spkernel.pl | 30
monitoring/PerlModules/NP/NOT-USED/Spread/sputnik | 62
monitoring/PerlModules/NP/NOT-USED/TelAlert/BUILD | 52
monitoring/PerlModules/NP/NOT-USED/TelAlert/SQLtest.pl | 208
monitoring/PerlModules/NP/NOT-USED/TelAlert/TelAlert.pm | 2562 ----------
monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD | 52
monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD.spec | 59
monitoring/PerlModules/NP/NOT-USED/Time-System/Changes | 6
monitoring/PerlModules/NP/NOT-USED/Time-System/MANIFEST | 7
monitoring/PerlModules/NP/NOT-USED/Time-System/Makefile.PL | 17
monitoring/PerlModules/NP/NOT-USED/Time-System/README | 35
monitoring/PerlModules/NP/NOT-USED/Time-System/System.pm | 112
monitoring/PerlModules/NP/NOT-USED/Time-System/System.xs | 35
monitoring/PerlModules/NP/NOT-USED/Time-System/test.pl | 29
monitoring/PerlModules/NP/NOT-USED/Time-System/version | 1
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/BUILD | 48
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/MANIFEST | 5
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/Makefile.PL | 11
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/README | 17
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/TroubleTicket.pm | 703 --
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test.pl | 17
monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test/test-TroubleTicket.pl | 14
87 files changed, 12305 deletions(-)
New commits:
commit 9f5abeee37fb6dead1c2d26e0aadf659a5c37bae
Author: Michael Mraka <michael.mraka(a)redhat.com>
Date: Tue Jan 31 15:30:30 2012 +0100
Purging old NOT-USED stuff.
diff --git a/monitoring/PerlModules/NP/NOT-USED/DocGen/CustomPod.pm b/monitoring/PerlModules/NP/NOT-USED/DocGen/CustomPod.pm
deleted file mode 100644
index a46490c..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/DocGen/CustomPod.pm
+++ /dev/null
@@ -1,224 +0,0 @@
-package PerlModules::NP::DocGen::CustomPod;
-
-use strict;
-
-use Marek::Pod::HTML qw(pod2html);
-use vars qw(@ISA @EXPORT @EXPORT_OK);
-use Data::Dumper;
-
-require Exporter;
-@ISA = qw(Marek::Pod::HTML);
-@EXPORT_OK = qw(&pod2html);
-
-my $NBSP = HTML::Entities::decode_entities(' ');
-
-sub customize {
- my ($self, $name) = @_;
-
-# $self->SUPER::customize($name);
-
- # Add the stylesheet.
- $self->{_head}->push_content(HTML::Element->new('link',
- rel => "stylesheet",
- href => "/perldoc/pod.css",
- type => "text/css"));
- # Set up the method summary right after the METHODS header.
- $self->add_method_summary($self->find_header('METHODS'));
-
- # Add a link to the source code in the SEE ALSO section.
- $self->add_source_link($name, $self->find_header('SEE_ALSO'));
-
- $self->customize_main_elements($name);
-}
-
-# Copied from Marek::Pod::HTML::customize
-sub customize_main_elements {
- my ($self, $name) = @_;
-
- # set document class
- my $root = HTML::Element->new('~declaration', text =>
- 'DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"');
- $root->push_content("\n", $self->{_html});
- $self->{_html} = $root;
-
- # customize the title
- my $title = HTML::Element->new('title');
- $title->push_content($self->{-title} || $name || 'POD');
- $self->{_head}->push_content($title, "\n");
-
- # prepend big heading
- if($name) {
- my $titleh = HTML::Element->new('h1', CLASS => 'POD_TITLE');
- $titleh->push_content($name);
- $self->{_body}->unshift_content("\n",$titleh,"\n",
- HTML::Element->new('hr'));
- }
-
- if($self->{-navigation}) {
- # add navigation
- my $table = HTML::Element->new('table', width => '100%');
- $self->{_body}->unshift_content("\n",$table);
-
- my $tr = HTML::Element->new('tr');
- $table->push_content("\n", $tr, "\n");
- if ($self->{-toc} || $self->{-idx}) {
- my $td = HTML::Element->new('td', class => 'POD_NAVBAR');
- $tr->push_content($td, "\n");
-
- if($self->{-toc}) {
- my $anchor = $self->navbar_href($self->{-tocname}, $self->{-toctitle});
- $self->{_toc_link_element} = $anchor->clone();
- $td->push_content("\n", $anchor, $NBSP, $NBSP);
- }
-
- if($self->{-idx}) {
- my $anchor = $self->navbar_href($self->{-idxname}, $self->{-idxtitle});
- $self->{_idx_link_element} = $anchor->clone();
- $td->push_content($anchor, $NBSP, $NBSP);
- }
-
- # Custom crosslinks between CPAN and NOCpulse
- if($self->{-toctitle} =~ /CPAN/) {
- my $anchor = $self->navbar_href('/perldoc/nocpulse/np-toc', 'NOCpulse');
- $td->push_content($anchor, "\n");
-
- } elsif($self->{-toctitle} =~ /NOCpulse/) {
- my $anchor = $self->navbar_href('/perldoc/cpan/PerlModules/CPAN/cpan-toc', 'CPAN');
- $td->push_content($anchor, "\n");
- }
- }
-
- } # end navigation
-
- # for finding the way back to the top
- my $anchor = HTML::Element->new('a', CLASS => 'POD_NAVLINK',
- name => 'Pod_TOP_OF_PAGE');
- $self->{_body}->unshift_content("\n", $anchor);
-
- # customize the footer
- $anchor = HTML::Element->new('a', CLASS => 'POD_NAVLINK',
- href => '#Pod_TOP_OF_PAGE');
- $anchor->push_content('Top');
- $self->{_body}->push_content(['hr'],
- "\n",
- $anchor,
- $NBSP, $NBSP,
- $self->{_toc_link_element},
- $NBSP, $NBSP,
- $self->{_idx_link_element},
- $NBSP, $NBSP,
- ['span', { class => 'POD_VERSION_FOOTER' },
- " \nGenerated by Pod::HTML ",
- $Marek::Pod::HTML::VERSION,
- " on " . localtime() . "\n",
- ]);
-}
-
-sub navbar_href {
- my ($self, $filename, $title) = @_;
-
- my $href_file = _construct_file_name($filename, $self->depth(), $self->{-suffix});
- my $anchor = HTML::Element->new('a', CLASS => 'POD_NAVLINK', href => $href_file);
- $title =~ s/\s+/$NBSP/g;
- $anchor->push_content(['span', { class => 'POD_TEXT' }, $title]);
-
- return $anchor;
-}
-
-sub _construct_file_name {
- return Marek::Pod::HTML::_construct_file_name(@_);
-}
-
-sub find_header {
- my ($self, $name) = @_;
- my $index = -1;
- foreach my $el ($self->{_body}->content_list()) {
- ++$index;
- next unless ref($el) && $el->tag eq 'h2';
- my $content = ($el->content_list())[0];
- if (ref($content) && $content->tag eq 'a' && $content->attr('name') eq $name) {
- return ($el, $index);
- }
- }
- return undef;
-}
-
-sub add_source_link {
- my ($self, $name, $see_also_header, $element_index) = @_;
-
- # Bail unless there's an underlying .pm around
- return unless -e _construct_file_name($name, 0, '.pm');
-
- my $anchor = HTML::Element->new('a', CLASS => 'POD_NAVLINK',
- href => _construct_file_name($name,
- $self->depth(),
- '.pm'));
- $anchor->push_content('Source code');
-
- unless ($see_also_header) {
- my $see_also_header = HTML::Element->new('h2', class => 'POD_HEAD1',
- name => 'SEE_ALSO');
- $see_also_header->push_content(['a', { name => "SEE_ALSO" }, "SEE ALSO", ]);
- $self->{_body}->push_content($see_also_header,
- ['p', { class => 'POD_TEXT' },
- "\n", $anchor, "\n" ]);
- } else {
- my @elements = $self->{_body}->content_list();
- foreach my $item (@elements[$element_index .. scalar(@elements)]) {
- next unless ref($item) && $item->tag eq 'p';
- $item->unshift_content("\n", $anchor, HTML::Element->new('br'), "\n");
- last;
- }
- }
-}
-
-sub add_method_summary {
- my ($self, $method_header, $element_index) = @_;
-
- return unless $method_header;
-
- my $method_summary = HTML::Element->new('table');
- $method_header->postinsert("\n", $method_summary, "\n");
-
- $method_summary->push_content(['tr',
- ['td', { class => 'POD_METHOD_SUMMARY_HEADER' },
- 'Summary'
- ],
- ]);
-
- my @elements = $self->{_body}->content_list();
-
- foreach my $item (@elements[$element_index .. scalar(@elements)]) {
-
- next unless ref($item) && $item->tag eq 'dl';
-
- # Gather up the dt elements.
- my %methods = ();
- foreach my $dl_entry ($item->content_list) {
- next unless ref($dl_entry) && $dl_entry->tag eq 'dt';
- my $method_element = ($dl_entry->content_list())[0];
- $methods{$method_element->attr('name')} = $method_element;
- }
-
- # Generate the table of method call summaries sorted by name.
- foreach my $method_target (sort keys %methods) {
- my $method_element = $methods{$method_target};
- my $method_call = $method_element->as_text();
-
- my $tag = HTML::Element->new('a', href => '#' . $method_target);
- $method_summary->push_content
- (['tr', "\n",
- ['td', { class => 'POD_METHOD_SUMMARY' },
- $method_call,
- ], "\n",
- ['td', { class => 'POD_METHOD_SUMMARY' },
- ['a', { href => '#' . $method_target }, "view" ],
- ], "\n",
- ], "\n",
- );
- }
- last;
- }
-}
-
-1;
diff --git a/monitoring/PerlModules/NP/NOT-USED/DocGen/pod.css b/monitoring/PerlModules/NP/NOT-USED/DocGen/pod.css
deleted file mode 100644
index 1d4bc5c..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/DocGen/pod.css
+++ /dev/null
@@ -1,78 +0,0 @@
-body {
- background: white;
- font-family: arial, helvetica, sans-serif;
-}
-tt {
- font-family: courier, monospace;
-}
-code {
- font-family: lucidatypewriter, courier, monospace;
- font-size: 85%;
-}
-pre {
- font-family: lucidatypewriter, courier, monospace;
- font-size: 85%;
-}
-p {
- font-family: arial, helvetica, sans-serif;
-}
-dd {
- font-family: arial, helvetica, sans-serif;
-}
-blockquote {
- font-family: arial, helvetica, sans-serif;
- font-weight: normal;
-}
-b {
- font-weight: bold;
-}
-h1 {
- font-family: arial, helvetica, sans-serif;
- font-weight: bold;
- font-size: 130%;
- color: #336699;
-}
-h2 {
- font-family: arial, helvetica, sans-serif;
- font-weight: bold;
- font-size: 115%;
- color: #336699;
-}
-h3 {
- font-family: arial, helvetica, sans-serif;
- font-weight: bold;
- font-size: 110%;
- color: #336699;
-}
-
-dt {
- color: #006699;
-}
-.POD_TEXT {
- font-family: arial, helvetica, sans-serif;
-}
-
-.POD_NAVBAR {
- font-family: arial, helvetica, sans-serif;
-}
-
-.POD_NAVLINK {
- font-family: arial, helvetica, sans-serif;
-}
-
-.POD_METHOD_SUMMARY_HEADER {
- font-family: arial, helvetica, sans-serif;
- font-weight: bold;
- color: #336699;
-}
-
-.POD_METHOD_SUMMARY {
- font-size: smaller;
- font-family: arial, helvetica, sans-serif;
-}
-
-.POD_VERSION_FOOTER {
- font-family: arial, helvetica, sans-serif;
- font-size: 75%;
- color: #555555
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/Getresuid/BUILD b/monitoring/PerlModules/NP/NOT-USED/Getresuid/BUILD
deleted file mode 100644
index 5181cfc..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Getresuid/BUILD
+++ /dev/null
@@ -1,45 +0,0 @@
-# Macros
-%define cvs_package PerlModules/NP/Getresuid
-
-# Package specific stuff
-Name: Getresuid
-Version: 1.0.0
-Release: 1
-Packager: Dave Faraldo <dfaraldo(a)redhat.com>
-Summary: Get real, effective, and saved UID/GID
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-Group: unsorted
-Copyright: (c) 2002-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Prefix: %{_our_prefix}
-Buildroot: %{_tmppath}/%cvs_package
-
-
-%description
-
-%{name} is a Perl extension module to provide the getresuid() and
-getresgid() system calls.
-
-%prep
-%entirely_abstract_build_step
-
-
-%build
-%makefile_build
-
-
-%install
-rm -rf $RPM_BUILD_ROOT
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-%makefile_install
-%point_scripts_to_correct_perl
-%make_file_list
-
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-
-%clean
-%abstract_clean_script
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Getresuid/Changes b/monitoring/PerlModules/NP/NOT-USED/Getresuid/Changes
deleted file mode 100644
index d65ca1a..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Getresuid/Changes
+++ /dev/null
@@ -1,6 +0,0 @@
-Revision history for Perl extension Getresuid.
-
-0.01 Sat Aug 30 01:20:17 2003
- - original version; created by h2xs 1.21 with options
- -A -n Getresuid
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.pm b/monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.pm
deleted file mode 100644
index fee5763..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.pm
+++ /dev/null
@@ -1,82 +0,0 @@
-package Getresuid;
-
-use 5.00503;
-use strict;
-
-require Exporter;
-require DynaLoader;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-@ISA = qw(Exporter DynaLoader);
-
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-
-# This allows declaration use Getresuid ':all';
-# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
-# will save memory.
-%EXPORT_TAGS = ( 'all' => [ qw(
-
-) ] );
-
-@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
-
-@EXPORT = qw(
- getresuid
- getresgid
- setresuid
- setresgid
-);
-$VERSION = '0.01';
-
-bootstrap Getresuid $VERSION;
-
-# Preloaded methods go here.
-
-1;
-__END__
-
-=head1 NAME
-
-Getresuid - Perl extension for getresuid/getresgid Linux system calls
-
-=head1 SYNOPSIS
-
- use Getresuid;
-
- my($ruid, $euid, $suid) = getresuid();
- my $rv = setresuid($ruid, $euid, $suid);
-
- my($rgid, $egid, $sgid) = getresgid();
- my $rv = setresgid($rgid, $egid, $sgid);
-
-
-=head1 DESCRIPTION
-
-The Getresuid module imports the 'getresuid' and 'getresgid' Linux
-system calls.
-
-=head1 EXPORTS
-
-getresuid() - get real, effective, and saved UID
-
-setresuid() - set real, effective, and saved UID
-
-getresgid() - get real, effective, and saved GID
-
-setresgid() - set real, effective, and saved GID
-
-
-=head1 AUTHOR
-
-Dave Faraldo<lt>dfaraldo(a)redhat.com<gt>
-
-=head1 DATE
-
-Last modified: $Date: 2003-09-03 02:42:59 $
-
-=head1 SEE ALSO
-
-The 'getresuid' and 'getresgid' man pages.
-
-=cut
diff --git a/monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.xs b/monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.xs
deleted file mode 100644
index 0529d7f..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Getresuid/Getresuid.xs
+++ /dev/null
@@ -1,48 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-
-MODULE = Getresuid PACKAGE = Getresuid
-
-void
-getresuid()
- PREINIT:
- uid_t ruid;
- uid_t euid;
- uid_t suid;
- PPCODE:
- getresuid(&ruid, &euid, &suid);
- EXTEND(SP, 3);
- PUSHs(sv_2mortal(newSViv(ruid)));
- PUSHs(sv_2mortal(newSViv(euid)));
- PUSHs(sv_2mortal(newSViv(suid)));
-
-
-void
-getresgid()
- PREINIT:
- gid_t rgid;
- gid_t egid;
- gid_t sgid;
- PPCODE:
- getresgid(&rgid, &egid, &sgid);
- EXTEND(SP, 3);
- PUSHs(sv_2mortal(newSViv(rgid)));
- PUSHs(sv_2mortal(newSViv(egid)));
- PUSHs(sv_2mortal(newSViv(sgid)));
-
-
-
-int
-setresuid(ruid, euid, suid)
- int ruid
- int euid
- int suid
-
-
-int
-setresgid(rgid, egid, sgid)
- int rgid
- int egid
- int sgid
diff --git a/monitoring/PerlModules/NP/NOT-USED/Getresuid/MANIFEST b/monitoring/PerlModules/NP/NOT-USED/Getresuid/MANIFEST
deleted file mode 100644
index cd957e2..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Getresuid/MANIFEST
+++ /dev/null
@@ -1,7 +0,0 @@
-Changes
-Getresuid.pm
-Getresuid.xs
-Makefile.PL
-MANIFEST
-README
-test.pl
diff --git a/monitoring/PerlModules/NP/NOT-USED/Getresuid/Makefile.PL b/monitoring/PerlModules/NP/NOT-USED/Getresuid/Makefile.PL
deleted file mode 100644
index c0742cc..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Getresuid/Makefile.PL
+++ /dev/null
@@ -1,10 +0,0 @@
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- 'NAME' => 'Getresuid',
- 'VERSION_FROM' => 'Getresuid.pm', # finds $VERSION
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'Getresuid.pm', # retrieve abstract from module
- AUTHOR => 'Dave Faraldo<lt>dfaraldo(a)redhat.com<gt>') : ()),
-);
diff --git a/monitoring/PerlModules/NP/NOT-USED/Getresuid/README b/monitoring/PerlModules/NP/NOT-USED/Getresuid/README
deleted file mode 100644
index d5011e7..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Getresuid/README
+++ /dev/null
@@ -1,27 +0,0 @@
-Getresuid version 0.01
-======================
-
-The Getresuid module imports the 'getresuid' and 'getresgid' Linux
-system calls for getting and setting the real, effective, and saved
-user and group IDs. See the 'getresuid' and 'getresgid' man pages
-for details.
-
-INSTALLATION
-
-To install this module type the following:
-
- perl Makefile.PL
- make
- make test
- make install
-
-COPYRIGHT AND LICENCE
-
-Copyright (C) 2003 Dave Faraldo <dfaraldo(a)redhat.com>
-
-This package is free software and is provided "as is" without
-express or implied warranty. It may be used, redistributed and/or
-modified under the terms of the Perl Artistic License (see
-http://www.perl.com/perl/misc/Artistic.html)
-
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Getresuid/test.pl b/monitoring/PerlModules/NP/NOT-USED/Getresuid/test.pl
deleted file mode 100644
index 1f3f13f..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Getresuid/test.pl
+++ /dev/null
@@ -1,33 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use Test;
-BEGIN { plan tests => 1 };
-use Getresuid;
-ok(1); # If we made it this far, we're ok.
-
-#########################
-
-# Make sure getresuid() and getresgid() think our real and effective
-# user/group IDs are what Perl thinks they are.
-
-my($ruid, $euid, $suid) = getresuid();
-my($rgid, $egid, $sgid) = getresgid();
-
-
-# Test 2: Verify real UID
-ok($ruid, $<);
-
-# Test 3: Verify effective UID
-ok($euid, $>);
-
-# Test 4: Verify real GID
-ok($rgid, (split(/\s+/, $())[0]);
-
-# Test 5: Verify effective UID
-ok($egid, (split(/\s+/, $())[0]);
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Handlers/BUILD b/monitoring/PerlModules/NP/NOT-USED/Handlers/BUILD
deleted file mode 100644
index 61a6a42..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Handlers/BUILD
+++ /dev/null
@@ -1,59 +0,0 @@
-# Macros
-
-%define cvs_package PerlModules/NP/Handlers
-%define nocpulse_home /opt/home/nocpulse
-
-Name: perl-NOCpulse-Handlers
-Version: 1.8.1
-Release: 1
-Packager: Karen Jacqmin-Adams <kja(a)redhat.com>
-Summary: apache handler development tools
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Group: unsorted
-Copyright: (c) 2002-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Prefix: %{_our_prefix}
-Buildroot: %{_tmppath}/%cvs_package
-Prereq: NPusers
-
-%description
-
-mod_perl handler development tools
-
-%prep
-%entirely_abstract_build_step
-
-%build
-echo "Nothing to build"
-
-%install
-
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-%find_perl_installsitelib
-
-mkdir -p $RPM_BUILD_ROOT/$installsitelib/NOCpulse
-mkdir -p $RPM_BUILD_ROOT/$installsitelib/LWP/Protocol
-mkdir -p $RPM_BUILD_ROOT/%nocpulse_home/bin
-
-install MockApacheLog.pm $RPM_BUILD_ROOT/$installsitelib/NOCpulse
-install MockApacheRequest.pm $RPM_BUILD_ROOT/$installsitelib/NOCpulse
-install handler.pm $RPM_BUILD_ROOT/$installsitelib/LWP/Protocol
-install handle.pl $RPM_BUILD_ROOT%nocpulse_home/bin
-
-%point_scripts_to_correct_perl
-
-%make_file_list
-
-%files -f %{name}-%{version}-%{release}-filelist
-%defattr(-,root,root,-)
-%attr(555,root,root) %nocpulse_home/bin/handle.pl
-
-
-%clean
-%abstract_clean_script
-
-%changelog
-* Thu Jun 19 2008 Miroslav Suchy <msuchy(a)redhat.com>
-- migrating nocpulse home dir (BZ 202614)
diff --git a/monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheLog.pm b/monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheLog.pm
deleted file mode 100644
index 7582c80..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheLog.pm
+++ /dev/null
@@ -1,96 +0,0 @@
-
-use strict;
-
-
-package NOCpulse::MockApacheLog;
-
-
-sub new
-{
- my $class = shift;
- my $self = {};
- bless $self, $class;
-
- return $self;
-}
-
-# The log() method is for internal use only. Use one of the
-# methods below instead.
-
-sub log
-{
- my $line = shift;
- my $level = shift || 'info';
-
- print '['.gmtime().'] ['.$level.'] [client 127.0.0.1] '.$line."\n";
-
-}
-
-# The various methods for logging. The method name
-# corresponds to the log level.
-
-sub emerg
-{
- my $self = shift;
- my $line = shift;
-
- $self->log($line, 'emerg');
-}
-
-sub alert
-{
- my $self = shift;
- my $line = shift;
-
- $self->log($line, 'alert');
-}
-
-sub crit
-{
- my $self = shift;
- my $line = shift;
-
- $self->log($line, 'crit');
-}
-
-sub error
-{
- my $self = shift;
- my $line = shift;
-
- $self->log($line, 'error');
-}
-
-sub warn
-{
- my $self = shift;
- my $line = shift;
-
- $self->log($line, 'warn');
-}
-
-sub notice
-{
- my $self = shift;
- my $line = shift;
-
- $self->log($line, 'notice');
-}
-
-sub info
-{
- my $self = shift;
- my $line = shift;
-
- $self->log($line, 'info');
-}
-
-sub debug
-{
- my $self = shift;
- my $line = shift;
-
- $self->log($line, 'debug');
-}
-
-1;
diff --git a/monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheRequest.pm b/monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheRequest.pm
deleted file mode 100644
index 0ad5a76..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Handlers/MockApacheRequest.pm
+++ /dev/null
@@ -1,47 +0,0 @@
-
-package NOCpulse::MockApacheRequest;
-
-use strict;
-use Apache::FakeRequest;
-use NOCpulse::MockApacheLog;
-
-@NOCpulse::MockApacheRequest::ISA = qw ( Apache::FakeRequest );
-
-
-sub new
-{
- my $class = shift;
- my @args = @_;
-
- my $self = Apache::FakeRequest->new(@args);
- bless $self, $class;
-
- $self->{'log'} = NOCpulse::MockApacheLog->new();
-
- $self->{'output'} = "";
-
- return $self;
-}
-
-sub log
-{
- my $self = shift;
-
- return $self->{'log'};
-}
-
-sub print
-{
- my $self = shift;
-
- $self->{'output'} .= join("", @_);
-}
-
-sub output
-{
- my $self = shift;
- $self->{'output'};
-}
-
-1;
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Handlers/handle.pl b/monitoring/PerlModules/NP/NOT-USED/Handlers/handle.pl
deleted file mode 100755
index 207107b..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Handlers/handle.pl
+++ /dev/null
@@ -1,29 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-
-use LWP::UserAgent;
-use HTTP::Request;
-use CGI;
-
-my $class = shift;
-if( not defined $class ) {
- print STDERR "\nUsage: $0 <handler_class_name>\n\n";
- exit(1);
-}
-
-my $cgi = CGI->new();
-
-my $request = HTTP::Request->new('POST', 'handler://'.$class);
-$request->content($cgi->query_string());
-
-my $ua = LWP::UserAgent->new();
-my $response = $ua->request($request);
-
-my $success = $response->is_success;
-my $status_line = $response->status_line();
-my $content = $response->content();
-
-print "success = $success\n";
-print "status_line = $status_line\n";
-print "content = $content\n";
diff --git a/monitoring/PerlModules/NP/NOT-USED/Handlers/handler.pm b/monitoring/PerlModules/NP/NOT-USED/Handlers/handler.pm
deleted file mode 100644
index 653ca6f..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Handlers/handler.pm
+++ /dev/null
@@ -1,53 +0,0 @@
-
-package LWP::Protocol::handler;
-
-use LWP::Protocol;
-@ISA = qw(LWP::Protocol);
-
-use strict;
-use HTTP::Request;
-use HTTP::Response;
-use HTTP::Status;
-use HTTP::Date;
-use URI::Escape;
-use NOCpulse::MockApacheRequest;
-
-sub request
-{
- my($self, $http_request, $proxy, $arg, $size) = @_;
-
- my $url = $http_request->url;
-
- my $scheme = $url->scheme;
- if ($scheme ne 'handler') {
- return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "LWP::Protocol::handler::request called for '$scheme'");
- }
-
- my $uri = $http_request->uri;
- $uri =~ /^handler:\/\/([^\/]+)/;
- my $handler_class = $1;
-
- my $apache_request = NOCpulse::MockApacheRequest->new();
- $apache_request->query_string($http_request->content());
-
- my $status;
- {
- eval "use $handler_class;";
- no strict "refs";
- # need to eval {} this next line?
- $status = &{$handler_class.'::handler'}($apache_request);
- }
-
- my $response = HTTP::Response->new($status);
-
- my $content = $apache_request->output();
-
- $response->header('Content-Length', scalar($content));
- $response->is_success(1);
- $response->content($content);
-
- return $response;
-}
-
-1;
diff --git a/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/BUILD b/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/BUILD
deleted file mode 100644
index e1dc9cf..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/BUILD
+++ /dev/null
@@ -1,39 +0,0 @@
-# Macros
-%define cvs_package PerlModules/NP/KudzuDevice
-
-# Package specific stuff
-Name: KudzuDevice
-Version: 1.4.0
-Release: 1
-Packager: Dave Parker <dparker(a)redhat.com>
-Summary: Provides read-only interface to Kudzu's hwconf file
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Group: unsorted
-Copyright: (c) 2000-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Prefix: %{_our_prefix}
-Prereq: perl-rhnmon
-Buildroot: %{_tmppath}/%cvs_package
-
-
-%description
-
-Provides read-only interface to Kudzu's hwconf file
-
-%prep
-%entirely_abstract_build_step
-
-%build
-%makefile_build
-
-%install
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-%makefile_install
-%point_scripts_to_correct_perl
-%make_file_list
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-%clean
-%abstract_clean_script
diff --git a/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/KudzuDevice.pm b/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/KudzuDevice.pm
deleted file mode 100755
index 5f5b129..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/KudzuDevice.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package KudzuDevice;
-use Data::Dumper;
-
-sub Initialize
-{
- my $class = shift;
- $class = ref($class) || $class;
- $class->{'records'} = [];
- open(FILE,'/etc/sysconfig/hwconf');
- $text = join('',<FILE>);
- close(FILE);
- @rawrecords = split(/^-$/m,$text);
- my $rawrecord;
- foreach $rawrecord (@rawrecords) {
- push(@{$class->{'records'}},$class->newInitialized($rawrecord));
- }
- return $class->{'records'};
-}
-
-sub AllWhereKeyOfValue
-{
- my ($class,$key,$value) = @_;
- $class = ref($class) || $class;
- $class->Initialize if ! $class->{'records'};
- my (@result,$record);
- foreach $record (@{$class->{'records'}}) {
- if ( exists($record->{$key}) ) {
- if ($record->{$key} eq $value) {
- push(@result,$record);
- }
- }
- }
- return \@result;
-}
-
-sub AllOfClass
-{
- my ($class,$hwclass) = @_;
- return $class->AllWhereKeyOfValue('class',$hwclass);
-}
-
-sub newInitialized
-{
- my $class = shift();
- my %self;
- my $rawrecord = shift();
- %self = map {
- split(/: /,$_,2);
- } split(/\n/,$rawrecord);
-
- bless(\%self,$class);
- return \%self;
-}
-
-1;
diff --git a/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/Makefile.PL b/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/Makefile.PL
deleted file mode 100644
index df5af6c..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/Makefile.PL
+++ /dev/null
@@ -1,11 +0,0 @@
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- 'NAME' => 'KudzuDevice',
- 'VERSION_FROM' => 'KudzuDevice.pm', # finds $VERSION
- 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'KudzuDevice.pm', # retrieve abstract from module
- AUTHOR => 'Dave Parker <dparker(a)redhat.com>') : ()),
-);
diff --git a/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/devdump b/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/devdump
deleted file mode 100755
index a2c0d8f..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/KudzuDevice/devdump
+++ /dev/null
@@ -1,5 +0,0 @@
-#!/opt/home/nocpulse/bin/perl
-use KudzuDevice;
-use Data::Dumper;
-KudzuDevice.Initialize;
-print Dumper(KudzuDevice->AllOfClass($ARGV[0]));
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_CVS/BUILD b/monitoring/PerlModules/NP/NOT-USED/NP_CVS/BUILD
deleted file mode 100644
index ada6088..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_CVS/BUILD
+++ /dev/null
@@ -1,47 +0,0 @@
-# Macros
-
-%define cvs_package PerlModules/NP/NP_CVS
-
-# Package specific stuff
-Name: NOCpulse-CVS
-Version: 1.2.0
-Release: 1
-Packager: Karen Jacqmin-Adams <karen(a)nocpulse.com>
-Summary: Perl CVS wrapper
-Source: NOCpulse-CVS-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Requires: cvs
-Provides: perl(NOCpulse::CVS)
-Group: unsorted
-Copyright: NOCpulse (c) 2001
-Vendor: NOCpulse
-Prefix: %{_our_prefix}
-Buildroot: %{_tmppath}/%cvs_package
-
-
-%description
-
-Provides an API to the cvs command.
-
-%prep
-%entirely_abstract_build_step
-
-
-%build
-%makefile_build
-
-%install
-rm -rf $RPM_BUILD_ROOT
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-%makefile_install
-%point_scripts_to_correct_perl
-%make_file_list
-
-%files -f %{name}-%{version}-%{release}-filelist
-%defattr(-,root,root,-)
-
-%clean
-%abstract_clean_script
-
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_CVS/CVS.pm b/monitoring/PerlModules/NP/NOT-USED/NP_CVS/CVS.pm
deleted file mode 100644
index a48329c..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_CVS/CVS.pm
+++ /dev/null
@@ -1,68 +0,0 @@
-######################
-package NOCpulse::CVS;
-######################
-
-use vars qw($VERSION);
-$VERSION = (split(/\s+/, q$Id: CVS.pm,v 1.4 2004-12-15 23:09:27 mmccune Exp $, 4))[2];
-
-use strict;
-use NOCpulse::Log::Logger;
-
-# Globals
-my $CVS_BIN = '/usr/bin/cvs';
-my $Log = NOCpulse::Log::Logger->new(__PACKAGE__);
-
-
-###########
-# Methods #
-###########
-
-###########
-sub new {
-###########
-
- my ($class) = @_;
- my $self = {};
- bless $self, $class;
-
- return $self;
-}
-
-# Accessor methods
-
-##########
-sub exec {
-##########
-
- my ($self, @params) = @_;
-
- # Prepare command for shell
- my $cmd = "$CVS_BIN @params";
-
- my $results;
- my $exitstatus;
- my $done=0;
- my $count=0;
-
- while (!$done) {
-
- $count++;
- $cmd =~ /(.*)/;
- $cmd = $&;
- $results = `$cmd 2>&1`;
-
- # Interpret the exit status
- $exitstatus = $? >> 8;
-
- $done=1;
- if ($exitstatus==1) {
- $done=0 if ($results =~ /Connection reset by peer/) && ($count <= 3);
- print STDERR "\n$results\nRetrying...\n";
- }
-}
-
- # Return results
- $Log->log(3,"CMD: $cmd\nRESULTS:($exitstatus) $results\n");
- return($results, $exitstatus, $cmd);
-
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_CVS/Makefile.PL b/monitoring/PerlModules/NP/NOT-USED/NP_CVS/Makefile.PL
deleted file mode 100644
index a9a5653..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_CVS/Makefile.PL
+++ /dev/null
@@ -1,11 +0,0 @@
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- 'NAME' => 'NOCpulse::CVS',
- 'VERSION_FROM' => 'CVS.pm', # finds $VERSION
- 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'CVS.pm', # retrieve abstract from module
- AUTHOR => 'A. U. Thor <a.u.thor(a)a.galaxy.far.far.away>') : ()),
-);
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_CVS/TestCVS.pl b/monitoring/PerlModules/NP/NOT-USED/NP_CVS/TestCVS.pl
deleted file mode 100644
index 4132ec0..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_CVS/TestCVS.pl
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use NOCpulse::CVS;
-
-my $rpm=new NOCpulse::CVS;
-
-my ($results,$retval,$cmd)=$rpm->exec('--help-options');
-print "results are\n$results\n\n";
-print "return value is\n$retval\n\n";
-print "command executed was\n$cmd\n\n";
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/BUILD b/monitoring/PerlModules/NP/NOT-USED/NP_RPM/BUILD
deleted file mode 100644
index 9d0c990..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/BUILD
+++ /dev/null
@@ -1,45 +0,0 @@
-# Macros
-%define cvs_package PerlModules/NP/NP_RPM
-
-# Package specific stuff
-Name: NOCpulse-RPM
-Version: 1.1.0
-Release: 1
-Packager: Karen Jacqmin-Adams <karen(a)nocpulse.com>
-Summary: Perl wrapper for RPM
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Requires: perl
-Provides: NOCpulse::RPM
-Group: unsorted
-Copyright: (c) 2001-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Prefix: /usr
-Buildroot: /tmp/%cvs_package
-
-%description
-
-Provides an API to the RPM command.
-
-
-%prep
-%entirely_abstract_build_step
-
-
-%build
-%makefile_build
-
-%install
-rm -rf $RPM_BUILD_ROOT
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-%makefile_install
-%point_scripts_to_correct_perl
-%make_file_list
-
-%files -f %{name}-%{version}-%{release}-filelist
-%defattr(-,root,root,-)
-
-%clean
-%abstract_clean_script
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/MANIFEST b/monitoring/PerlModules/NP/NOT-USED/NP_RPM/MANIFEST
deleted file mode 100644
index c735c32..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/MANIFEST
+++ /dev/null
@@ -1,6 +0,0 @@
-Makefile.PL
-MANIFEST
-README
-RPM.pm
-test.pl
-test/TestRPM.pl
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/Makefile.PL b/monitoring/PerlModules/NP/NOT-USED/NP_RPM/Makefile.PL
deleted file mode 100644
index c9be6a9..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/Makefile.PL
+++ /dev/null
@@ -1,11 +0,0 @@
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- 'NAME' => 'NOCpulse::RPM',
- 'VERSION_FROM' => 'RPM.pm', # finds $VERSION
- 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'RPM.pm', # retrieve abstract from module
- AUTHOR => 'A. U. Thor <a.u.thor(a)a.galaxy.far.far.away>') : ()),
-);
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/README b/monitoring/PerlModules/NP/NOT-USED/NP_RPM/README
deleted file mode 100644
index b810330..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/README
+++ /dev/null
@@ -1,35 +0,0 @@
-NOCpulse/RPM version 0.01
-=========================
-
-The README is used to introduce the module and provide instructions on
-how to install the module, any machine dependencies it may have (for
-example C compilers and installed libraries) and any other information
-that should be provided before the module is installed.
-
-A README file is required for CPAN modules since CPAN extracts the
-README file from a module distribution so that people browsing the
-archive can use it get an idea of the modules uses. It is usually a
-good idea to provide version information here so that people can
-decide whether fixes for the module are worth downloading.
-
-INSTALLATION
-
-To install this module type the following:
-
- perl Makefile.PL
- make
- make test
- make install
-
-DEPENDENCIES
-
-This module requires these other modules and libraries:
-
- blah blah blah
-
-COPYRIGHT AND LICENCE
-
-Put the correct copyright and licence information here.
-
-Copyright (C) 2003 A. U. Thor blah blah blah
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/RPM.pm b/monitoring/PerlModules/NP/NOT-USED/NP_RPM/RPM.pm
deleted file mode 100644
index 139e912..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/RPM.pm
+++ /dev/null
@@ -1,111 +0,0 @@
-######################
-package NOCpulse::RPM;
-######################
-
-use vars qw($VERSION);
-$VERSION = (split(/\s+/, q$Id: RPM.pm,v 1.3 2003-08-29 20:39:03 cvs Exp $, 4))[2];
-
-use strict;
-use NOCpulse::Log::Logger;
-
-# Globals
-my $RPM_BIN = '/bin/rpm';
-my $Log = NOCpulse::Log::Logger->new(__PACKAGE__);
-
-###########
-# Methods #
-###########
-
-###########
-sub new {
-###########
-
- my ($class) = @_;
- my $self = {};
- bless $self, $class;
-
- return $self;
-}
-
-# Accessor methods
-#sub connected { shift->_elem('connected', @_); }
-
-###########
-sub _elem {
-###########
-# Stolen from LWP::MemberMixin
-
- my($self, $elem, $val) = @_;
- my $old = $self->{$elem};
- $self->{$elem} = $val if defined $val;
- return $old;
-}
-
-
-#### DAP - It hurts to have done this. Given the interface to exec()
-#### however, the only other solution that strikes me as tenable
-#### is to actually parse the params to figure out what's supposed
-#### to get run. If you guys have a better idea I'm all for it.
-
-##########
-sub set_build_mode {
-##########
- my $self = shift();
- $RPM_BIN='/usr/bin/rpmbuild';
-}
-
-##########
-sub set_query_mode {
-##########
- my $self = shift();
- $RPM_BIN='/bin/rpm';
-}
-
-##########
-sub exec {
-##########
-
- my ($self, @params) = @_;
-
- # Prepare command for shell
- my $cmd = "$RPM_BIN @params";
- $cmd =~ /(.*)/;
- $cmd = $&;
-
- # Don't let it take too long!
-# my $tomsg = "Timed out!\n";
- my $results;
- my $exitstatus;
-
- eval {
-# $SIG{'ALRM'} = sub {die $tomsg};
-# alarm($self->timeout);
-
- # Execute command and capture STDOUT & STDERR
- $results = `$cmd 2>&1`;
-
-# alarm(0);
- };
-
-# if ($@ eq $tomsg) {
-#
-# $results = "Error: Timed out\n";
-# $exitstatus = 4;
-#
-# } elsif ($@) {
-
- if ($@) {
-
- $results = "Error: $@\n";
- $exitstatus = 4;
-
- } else {
- # Interpret the exit status
- $exitstatus = $? >> 8;
-
- }
- # Return results
- $Log->log(3,"CMD: $cmd\nRESULTS:($exitstatus) $results\n");
- return($results, $exitstatus, $cmd);
-
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/test.pl b/monitoring/PerlModules/NP/NOT-USED/NP_RPM/test.pl
deleted file mode 100644
index 2136b0c..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/test.pl
+++ /dev/null
@@ -1,17 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use Test;
-BEGIN { plan tests => 1 };
-use NOCpulse::RPM;
-ok(1); # If we made it this far, we're ok.
-
-#########################
-
-# Insert your test code below, the Test module is use()ed here so read
-# its man page ( perldoc Test ) for help writing this test script.
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/test/TestRPM.pl b/monitoring/PerlModules/NP/NOT-USED/NP_RPM/test/TestRPM.pl
deleted file mode 100644
index e7c20aa..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/NP_RPM/test/TestRPM.pl
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use NOCpulse::RPM;
-
-my $rpm=new NOCpulse::RPM;
-
-my ($results,$retval,$cmd)=$rpm->exec('--help');
-print "results are\n$results\n\n";
-print "return value is\n$retval\n\n";
-print "command executed was\n$cmd\n\n";
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/PackingList/BUILD b/monitoring/PerlModules/NP/NOT-USED/PackingList/BUILD
deleted file mode 100644
index ff2a23a..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PackingList/BUILD
+++ /dev/null
@@ -1,41 +0,0 @@
-# Macros
-
-%define cvs_package PerlModules/NP/PackingList
-
-# Package specific stuff
-Name: NOCpulse-PackingList
-Version: 1.4.0
-Release: 1
-Packager: Karen Jacqmin-Adams <karen(a)nocpulse.com>
-Summary: PackingList for meta-rpm
-Source: NOCpulse-PackingList-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Requires: perl >= 5.00500
-Provides: NOCpulse::PackingList
-Group: unsorted
-Copyright: NOCpulse (c) 2001
-Vendor: NOCpulse
-Prefix: %{_our_prefix}
-Buildroot: %{_tmppath}/%cvs_package
-
-%description
-
-Provides an API to the MAINFEST and PACKINGLIST files for the NOCpulse release process.
-
-%prep
-%entirely_abstract_build_step
-
-%build
-
-%install
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-%find_perl_installsitelib
-mkdir -p $RPM_BUILD_ROOT$installsitelib/NOCpulse
-install -o root -g root -m 444 PackingList.pm $RPM_BUILD_ROOT$installsitelib/NOCpulse/PackingList.pm
-%point_scripts_to_correct_perl
-%make_file_list
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-%clean
-%abstract_clean_script
diff --git a/monitoring/PerlModules/NP/NOT-USED/PackingList/MANIFEST b/monitoring/PerlModules/NP/NOT-USED/PackingList/MANIFEST
deleted file mode 100644
index 5cb2d1e..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PackingList/MANIFEST
+++ /dev/null
@@ -1,93 +0,0 @@
-%Require Users%
- nocops
-
-%Require Packages%
-# Config-IniFiles #PerlModules/CPAN/Config-IniFiles-0.09
-# Date-Manip #PerlModules/CPAN/DateManip-5.35
-# FreezeThaw #PerlModules/CPAN/FreezeThaw-0.3
-# openssl #PerlModules/CPAN/openssl-0.9.6a
-# Crypt-SSLeay #PerlModules/CPAN/Crypt-SSLeay-0.17
-# Net_SSLeay.pm #PerlModules/CPAN/Net/SSLeay
-# DBI #PerlModules/CPAN/DBI-1.14
-# DBD-Oracle #PerlModules/CPAN/DBD-Oracle-1.05
-# DBD-Pg #PerlModules/CPAN/DBD-Pg-0.95
-# Digest-MD5 #PerlModules/CPAN/Digest-MD5-2.12
-# MIME-Base64 #PerlModules/CPAN/MIME-Base64-2.11
-# MIME-tools #PerlModules/CPAN/MIME-tools-5.410
-# Mail-Alias #PerlModules/CPAN/Mail-Alias-1.12
-# MailTools #PerlModules/CPAN/MailTools-1.15
-# HTML-Parser #PerlModules/CPAN/HTML-Parser-3.13
-# Net-SNMP #PerlModules/CPAN/Net-SNMP-3.6
-# URI #PerlModules/CPAN/URI-1.09
-# libwww-perl #PerlModules/CPAN/libwww-perl-5.48
-# expat #PerlModules/CPAN/expat-1.95.1
-# XML-Parser #PerlModules/CPAN/XML-Parser-2.30
-# XML-Dumper #PerlModules/CPAN/XML-Dumper-0.4
-# IO-stringy #PerlModules/CPAN/IO-stringy-1.219
-# IO #PerlModules/CPAN/IO-1.20
-# libnet #PerlModules/CPAN/libnet-1.0703
-# Time-HiRes #PerlModules/CPAN/Time-HiRes-01.20
-# OracleClient-1.0.2 --nodeps --nofiles
-# ora-config
-
-%Remove Packages%
- SatConfig-client #SatConfig/satgen
- np-shell-plugin
-
-%Install Packages%
- PerlModules/CPAN/Config-IniFiles-2.19
- PerlModules/CPAN/DateManip-5.35
- PerlModules/CPAN/FreezeThaw-0.3
- PerlModules/CPAN/openssl-0.9.6a | openssl-0.9.6a # don't install devel or doc
- PerlModules/CPAN/Crypt-SSLeay-0.17
- PerlModules/CPAN/Net/SSLeay
- PerlModules/CPAN/DBI-1.14
- PerlModules/CPAN/DBD-Oracle-1.05
- PerlModules/CPAN/DBD-Pg-0.95
- PerlModules/CPAN/Digest-MD5-2.12
- PerlModules/CPAN/MIME-Base64-2.11
- PerlModules/CPAN/MIME-tools-5.410
- PerlModules/CPAN/Mail-Alias-1.12
- PerlModules/CPAN/MailTools-1.15
- PerlModules/CPAN/HTML-Parser-3.13
- PerlModules/CPAN/Net-SNMP-3.6
- PerlModules/CPAN/URI-1.09
- PerlModules/CPAN/libwww-perl-5.48
- PerlModules/CPAN/expat-1.95.1
- PerlModules/CPAN/XML-Parser-2.30
- PerlModules/CPAN/XML-Dumper-0.4
- PerlModules/CPAN/IO-stringy-1.219
- PerlModules/CPAN/IO-1.20 --force
- PerlModules/CPAN/IO-Socket-SSL-0.77
- PerlModules/CPAN/libnet-1.0703
- PerlModules/CPAN/Time-HiRes-01.20
- PerlModules/CPAN/Device-SerialPort-0.10
- SatConfig/general
- PerlModules/NP/OracleDB
- np-config, CUSTOMER
- network/admin --force
- ucd-snmp-4.1
- PerlModules/NP/Debug
- PerlModules/NP/Gritch
- ProgAGoGo
- MessageQueue
- SatConfig/installer
- SatConfig/custcfg
- PerlModules/NP/Object
- PerlModules/NP/Cluster
- PerlModules/NP/NSStatus
- PerlModules/NP/PlugFrame
- PerlModules/NP/ProcessPool
- PerlModules/NP/Scheduler
- NOCpulsePlugins
- timesync | timesync-client # don't install the server
- LongLegs
- status_log_grabber
- freetds-0.51
- DBD-Sybase-0.91
- SatConfig/logpusher
- SatConfig/bootstrap
- sputnik/SputLite, CLIENT
- LogAgent
- SNMP
- mysql-3.23.41
diff --git a/monitoring/PerlModules/NP/NOT-USED/PackingList/PackingList.pm b/monitoring/PerlModules/NP/NOT-USED/PackingList/PackingList.pm
deleted file mode 100644
index 77a06ed..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PackingList/PackingList.pm
+++ /dev/null
@@ -1,163 +0,0 @@
-##############################
-package NOCpulse::PackingList;
-##############################
-
-use vars qw($VERSION);
-$VERSION = (split(/\s+/,
- q$Id: PackingList.pm,v 1.11 2002-06-07 21:03:08 cvs Exp $,
- 4))[2];
-
-use strict;
-
-###########
-# Methods #
-###########
-
-###########
-sub new {
-###########
-
- my ($class) = @_;
- my $self = {};
- bless $self, $class;
-
- return $self;
-}
-
-# Accessor methods
-sub required_users { shift->_elem('required_users', @_); }
-sub required_packages { shift->_elem('required_packages', @_); }
-sub remove_packages { shift->_elem('remove_packages', @_); }
-sub install_packages { shift->_elem('install_packages', @_); }
-sub debug { shift->_elem('debug', @_); }
-
-###########
-sub _elem {
-###########
-# Stolen from LWP::MemberMixin
-
- my($self, $elem, $val) = @_;
- my $old = $self->{$elem};
- $self->{$elem} = $val if defined $val;
- return $old;
-}
-
-#####################
-sub createHash {
-#####################
- my ($line,$comment)=@_;
- my %hash={};
- my ($line2,$pkg) =split(/\|/,$line);
- my ($name, $build, @args, $line3);
-
- if ($line2 =~ /,/)
- {
- #this contains a BUILD file name
- ($name, $line3)= split(/,/,$line2);
- $line3 =~ s/^\s*//;
- ($build, @args)=split(/\s+/,$line3);
- } else {
- ($name, @args)=split(/\s+/,$line2);
- }
-
- $hash{'name'} =&trimString($name);
- $hash{'build'} =&trimString($build) if defined($build);
- $hash{'package'}=&trimString($pkg) if defined($pkg);
- $hash{'args'} =join(' ',@args);
- $hash{'comment'}=$comment;
- return \%hash;
-}
-
-############
-sub absorb {
-############
-
- my ($self, $manifest_file)=@_;
-
- open(FILE,$manifest_file) || die "ERROR reading manifest data: $!";
-
- my %hash = map { $_ => [] } qw (Require_Users Require_Packages Install_Packages Remove_Packages);
-
- my $key;
- my $comment;
- while (<FILE>)
- {
- ($_,$comment) = split(/#/); #weed out comments
- if (/^\s*%.*%\s*$/)
- {
-
- s/^\s*%(.*)%\s$*/\1/;
- s/\s/_/g;
- $key = $_;
-
- } else {
-
- s/^\s*$//g;
- s/^\s*(\S.*\S)\s*$/\1/;
- my $elem=$hash{$key};
- chomp($comment);
- push(@$elem,&createHash($_,$comment)) unless /^$/;
- }
- }
-
- $self->required_users( $hash{'Require_Users'});
- $self->required_packages($hash{'Require_Packages'});
- $self->remove_packages( $hash{'Remove_Packages'});
- $self->install_packages( $hash{'Install_Packages'});
-}
-
-#########################
-sub transcribeHashArray {
-#########################
-
- my ($self, $handle, $arrayptr, $label)=@_;
-
- print $handle "$label\n";
-
- my ($item,$name);
- foreach $item (@$arrayptr) {
-
- foreach $name (split(/,/,$item->{'name'}))
- {
- print $handle $name;
- unless($item->{'args'} =~ /^\s*$/)
- {
- print $handle ' ', $item->{'args'};
- }
- unless($item->{'comment'} =~ /^\s*$/)
- {
- print $handle ' #', $item->{'comment'};
- }
- print $handle "\n";
- }
-
- }
- print $handle "\n";
-}
-
-################
-sub transcribe {
-################
-
- my ($self, $file, $comment)=@_;
- my $tmp;
-
- open(FILE, "> $file") || die "Unable to open file $file: $!";
-
- print FILE "# $comment\n\n";
-
- $self->transcribeHashArray(\*FILE, $self->required_users, "%Require Users%");
- $self->transcribeHashArray(\*FILE, $self->required_packages, "%Require Packages%");
- $self->transcribeHashArray(\*FILE, $self->remove_packages, "%Remove Packages%");
- $self->transcribeHashArray(\*FILE, $self->install_packages, "%Install Packages%");
-
- close(FILE);
-}
-
-#################
-sub trimString {
-#################
- my ($string)=@_;
- $string =~ s/^\s*(.*[^\s])\s*$/$1/;
- return $string;
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/PackingList/testPackingList.pl b/monitoring/PerlModules/NP/NOT-USED/PackingList/testPackingList.pl
deleted file mode 100755
index 4f7e0d7..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PackingList/testPackingList.pl
+++ /dev/null
@@ -1,19 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use Data::Dumper;
-use NOCpulse::PackingList;
-
-my $packing_list= new NOCpulse::PackingList;
-$packing_list->absorb('MANIFEST');
-
-#print "required users:\n" , &Dumper($packing_list->required_users), "\n";
-#print "required packages:\n" , &Dumper($packing_list->required_packages), "\n";
-#print "remove packages:\n" , &Dumper($packing_list->remove_packages), "\n";
-print "install packages:\n" , &Dumper($packing_list->install_packages), "\n";
-
-print "\n\nHere is the transcribed packing list:\n";
-$packing_list->transcribe("$$.dat");
-print `cat $$.dat`;
-
-print "Please verify output in $$.dat\n";
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/BUILD b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/BUILD
deleted file mode 100644
index 02ed65b..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/BUILD
+++ /dev/null
@@ -1,44 +0,0 @@
-# Macros
-%define cvs_package PerlModules/NP/PlugFrame
-
-# Package specific stuff
-Name: NOCpulse-PlugFrame
-Version: 4.42.0
-Release: 1
-Packager: Karen Jacqmin-Adams <kja(a)redhat.com>
-Summary: NOCpulse Plugin framework for Perl
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-Requires: NOCpulse-Object NOCpulse-CLAC np-config MessageQueue
-BuildArch: noarch
-Group: unsorted
-Copyright: (c) 2000-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Prefix: %{_our_prefix}
-Buildroot: %{_tmppath}/%cvs_package
-
-%description
-
-NOCpulse-PlugFrame provides a framework for writing NOCpulse-compliant
-satellite probes in Perl
-
-%prep
-%entirely_abstract_build_step
-
-
-%build
-%makefile_build
-
-%install
-rm -rf $RPM_BUILD_ROOT
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-%makefile_install
-%point_scripts_to_correct_perl
-%make_file_list
-
-
-%files -f %{name}-%{version}-%{release}-filelist
-%defattr(-,root,root,-)
-
-
-%clean
-%abstract_clean_script
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/MANIFEST b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/MANIFEST
deleted file mode 100644
index 39463e8..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/MANIFEST
+++ /dev/null
@@ -1,11 +0,0 @@
-Makefile.PL
-MANIFEST
-README
-test.pl
-Metric.pm
-Plugin.pm
-PortableShellProbe.pm
-ProbeGenerator.pm
-Probe.pm
-ProbeState.pm
-ShellProbe.pm
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Makefile.PL b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Makefile.PL
deleted file mode 100644
index 24d3f4a..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Makefile.PL
+++ /dev/null
@@ -1,11 +0,0 @@
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- 'NAME' => 'NOCpulse::PlugFrame::Plugin',
- 'VERSION_FROM' => 'Plugin.pm', # finds $VERSION
- 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'Plugin.pm', # retrieve abstract from module
- AUTHOR => 'Dave Parker <dparker(a)redhat.com>') : ()),
-);
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Metric.pm b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Metric.pm
deleted file mode 100644
index 0bfafb8..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Metric.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-package Metric;
-
-use strict;
-
-use NOCpulse::PersistentObject;
-@Metric::ISA=qw(NOCpulse::PersistentObject);
-
-sub named {
- my ($class,$instanceName) = @_;
- return $class->newInitializedNamed($instanceName);
-}
-
-sub hasValue {
- my $self = shift();
- return $self->get_value;
-}
-
-sub templateNodes {
- my $self = shift();
- my @parts = split('->',$self->get_Template_string);
- return @parts;
-}
-
-sub metricId {
- my $self = shift();
- my ($junk, $metricId) = split('->', $self->get_name, 2);
- return $metricId;
-}
-
-sub templateAndMetricIds
-{
- my $self = shift();
- my ($template,$metricId) = split('->',$self->get_name,2);
- my ($junk1,$templateId,$junk2) = split(/(^.*)_.?/,$template,2);
- return [$templateId,$metricId];
-}
-
-1;
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Plugin.pm b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Plugin.pm
deleted file mode 100644
index 12fb70d..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Plugin.pm
+++ /dev/null
@@ -1,569 +0,0 @@
-package Plugin;
-
-use strict;
-use vars qw(@ISA);
-
-use NOCpulse::CommandLineApplicationComponent;
-use NOCpulse::Module;
-use NOCpulse::PlugFrame::Probe;
-use NOCpulse::NPRecords;
-use Getopt::Long;
-use NOCpulse::Config;
-use Data::Dumper;
-use NOCpulse::SatCluster;
-use NOCpulse::SetID;
-
-@ISA=qw(NOCpulse::CommandLineApplicationComponent);
-
-my %statusMap = ('CRITICAL'=> 2,'WARN'=>1,'OK'=>0,'UNKNOWN'=>-1);
-
-sub overview {
- return "This component drives execution of a probe class that you must specify.";
-}
-
-sub classVarDefinitions
-{
- my $class = shift();
- my $class = ref($class) || $class;
-
- if (! $class->getClassVar('NPConfig')) {
- $class->setClassVar('NPConfig',NOCpulse::Config->new);
- }
-
- if (! $class->getClassVar('Cluster')) {
- $class->setClassVar('Cluster',NOCpulse::SatCluster->newInitialized($class->getClassVar('NPConfig')));
- }
-}
-
-sub instVarDefinitions
-{
- my $self = shift();
- $self->SUPER::instVarDefinitions;
- $self->addInstVar('probeModule');
- $self->addInstVar('shellModule');
- $self->addInstVar('npconfig');
- $self->addInstVar('cluster');
- $self->addInstVar('definition');
- $self->addInstVar('isValid',1);
-}
-
-sub loadClass
-{
- my ($self,$className) = @_;
- my $libdir = $self->get_libdir;
- unless ($libdir) {
- $libdir = $self->configValue('probeClassLibraryDirectory');
- }
-
- my ($status,$errors) = Module::load($className, $libdir, ['NOCpulse::PlugFrame','NOCpulse']);
-
- if (! $status) {
- $self->print("Configuration error - unable to load $className:\n");
- my $attempt = 0;
- map { $self->print("Attempt ".($attempt + 1)." = ".$$errors[$attempt]."\n");$attempt ++} @$errors;
- return $self->exit;
- }
-
-
-}
-
-sub registerSwitches
-{
- my $self = shift();
- $self->SUPER::registerSwitches;
- $self->addSwitch('probe','=s',1,undef,'Specify the probe class or instance ID to use');
- $self->addSwitch('shell','=s',0,$self->configValue('defaultCommandShell'),'Specify the type of shell to use (if required)');
- $self->addSwitch('debug','=i',0,0,'Execute with debug level set to this number. Support varies from module to module.');
- $self->addSwitch('saveid','=i',0,0,'Save configuration (do not run probe) to the object database with ID equal to this value');
- $self->addSwitch('libdir','=s',0,undef,'Use this library directory instead of the one defined in the framework configuration file');
- $self->addSwitch('xmlUsage','',0,'','Print usage as XML');
- $self->addSwitch('help','',0,'','Print this help');
-
- # This will go away soon...it's been replaced by the catalog script
- $self->addSwitch('catalog','',0,'','Obsolete: use catalog script instead');
-}
-
-sub setupDebugging {
- my $self = shift();
- # Note - this can only be called after switchesAreValid is called as
- # CommandLineApplicationComponent doesn't actually claim switch values
- # 'til then.
- if ($self->get_debug) {
- my $debugLevel = $self->get_debug;
- $self->debugObject()->addstream(LEVEL=>$debugLevel);
- $self->dprint($debugLevel,"Debugging set to $debugLevel\n");
- }
-}
-
-
-sub initialize
-{
- my ($self,$probeRecord) = @_;
-
- $self->classVarDefinitions;
- $self->set_npconfig($self->getClassVar('NPConfig'));
- $self->set_cluster($self->getClassVar('Cluster'));
-
- if (! defined($NOCpulse::Object::config)) {
- NOCpulse::Object::SystemIni($self->get_npconfig->get('PlugFrame','configFile'));
- }
-
- $self->SUPER::initialize;
-
- if ($self->configValue('requiredUser')) {
- $self->ensureIsRequiredUser;
- }
-
- if (! $self->switchesAreValid) {
- if ($self->get_catalog) {
- # Old usage, tell them what to do and bail.
- $self->print("\nNOTE: Run /opt/home/nocpulse/libexec/catalog to get a catalog of probes.\n\n");
- exit;
-
- } else {
- $self->print("Configuration error\n");
- $self->printUsage($self->get_xmlUsage);
- return $self->exit;
- }
- } else {
- $self->setupDebugging;
- }
-
- my $probeSwitch = $self->switchValue('probe');
-
- if ($probeSwitch =~ /^\d*$/) {
- # This is a probe ID
- $self->initFromProbeId($probeSwitch, $probeRecord);
-
- } else {
- # Not an ID, so it should be the class name
- $self->initFromProbeClass($probeSwitch, $probeRecord);
- }
- if ($self->switchValue('help')) {
- $self->printUsage($self->get_xmlUsage);
- return $self->exit;
- # Does not return
-
- } elsif ( ! $self->commandLineIsValid ) {
- $self->set_isValid(0);
- $self->printUsage($self->get_xmlUsage);
- $self->printInvalidSwitches($self->get_xmlUsage);
- return $self->exit;
- # Does not return
- }
-
- if ($self->switchValue('saveid')) {
- # Save the probe instance to the object database with the given ID
- $self->get_probeModule->persist; # Magic happens :)
- $self->get_probeModule->set_status('OK');
- #$self->print("Saved probe with id ".$self->switchValue('saveid').' to object database');
- return $self->exit;
- }
- return $self;
-}
-
-sub run
-{
- my ($self) = @_;
- # Probe object is defined unless it's been deleted
- # from the probe DB while the probe was running.
- my $probe = $self->get_probeModule;
- if ($probe) {
- $probe->_run(1);
- }
- return $self->exit;
-}
-
-sub runAndDump
-{
- my ($self) = @_;
- $self->get_probeModule->_run(1);
- $self->dprint(1,$self->printString);
- return $self->exit;
-}
-
-sub pluginStatusMessage
-{
- my $self = shift();
- if ($self->get_probeModule) {
- return $self->get_probeModule->get_status.': '.
- $self->get_probeModule->statusMessage;
- } else {
- return "UNKNOWN: Configuration error: cannot find probe module\n";
- }
-}
-
-sub exitLevel
-{
- my $self = shift();
- if ($self->get_probeModule) {
- return $statusMap{$self->get_probeModule->get_status()};
- } else {
- return 'UNKNOWN';
- }
-}
-
-sub exit
-{
- my $self = shift();
- print $self->pluginStatusMessage;
- exit($self->exitLevel);
-}
-
-sub printUsage {
- my ($self,$xmlUsage) = @_;
- $self->dprint(1,$self->printString);
- if ($xmlUsage) {
- $self->printUsageAsXML;
- } else {
- $self->SUPER::printUsage;
- }
-}
-
-sub printInvalidSwitches {
- my ($self,$xmlUsage) = @_;
- if (!$xmlUsage) {
- $self->SUPER::printInvalidSwitches;
- }
-}
-
-# Exits if not running as the required user.
-sub ensureIsRequiredUser
-{
- my ($self, $requiredUser) = @_;
- if ($requiredUser) {
- if ( $< == 0) {
- if (getpwnam($requiredUser) > 0) {
- NOCpulse::SetID->new( username => $requiredUser)->su(permanent=>1);
- } else {
- $self->print("\n!!ERROR!! No $requiredUser user found - ending run\n\n");
- exit(-1);
- }
- } elsif (! (getpwuid($<) eq $requiredUser)) {
- $self->print("\nERROR: Plugins must be run as user ".$requiredUser.', but you are currently '.getpwuid($<)." - ending run.\n\n");
- exit(-1);
- }
- }
-}
-
-# Initializes a probe from its class name.
-sub initFromProbeClass
-{
- my ($self, $probeClass, $probeRecord) = @_;
- $probeClass =~ s/(.*)\.pm/$1/g;
- $self->loadClass($probeClass);
-
- if ($self->switchValue('saveid')) {
- # Saving this one in the probe database.
- $probeRecord = $self->getDummyProbeRecord(@ARGV) unless $probeRecord;
- $self->set_probeModule($probeClass->newInitializedNamed($self->switchValue('saveid'),$self,$probeRecord));
- } else {
- # Not saving, so don't try to save state.
- ProbeState->setClassVar('databaseDirectory', '/dev/null');
- $self->set_probeModule($probeClass->newInitialized($self));
- }
- my $shellClass = $self->switchValue('shell');
- if ($self->get_probeModule->needsCommandShell) {
- $self->loadClass($shellClass);
- $self->set_shellModule($shellClass->newInitialized());
- }
- # Assign the shell module directly to the probe, so that it is
- # present in the probe DB for use after thawing.
- $self->get_probeModule->set_shellModule($self->get_shellModule);
-}
-
-# Initializes a probe from the probe cache or database.
-sub initFromProbeId
-{
- my ($self, $probeId, $probeRecord) = @_;
-
- my $probe = Probe->loadFromDatabase($probeId, 'try-cache');
-
- if (! $probe) {
- $self->print('Unable to load probe with instance ID='.$probeId."\n");
- return $self->exit;
- }
-
- $self->loadClass(ref($probe)); # Now load the relevant class definition
-
- $probe->set_probeRecord(ProbeRecord->Called($probeId));
-
- # (Next one is sort of kludgy)
- NOCpulse::CommandLineApplicationComponent::AddInstance($probe); # Let the framework know about it too
- $self->set_shellModule($probe->get_shellModule); # Re-wire the shell instance
- if ($self->get_shellModule) {
- $self->loadClass(ref($self->get_shellModule)); # ...and load its class definition
- NOCpulse::CommandLineApplicationComponent::AddInstance($self->get_shellModule); # Let the framework know about it too
- }
- $probe->set_plugin($self); # Tell probe instance it belongs to me now
- $self->set_probeModule($probe); # Tell me I own the probe instance
-}
-
-
-###################################################################
-### The status methods are for backward compatibility with probes
-### that wanted to converse with their status at the plugin level,
-### which is where it used to be.
-sub get_status
-{
- my $self = shift();
- return $self->get_probeModule->get_status;
-}
-sub set_status
-{
- my ($self,$value) = @_;
- return $self->get_probeModule->set_status($value);
-}
-###################################################################
-
-# Returns a dummy probe record so that things can more or less run from the command line.
-sub getDummyProbeRecord {
- my $self = shift();
- my %rec =
- (
- 'RECID' => $self->get_saveid,
- 'PROBE_TYPE' => 'ServiceProbe',
- 'CUSTOMER_ID' => 0,
- 'CHECK_INTERVAL' => 5,
- 'RETRY_INTERVAL' => 5,
- 'MAX_ATTEMPTS' => 1,
- 'parsedCommandLine' => \@ARGV,
- 'hostName' => 'None',
- 'hostRecid' => 0,
- 'DESCRIPTION' => 'None',
- 'NOTIFY_WARNING' => '0',
- 'NOTIFY_CRITICAL' => '0',
- 'NOTIFY_RECOVERY' => '0',
- 'NOTIFICATION_PERIOD' => 1,
- 'NOTIFICATION_INTERVAL' => 60,
- 'contactGroupNames' => [ 'ignoreMe' ],
- 'LAST_UPDATE_USER' => 'nobody',
- 'LAST_UPDATE_DATE' => 'never',
- );
- ProbeRecord->ReleaseAllInstances;
- return ProbeRecord->newFromHash(\%rec, 'RECID');
-}
-
-
-package MemoryPlugin;
-
-use strict;
-use vars qw(@ISA);
-@ISA=qw(Plugin);
-use NOCpulse::Scheduler::Event::PluginEvent;
-use Data::Dumper;
-
-sub initialize {
- my ($self,$probeRecord) = @_;
- $self->SUPER::initialize($probeRecord);
- return $self;
-}
-
-sub asInitialEvent
-{
- my $self = shift();
- my $event = NOCpulse::Scheduler::Event::PluginEvent->new($self->get_probeModule->get_name);
- my $probeRec = $self->get_probeModule->get_probeRecord($event->id);
- if (! defined($probeRec)) {
- print STDERR "No probe record found for probe ", $event->id, "\n";
- } else {
- $event->time_to_execute($self->get_probeModule->nextRunTime);
- if ($probeRec->get_PARENT_PROBES_ID) {
- $event->subscribe_to('childOf-'.$probeRec->get_PARENT_PROBES_ID);
- }
- }
- return $event;
-}
-
-sub exit {
- my $self = shift();
- return $self;
-}
-
-package ScheduledPlugin;
-
-use strict;
-use vars qw(@ISA);
-@ISA=qw(Plugin);
-use NOCpulse::Scheduler::Message;
-
-sub initialize {
- my ($self,$recid) = @_;
- my $args = ["--probe=$recid"];
- @ARGV=@$args;
- DBMObjectRepository->CacheHandles(0);
- $self->SUPER::initialize();
- return $self;
-}
-
-sub run
-{
- my $self = shift();
- return $self->SUPER::run();
-}
-
-sub handleTimeout
-{
- my $self = shift();
- $self->get_probeModule->handleTimeout;
- return $self->exit;
-}
-
-sub exit {
- my $self = shift();
- print $self->pluginStatusMessage;
- my $probe = $self->get_probeModule;
- if ($probe) {
- return $probe->nextRunTime, undef;
- } else {
- return undef,undef;
- }
-}
-
-sub removeStatusFile
-{
- my $self = shift();
- my $filename = $self->get_probeModule->get_probeRecord->get_RECID;
- my $fullPath = "/opt/home/nocpulse/var/status/$filename";
- return unlink($fullPath);
- # Ridiculous - this appears to be the only reason we're using NSStatus. The code above
- # accomplishes the same thing.
- #return NSStatusFile->newInitialized->remove($self->get_probeModule->get_probeRecord->get_RECID);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Plugin - NOCpulse style plugin "driver" class
-
-=head1 SYNOPSIS
-
- use NOCpulse::PlugFrame::Plugin;
- Plugin->newInitialized->run;
-
-
-=head1 DESCRIPTION
-
-Plugin is a "driver" class that implements NOCpulse style plugin probes. It is a
-"driver" in that its intent is to be that of the "mainline" for a probe (it
-is not intended to be subclassed).
-
-Plugin provides for dynamic loading of probe classes and support for dynamically loading
-shell access classes.
-
-=head1 REQUIRES
-
-Perl 5.004, CommandLineApplicationComponent, Getopt::Long, NOCpulse::Config;
-
-=cut
-
-
-=head1 CLASS VARIABLES
-
-=over 4
-
-=item %statusMap
-
-A hash that translates a status name to an exit level:
-
-CRITICAL = 2
-
-WARN = 1
-
-OK = 0
-
-UNKNOWN = -1
-
-=cut
-
-
-=head1 INSTANCE METHODS
-
-=over 4
-
-=item instVarDefinitions()
-
-Defines the following:
-
-probeModule - holds a pointer to an instance of the probe module for the current execution
-
-shellModule - holds a pointer to an instance of a CommandShell subclass (if the probeModule requires one)
-
-npconfig - holds a pointer to a NOCpulse::Config object
-
-cluster - holds a pointer to a NOCpulse::SatCluster object
-
-definition - holds the configuration database record for the current instance - only present when running in scheduler
-
-isValid - true or false depending on whether the command line is valid
-
-=cut
-
-
-=item registerSwitches()
-
-Defines the following:
-
-probe - the name of the class (module) to load/run
-
-shell - the name of the shell class to use (if required)
-
-debug - sets a debug level available to any module that requests it through the Plugin instance
-
-saveid - number to save instance to object database with
-
-libdir - override for configured library directory
-
-help - prints help
-
-=cut
-
-
-=item initialize()
-
-Sets up NOCpulse::Object::SystemIni(), validates Plugin switches, loads the
-probe class and instantiates it, loads the shell class and instantiates it if the probe
-class reports needsCommandShell, validates the probe instance and shell instance switches.
-
-=cut
-
-
-=item run()
-
-Sends the probe a "run" message, then calls exit()
-
-=cut
-
-
-=item runAndDump()
-
-Debugging tool. Sends the probe a "run" message, calls $self->printString for a comprehensive dump of all
-instantiated objects for the run to stdout, then calls exit()
-
-=cut
-
-
-=item pluginStatusMessage()
-
-Constructs a properly formatted status message from the list of messages created
-via calls to addStatusString() (above)
-
-=cut
-
-
-=item exitLevel()
-
-Returns the numeric version of the current named status
-
-=cut
-
-
-=item exit()
-
-Exits in the way by printing pluginStatusMessage() and exiting with exitLevel()
-
-=cut
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/PortableShellProbe.pm b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/PortableShellProbe.pm
deleted file mode 100644
index f7a2327..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/PortableShellProbe.pm
+++ /dev/null
@@ -1,178 +0,0 @@
-
-=head1 NAME
-
-PortableShellProbe - a ShellProbe subclass that provides for operating system dependent execution of command(s)
-
-=head1 DESCRIPTION
-
-PortableShellProbe enhances ShellProbe in that it allows the subclasser to specify different commands
-to be executed depending on operating system, and subsequently provides a mechanism for test
-code to find out what operating system the commands actually ran on.
-
-=head1 REQUIRES
-
-ShellProbe
-
-=cut
-
-package PortableShellProbe;
-use strict;
-use vars qw(@ISA);
-use NOCpulse::PlugFrame::ShellProbe;
-@ISA=qw(ShellProbe);
-
-
-sub registerCommands {
-
-=head1 INSTANCE METHODS
-
-=over 4
-
-=item registerCommands()
-
-Protocol method - you must override it.
-
-Override registerCommands() with a method that makes calls to registerCommand() (see below)
-
-=cut
-
- # You must override this with a method that
- # makes one or more calls to registerCommand('<os>','<command string')
- my $self = shift();
- return 0;
-}
-
-
-# ------------------------- Private stuff below - don't override -------------------------
-
-sub registerCommand {
-
-=item registerCommand(<os>,<commandString>)
-
-Adds <commandString> to the commands hash with a key who's name is <os>.
-
-=cut
-
- my ($self,$os,$commandString) = @_;
- $self->get_commands->{$os} = $commandString;
-}
-
-
-sub initialize {
-
-=item initialize(<plugin>)
-
-Initializes the instance by setting os and stdout to blank strings, commands to an empty
-hash, and calling SUPER::initialize(<plugin>)
-
-=cut
-
- my ($self,$plugin,@params) = @_;
- $self->set_os('');
- $self->set_stdout('');
- $self->set_commands({});
- $self->SUPER::initialize($plugin,@params);
-}
-
-sub instVarDefinitions {
-
-=item instVarDefinitions()
-
-Defines the following:
-
-os - contains the name of the os that the command shell executed it's commands on
-
-stdout - contains the stdout of the commands that got run
-
-commands - a hash who's key is the OS name (according to uname) and whos values are strings containing commands to be executed on that os.
-
-=cut
-
- my $self = shift();
- $self->SUPER::instVarDefinitions;
- $self->addInstVar('os');
- $self->addInstVar('stdout');
- $self->addInstVar('commands');
-}
-
-
-sub setup
-{
-
-=item setup()
-
-Overrides ShellProbe::setup()
-
-Constructs a shell script that detects the operating system on which its run and which
-then executes the commands associated with that os as specified in the commands hash.
-
-Does a bit of in-band relaying of the name of the os using some chicanery (the jist of
-which is: please don't execute anything whos output could contain this string: "PINGELLO-PSP-OS="
-
-You should not override this - instead use registerCommands() (above).
-
-=cut
-
- my $self = shift();
- $self->registerCommands;
- my $command = "PATH=/bin:/usr/bin:/usr/ucb;OS=`uname`\necho PINGELLO-PSP-OS=\$OS\ncase \$OS in\n";
- my $commands = $self->get_commands;
- while (my ($os,$commandString) = each(%$commands)) {
- $command .= "'$os') $commandString;;\n"
- }
- $command .= "esac\n";
- $self->set_probeCommands($command);
-}
-
-
-sub parseStdout {
-
-=item parseStdout()
-
-Strips out the in-band OS detection stuff from stdout and places it in the os instance variable.
-Stores a cleansed version of stdout into the stdout instance variable.
-
-=cut
-
- my $self = shift();
- $self->set_stdout(join("\n",grep(!/^PINGELLO-PSP\-OS=.*$/,split("\n",$self->shell->get_stdout)))."\n");
- my $stdout = $self->shell->get_stdout;
- $stdout =~ /^PINGELLO-PSP\-OS=(.*)$/m;
- my $os = $1;
- $self->set_os($os);
-}
-
-sub stdout {
-
-=item stdout()
-
-Returns the value of the stdout instance variable. If the variable has no data, assumes that
-it must first call parseStdout()
-
-=cut
-
- my $self = shift();
- if (! $self->get_stdout) {
- $self->parseStdout
- }
- return $self->get_stdout;
-}
-
-sub os {
-
-=item os()
-
-Returns the value of the os instance variable. If the variable has no data, assumes that
-it must first call parseStdout()
-
-=cut
-
- my $self = shift();
- if (! $self->get_os) {
- $self->parseStdout;
- }
- return $self->get_os;
-}
-
-
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Probe.pm b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Probe.pm
deleted file mode 100644
index 4cf0714..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/Probe.pm
+++ /dev/null
@@ -1,772 +0,0 @@
-
-package Probe;
-
-use strict;
-
-use NOCpulse::CommandLineApplicationComponent;
-use NOCpulse::Scheduler::Event::PluginEvent;
-use NOCpulse::PlugFrame::ProbeState;
-use NOCpulse::TimeSeriesDatapoint;
-use NOCpulse::TimeSeriesQueue;
-use NOCpulse::Notification;
-use NOCpulse::NotificationQueue;
-use NOCpulse::StateChange;
-use NOCpulse::StateChangeQueue;
-use NOCpulse::Config;
-use NOCpulse::Gritch;
-use Date::Manip;
-use POSIX qw(strftime ceil);
-use Data::Dumper;
-use Time::HiRes qw(gettimeofday tv_interval);
-
-@Probe::ISA=qw(NOCpulse::CommandLineApplicationComponent);
-
-
-sub registerSwitches
-{
- my $self = shift();
- # NOTE: Override this and fill it with calls to
- # $self->registerSwitch(name,spec,required,default,usage)
- # if your module needs switches.
-}
-
-sub run
-{
- my $self = shift();
- # You **must** override this. This is where your probe subclass does it's work,
- # records it's results, and determines it's exit status.
- # $self->recordResult(metricName,objectName,value,[time]);
- # $self->setStatus('OK');
-}
-
-sub instVarDefinitions
-{
- # If you choose to override this, be absolutely certain that
- # you call $self->SUPER::instVarDefinitions from your subclass!
- my $self = shift();
- $self->SUPER::instVarDefinitions;
- $self->addInstVar('plugin');
- $self->addInstVar('memory', undef);
- $self->addInstVar('status');
- $self->addInstVar('statusStrings');
- $self->addInstVar('shellModule');
-}
-
-
-############################ Internal/private stuff below - don't modify or override! #############################
-sub initialize
-{
- # DO NOT OVERRIDE
- my ($self,$plugin,$probeRecord) = @_;
-
- $self->SUPER::initialize;
- $self->set_plugin($plugin);
- $self->set_shellModule($plugin->get_shellModule);
- $self->set_status('UNKNOWN');
- $self->set_statusStrings([]);
- $self->{'timeSeries'} = [];
- if ($probeRecord) {
- $self->addInstVar('probeRecord',$probeRecord);
- }
- return $self;
-}
-
-sub registerMetrics
-{
-}
-
-sub registerMetric {
-}
-
-# DAP Override persistent object per-class logic as all our objects have unique IDs
-
-sub databaseType {
- my $class = shift();
- return Probe->ConfigValue('databaseType');
-}
-
-sub databaseFilename {
- my $class = shift();
- if ($main::ProbeDatabaseFile) {
- my $result = $class->databaseDirectory.'/'.$main::ProbeDatabaseFile.$class->databaseType->fileExtension;
- return $result;
- } else {
- return $class->databaseDirectory.'/Probe'.$class->databaseType->fileExtension;
- }
-}
-
-sub database
-{
- my $class = 'Probe';
-
- if (!defined $class->getClassVar('database')) {
- my $database;
- $database = $class->databaseType->newInitialized($class->databaseFilename);
- $class->setClassVar('database',$database);
- return $database;
- } else {
- return $class->getClassVar('database');
- }
-}
-
-sub instances
-{
- my $class = 'Probe';
-
- if (!defined $class->getClassVar('objects')) {
- $class->setClassVar('objects',{});
- }
- return $class->getClassVar('objects');
-}
-
-################## end Persistent Object overrides ################
-
-sub get_probeRecord {
- my ($self, $id) = @_;
- my $probeRec = $self->get('probeRecord');
- if (! defined($probeRec) && defined($id)) {
- $probeRec = ProbeRecord->Called($id);
- $self->set_probeRecord($probeRec);
- }
- return $probeRec;
-}
-
-sub debugging {
- my $self = shift();
- return $self->get_plugin->switchValue('debug');
-}
-
-sub get_memory
-{
- # Returns a lazily-initialized ProbeState object.
- my $self = shift();
- if (! defined($self->get('memory'))) {
- $self->set_memory(ProbeState->newInitializedNamed($self->get_name));
- }
- return $self->get('memory');
-}
-
-sub persist
-{
- my $self = shift();
-
- # Remove data that need not be stored with the probe.
- $self->set_memory(undef);
- $self->set_plugin(undef);
- $self->set_probeRecord(undef);
-
- return $self->SUPER::persist;
-}
-
-
-sub needsCommandShell
-{
- # DO NOT OVERRIDE
- # If you probe needs a shell, use the ShellProbe class - it has a
- # bunch of shell IO behavior
- my $self = shift();
- return 0;
-}
-
-sub setStatus {
- # DO NOT OVERRIDE
- my $self = shift();
- $self->set_status(shift());
-}
-
-sub recordResult
-{
- # DO NOT OVERRIDE
-
- my $self = shift;
- my $metricPath = shift;
- my $unused = shift;
- my $v = shift;
- my $t = shift || time();
-
- my ($junk, $metricName) = split("->", $metricPath, 2);
-
- $self->dprint(5,'recordResult metric: '.$metricName.' value: '.$v.' time: '.$t, "\n");
-
- if ($self->has_probeRecord) {
- my @oidParts = ($self->get_probeRecord->get_CUSTOMER_ID,
- $self->get_probeRecord->get_RECID,
- $metricName);
- my $oid = join('-', @oidParts);
-
- my $tsdp = NOCpulse::TimeSeriesDatapoint->newInitialized();
- $tsdp->oid($oid);
- $tsdp->t($t);
- $tsdp->v($v);
-
- push @{$self->{'timeSeries'}}, $tsdp;
- } else {
- $self->dprint(5,"recordResult: No probe record, nothing recorded\n");
- }
-}
-
-sub addStatusString
-{
- # DO NOT OVERRIDE
- my ($self,@messages) = @_;
- $self->dprint(5,'Adding status string: '.join(' ',@messages),"\n");
- push(@{$self->get_statusStrings},join(' ',@messages));
-}
-
-sub get_lastNotificationForStatus
-{
- my ($self,$status) = @_;
- return $self->get_memory->get('last'.$status.'Notification');
-}
-
-sub set_lastNotificationForStatus
-{
- my ($self,$status,$value) = @_;
- return $self->get_memory->set('last'.$status.'Notification',$value);
-}
-
-sub prepareNotification
-{
- my $self = shift;
- my $now = shift;
-
- my $notification = NOCpulse::Notification->newInitialized();
-
- $notification->time($now);
- $notification->state($self->get_status);
- $notification->checkCommand($self->get_probeRecord->get_CHECK_COMMAND);
- $notification->commandLongName($self->get_probeRecord->get_command_long_name);
- $notification->clusterId($self->get_plugin->get_cluster->get_id);
- $notification->clusterDesc($self->get_plugin->get_cluster->get_description);
- $notification->customerId($self->get_probeRecord->get_CUSTOMER_ID);
-
- if ( $self->get_probeRecord->get_PROBE_TYPE eq 'ServiceProbe' )
- {
- $notification->type('service');
- $notification->probeId($self->get_probeRecord->get_RECID);
- $notification->probeType($self->get_probeRecord->get_PROBE_TYPE);
- $notification->probeDescription($self->get_probeRecord->get_DESCRIPTION);
- $notification->message($self->statusMessage);
- $notification->hostAddress($self->get_probeRecord->get_hostAddress); # vs ADDRESS ??
- $notification->probeGroupName($self->get_probeRecord->get_command_group_name);
- $notification->physicalLocationName($self->get_probeRecord->get_physical_location_name);
- $notification->osName($self->get_probeRecord->get_os_name);
- $notification->hostName($self->get_probeRecord->get_hostName);
- $notification->hostProbeId($self->get_probeRecord->get_hostRecid);
- }
- elsif ( $self->get_probeRecord->get_PROBE_TYPE eq 'LongLegs' )
- {
- $notification->type('longlegs');
- $notification->probeId($self->get_probeRecord->get_RECID);
- $notification->probeType($self->get_probeRecord->get_PROBE_TYPE);
- $notification->probeDescription($self->get_probeRecord->get_DESCRIPTION);
- $notification->message($self->statusMessage);
- }
- else
- {
- # assert: $self->get_probeRecord->get_PROBE_TYPE eq 'HostProbe'
-
- $notification->type('host');
- $notification->hostAddress($self->get_probeRecord->get_hostAddress);
- $notification->probeGroupName($self->get_probeRecord->get_command_group_name);
- $notification->physicalLocationName($self->get_probeRecord->get_physical_location_name);
- $notification->osName($self->get_probeRecord->get_os_name);
- $notification->hostName($self->get_probeRecord->get_hostName);
- $notification->hostProbeId($self->get_probeRecord->get_hostRecid);
- $notification->probeDescription($self->get_probeRecord->get_DESCRIPTION);
- }
-
- return $notification;
-}
-
-sub distributeNotification
-{
- my $self = shift;
- my $notification = shift;
- my $notificationqueue = shift;
-
- # probeRecord will have three parallel arrays:
- # CONTACT_GROUPS (cg recids)
- # contactGroupNames (cg names)
- # contactGroupCustomers (cg cust ids)
- # All same size, elements line up, so need to iterate by index
-
- my $cgRecids = $self->get_probeRecord->get_CONTACT_GROUPS;
- my $cgNames = $self->get_probeRecord->get_contactGroupNames;
- # my $cgCusts = $self->get_probeRecord->get_contactGroupCustomers;
-
- my $index = 0;
- while ($index < scalar(@$cgRecids))
- {
- my $groupId = $$cgRecids[$index];
- my $groupName = $$cgNames[$index];
- $notification->groupId($groupId);
- $notification->groupName($groupName);
- $notificationqueue->enqueue($notification);
- $index++;
- }
-
- # need to clear groupId and groupName ?
-
- my $queueUrls = $self->get_probeRecord->get_queue_urls;
- my $queueUrl;
- foreach $queueUrl (@$queueUrls)
- {
- $notification->snmp(1);
- $queueUrl =~ /(.*)\:\/\/(.*)/;
- my $snmpPort = $2;
- $notification->snmpPort($snmpPort);
- $notificationqueue->enqueue($notification);
- }
-
-}
-
-
-sub nextRunTime
-{
- my $self = shift();
-
- # This gets called by Plugin::asInitialEvent (and others).
- # The conditional allows for some spreading out of run times
- # for have-never-been-run probes.
-
- if (! $self->get_memory->get_nextRunTime)
- {
- $self->get_memory->set_nextRunTime(time() + ceil(rand($self->get_probeRecord->get_CHECK_INTERVAL * 60)));
- #print "Set randomized start time to ".$self->get_memory->get_nextRunTime."\n";
- }
-
- return $self->get_memory->get_nextRunTime;
-}
-
-sub handleDown
-{
- my $self = shift;
- my $timeNow = shift;
- my $notificationqueue = shift;
-
- $self->get_memory->set_failures($self->get_memory->get_failures + 1);
-
- if ($self->get_memory->get_failures >= $self->get_probeRecord->get_MAX_ATTEMPTS) {
- # I have failed enough so that I need to do notification.
- my $status = $self->get_status;
-
- if (
- ( ( $status eq 'WARN' ) and $self->get_probeRecord->get_NOTIFY_WARNING ) or
- ( ( $status eq 'UNKNOWN' ) and $self->get_probeRecord->get_NOTIFY_UNKNOWN ) or
- ( ( $status eq 'CRITICAL' ) and $self->get_probeRecord->get_NOTIFY_CRITICAL )
- ) {
- if (($self->get_lastNotificationForStatus($status) +
- ($self->get_probeRecord->get_NOTIFICATION_INTERVAL * 60)) <= $timeNow) {
- my $notification = $self->prepareNotification($timeNow);
- $self->distributeNotification($notification, $notificationqueue);
- $self->set_lastNotificationForStatus($status, $timeNow);
- }
- }
- }
-}
-
-sub handleRecover
-{
- my $self = shift;
- my $timeNow = shift;
- my $notificationqueue = shift;
-
- $self->get_memory->set_failures(0);
-
- if ($self->get_probeRecord->get_NOTIFY_RECOVERY) {
- $self->set_lastNotificationForStatus('WARN',0);
- $self->set_lastNotificationForStatus('CRITICAL',0);
- $self->set_lastNotificationForStatus('UNKNOWN',0);
-
- my $notification = $self->prepareNotification($timeNow);
- $self->distributeNotification($notification, $notificationqueue);
- }
-
-}
-
-
-sub get_translatedStatus
-{
- my $self = shift;
-
- my $state = $self->get_status;
- if ($self->get_probeRecord->get_PROBE_TYPE eq 'HostProbe')
- {
- $state = 'UP' if ($state eq 'OK');
- $state = 'DOWN' if ($state eq 'WARN');
- $state = 'DOWN' if ($state eq 'CRITICAL');
- }
- elsif ( $state eq 'WARN' )
- {
- $state = 'WARNING';
- }
-
- return $state;
-}
-
-sub stateHasChanged
-{
- my $self = shift;
-
-
-
- return $self->get_status ne $self->get_memory->get_lastStatus;
-}
-
-sub changeState
-{
- my $self = shift;
- my $timeNow = shift;
- my $statechangequeue = shift;
-
- my $stateChange = NOCpulse::StateChange->newInitialized();
-
- $stateChange->desc($self->statusMessage);
- $stateChange->t($timeNow);
-
- my $probe_id = $self->get_probeRecord->get_RECID;
-
- my $cluster = $self->get_plugin->get_cluster;
-
- if ($self->get_probeRecord->get_PROBE_TYPE eq 'LongLegs') {
- my $cluster_id = $cluster->get_id();
- $stateChange->oid($probe_id.'-'.$cluster_id);
- }
- else {
- $stateChange->oid($probe_id);
- }
-
- my $state = $self->get_translatedStatus();
- $stateChange->state($state);
-
- $self->get_memory->set_lastStatusChange($timeNow);
-
- $statechangequeue->enqueue($stateChange);
-}
-
-sub _run
-{
- # This is the protocol Plugin uses to invoke the probe. It's a wrapper
- # to the user's run() method as we need to take care of some business
- # after the probe is done doing it's probing.
-
- my ($self, $doProbe) = @_;
-
- $self->dprint(9,"entering _run\n");
-
- my $startTime = [gettimeofday];
- my ($scheduledRunTime,$latency);
- if ($self->has_probeRecord) {
- $scheduledRunTime = $self->get_memory->get_nextRunTime || $startTime->[0];
- $latency = $startTime->[0] - $scheduledRunTime;
- $latency = 0 if ($latency < 0);
- # Save this stuff in case we get killed during run() so we
- # don't throw latency etc all akilter.
- $self->get_memory->set_lastExecTime($startTime->[0]);
- $self->get_memory->set_lastLatency($latency);
- $self->get_memory->persist; # Possible source of delays/cpu loading/io loading, etc - keep eyes open
- }
- $self->set_status('UNKNOWN');
- my $execErr;
-
- if ( $doProbe ) {
- eval {
- $self->run();
- };
- $execErr = $@;
- if ($execErr) {
- # Code failure of some kind. Replace whatever the status string was with
- # the "internal problem" message, and print the full error to the log.
- $self->setStatus('UNKNOWN');
- $self->set_statusStrings([NOCpulse::Scheduler::Event::PluginEvent::CodeFailureMessage()]);
- print STDERR 'Error executing probe '.(ref $self).': '.$execErr;
- }
- }
- if ( $self->has_probeRecord )
- {
- # I'm running as a thawed instance (implies satellite or interactive --saveid)
-
- $self->dprint(4, "constructing queue objects\n");
-
- my $cfg = $self->get_plugin()->get_npconfig();
- my $debug = $self->get_plugin()->debugObject();
- my $gritcher = new NOCpulse::Gritch($cfg->get('queues', 'gritchdb'));
-
- my $notificationqueue = NOCpulse::NotificationQueue->new( Debug => $debug, Config => $cfg, Gritcher => $gritcher );
-
- if ($execErr) {
- # Gritch about the code error.
- my $codeGritcher = new NOCpulse::Gritch($cfg->get('satellite', 'gritchdb'));
- $codeGritcher->recipient($notificationqueue);
- my $truncatedStdErr = substr($execErr, 0, 1400);
- my $recid = $self->get_probeRecord->get_RECID;
- $codeGritcher->gritch("Probe ".ref($self)." code failed: $truncatedStdErr",
- "Probe $recid code caused a Perl error: $truncatedStdErr\n");
- }
-
- $self->dprint(9,"entering notif decision: ",
- ' status = ',$self->get_status,
- ' type = ',$self->get_probeRecord->get_PROBE_TYPE,
- ' lastStatus = ',$self->get_memory->get_lastStatus,
- ' failures = ',$self->get_memory->get_failures,
- ' max attempts = ',
- $self->get_probeRecord->get_MAX_ATTEMPTS, "\n");
-
- my $timeNow = time();
- my $nextRunTime;
-
- if ($self->get_status ne 'OK')
- {
- $nextRunTime = $timeNow + ($self->get_probeRecord->get_RETRY_INTERVAL * 60);
- $self->handleDown($timeNow, $notificationqueue);
- }
- elsif ( ( defined $self->get_memory->get_lastStatus ) and
- ( $self->get_memory->get_lastStatus ne 'OK' ) )
- {
- $nextRunTime = $timeNow + ($self->get_probeRecord->get_CHECK_INTERVAL * 60);
- $self->handleRecover($timeNow, $notificationqueue);
- }
- else
- {
- $nextRunTime = $timeNow + ($self->get_probeRecord->get_CHECK_INTERVAL * 60);
- }
-
- if ( $self->stateHasChanged() )
- {
- my $statechangequeue = NOCpulse::StateChangeQueue->new( Debug => $debug, Config => $cfg, Gritcher => $gritcher );
- $self->changeState($timeNow, $statechangequeue);
- }
-
- if ($self->get_plugin->configValue('enqueueMetrics') eq 'Y')
- {
- my $timeseriesqueue = NOCpulse::TimeSeriesQueue->new( Debug => $debug, Config => $cfg, Gritcher => $gritcher );
- $timeseriesqueue->enqueue(@{$self->{'timeSeries'}});
- }
-
- my $stopTime = [gettimeofday];
- my $interval = tv_interval($startTime, $stopTime);
-
- # Save current state for next run.
- $self->get_memory->set_lastExecutionTime($interval);
- $self->get_memory->set_lastStatus($self->get_status);
- $self->get_memory->set_lastStatusMessage($self->statusMessage);
- $self->get_memory->set_nextRunTime($nextRunTime);
- $self->get_memory->set_lastTranslatedStatus($self->get_translatedStatus);
-
- # Make sure we save our own state...
- $self->get_memory->set_readOnly(0);
- $self->get_memory->persist();
-
- $self->dprint(9,"leaving _run: ",
- ' status = ',$self->get_status,
- ' type = ',$self->get_probeRecord->get_PROBE_TYPE,
- ' lastStatus = ',$self->get_memory->get_lastStatus,
- ' failures = ',$self->get_memory->get_failures,
- ' max attempts = ',$self->get_probeRecord->get_MAX_ATTEMPTS, "\n");
-
- }
-}
-
-sub handleTimeout
-{
- my $self = shift();
- $self->set_status('UNKNOWN');
- $self->addStatusString('Probe timed out');
- return $self->_run(0,[]);
-}
-
-sub statusMessage
-{
- my $self = shift();
- my $output = '';
- if (scalar(@{$self->get_statusStrings})) {
- $output = join(' ', @{$self->get_statusStrings});
- # Escape the eol control characters so that they can be handled in HTML.
- $output =~ s/\r/\\r/g;
- $output =~ s/\n/\\n/g;
- $output .= "\n";
- }
- return $output;
-}
-
-sub dprint
-{
- my ($self,$level,@stuff) = @_;
- $self->SUPER::dprint($level,ref($self).'('.$self->get_name.") ",@stuff);
-}
-
-sub printUsageNotes {
- my ($self) = @_;
- if ($self->has_probeRecord) {
- $self->print("\nProbe record summary:\n\n");
- $self->print($self->get_probeRecord->description);
- $self->print("\n");
- $self->print("Probe memory:\n\n");
- $self->print($self->get_memory->asString);
- #$self->print("*"x80,"\n");
- }
-}
-
-1;
-
-__END__
-=head1 NAME
-
-Probe - an abstract superclass for creating probes within the NOCpulse PlugFrame framework.
-
-
-=head1 DESCRIPTION
-
-A probe is a piece of software that measures and reports on some
-aspect of a service or resource, optionally triggering state change
-events based on thresholds, and optionally returning metrics for use
-in trend reporting.
-
-In addition to the things that CommandLineApplicationComponent provides, the Probe class
-provides facilities for:
-
- * interacting with the driver layer (Plugin) in terms of status messages and exit levels.
-
- * a protocol for the execution of the probe logic itself
-
- * access to a mechanism that allows for transparent persistence of otherwise transient state data
-
-
-=head1 REQUIRES
-
-CommandLineApplicationComponent, ProbeState
-
-=cut
-
-=head1 INSTANCE METHODS
-
-=over 4
-
-=item registerSwitches()
-
-Protocol method - you must override it.
-
-Override registerSwitches() with a method that makes calls to
-addSwitch() (see CommandLineApplicationComponent)
-
-=cut
-
-=item run()
-
-Protocol method - you must override it.
-
-Override run() with a method that does your probe/test/record logic. Usually this will mean
-that you will be making calls to addMessage(), setStatus(), and recordResult()
-
-=cut
-
-
-=item instVarDefinitions()
-
-Defines the following:
-
-plugin - holds a pointer to the Plugin instance that created the probe object
-
-memory - holds a pointer to a ProbeState instance (with which you store and retrieve otherwise transient state)
-
-You may override this if you need to define additional instance variables. If you do,
-be sure that your method follows this pattern:
-
-{
- my $self = shift()
- $self->SUPER::instVarDefinitions()
- $self->addInstVar('nameOfIt');
-}
-
-=cut
-
-=item initialize(<plugin>,<@params>)
-
-Calls SUPER::initialize(), sets the plugin property to the plugin instance passed in,
-sets the memory property to a new (or un-serialized) instance of a ProbeState object,
-returns self. Other params may be passed as well - be sure to forward them to the SUPER.
-
-If you need to override this method, be sure it follows this pattern:
-
-{
- my ($self,$plugin,@params) = @_;
- $self->SUPER::initialize($plugin,@params);
- <your code>;
- return $self;
-}
-
-=cut
-
-
-=item registerMetrics()
-
-Deprecated method, never called.
-
-=cut
-
-
-=item registerMetric(<metricName>)
-
-Deprecated method that now has no effect, and eventually will be removed. It formerly
-registered a metric as being a part of this probe.
-
-=cut
-
-
-=item database()
-
-Returns the databaseType instance for this class
-
-=cut
-
-
-=item instances()
-
-Returns a hash of all the instances of the class B<currently in memory>
-
-=cut
-
-
-=item needsCommandShell()
-
-Returns zero. ShellProbe based derivatives return 1. You will probably never need to override
-this or access it.
-
-=cut
-
-
-=item setStatus(<statusName>)
-
-Tells the plugin to set up for exiting with the given statusName. Status names are listed in
-the Plugin class documentation.
-
-=cut
-
-
-=item recordResult(<metricName>,<objectName>,<value>,[<time>])
-
-Sends <value> into the metric named <metricName> optionally setting
-the time to <time>.
-
-NOTE: <objectName> is kruft - please supply undef and pay no attention to
-the man behind the curtain :)
-
-=cut
-
-
-=item addStatusString(<string>)
-
-Adds the string you provide to the list of status strings that the plugin will return as a
-status string.
-
-=cut
-
-
-=item statusMessage()
-
-Constructs a properly formatted status message from the list of messages created
-via calls to addStatusString() (above)
-
-=cut
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeGenerator.pm b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeGenerator.pm
deleted file mode 100644
index 387c841..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeGenerator.pm
+++ /dev/null
@@ -1,44 +0,0 @@
-package ProbeGenerator;
-use strict;
-use NOCpulse::Object;
-use NOCpulse::DBMObjectRepository;
-use NOCpulse::PlugFrame::Plugin;
-use NOCpulse::CommandLineApplicationComponent
-use MemoryPlugin;
-use vars qw(@ISA);
-@ISA=qw(NOCpulse::Object);
-
-DBMObjectRepository->CacheHandles(1);
-
-sub instVarDefinitions {
- my $self = shift();
- $self->SUPER::instVarDefinitions;
- $self->addInstVar('probeRecord');
- $self->addInstVar('probe');
-}
-
-sub initialize {
- my ($self,$probeRecord) = @_;
- $self->set_probeRecord($probeRecord);
- return $self;
-}
-
-sub createProbe {
- my ($self) = @_;
- #print $self->get_probeRecord->printString;
- my $recid = $self->get_probeRecord->get_RECID;
- my $args = $self->get_probeRecord->get_parsedCommandLine;
- my @cmdline = ();
- while (my ($param, $value) = each %$args) {
- push(@cmdline, '--'.$param.'='.$value);
- }
- push(@cmdline, "--saveid=$recid", '--xmlUsage');
- @ARGV = @cmdline;
- #print "\nARGV=".join(' ',@ARGV)."\n";
- my $result = MemoryPlugin->newInitialized($self->get_probeRecord);
- $self->set_probe($result);
- NOCpulse::CommandLineApplicationComponent::FreeAllInstances;
- return $result;
-}
-
-1
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeState.pm b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeState.pm
deleted file mode 100644
index 1078389..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/ProbeState.pm
+++ /dev/null
@@ -1,92 +0,0 @@
-
-=head1 NAME
-
-ProbeState - a class that helps provide transparent persistence of transient probe state
-
-
-=head1 DESCRIPTION
-
-ProbeState provides a mechanism for easily saving and restoring probe state info. It
-uses the probe->name() method as a key to the data it stores, but is otherwise mostly
-a slight enhancement to PersistentObject (wherein get just returns undef if it is asked to
-return something it does not know about).
-
-=head1 REQUIRES
-
-Perl 5.004, NOCpulse::PersistentObject
-
-=cut
-
-package ProbeState;
-use strict;
-use vars qw(@ISA);
-use NOCpulse::PersistentObject;
-@ISA=qw(NOCpulse::PersistentObject);
-
-sub AllInstancesReadOnly
-{
- my ($class, @ids) = @_;
- $class = ref($class)||$class;
- # Fetch status hash from database
- if (@ids) {
- foreach my $id (@ids) {
- $class->loadFromDatabase($id);
- }
- } else {
- $class->loadFromDatabase;
- }
- my $status = ProbeState->instances;
- my @values = values(%$status);
- map { $_->set_readOnly(1) if $_ } @values;
- return $status,\@values;
-}
-
-sub instVarDefinitions
-{
- my ($self,@params) = @_;
- $self->SUPER::instVarDefinitions(@params);
- $self->addInstVar('readOnly',0);
-}
-
-sub newInitializedNamed {
- my ($class,$name) = @_;
- my $state = $class->loadFromDatabase($name);
- if ($state) {
- return $state;
- } else {
- return $class->SUPER::newInitializedNamed($name);
- }
-}
-
-
-sub get {
- my ($self,$varname) = @_;
- if (exists($self->{$varname})) {
- return $self->{$varname}
- } else {
- return undef
- }
-}
-
-sub persist
-{
- my $self = shift();
- if (! $self->get_readOnly) {
- $self->SUPER::persist;
- }
-}
-
-sub has
-{
- return 1
-}
-
-sub DESTROY {
- my $self = shift();
- if ($self->databaseDirectory ne '/dev/null') {
- # Only save if there's somewhere to save to -- this avoids saving
- # meaningless state from command-line execution without a probe ID.
- $self->persist;
- }
- $self->SUPER::DESTROY;
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/README b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/README
deleted file mode 100644
index 0d03297..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/README
+++ /dev/null
@@ -1,24 +0,0 @@
-NOCpulse/PlugFrame/Plugin
-=========================
-
-NOCpulse-PlugFrame provides a framework for writing NOCpulse-compliant
-satellite probes in Perl
-
-INSTALLATION
-
-To install this module type the following:
-
- perl Makefile.PL
- make
- make test
- make install
-
-DEPENDENCIES
-
-This module requires these other modules and libraries:
-
- NOCpulse::Object NOCpulse::CLAC np-config MessageQueue
-
-COPYRIGHT AND LICENCE
-
-Copyright (c) 2000-2003 Red Hat, Inc. All rights reserved.
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/ShellProbe.pm b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/ShellProbe.pm
deleted file mode 100644
index 00beccd..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/ShellProbe.pm
+++ /dev/null
@@ -1,238 +0,0 @@
-
-=head1 NAME
-
-ShellProbe - An elaboration on Probe that provides probe logic with access to a command shell
-
-=head1 DESCRIPTION
-
-ShellProbe elaborates on Probe in that probes derived from it enjoy access to a command shell
-without having to worry about the mechanics of said access. Command shell access via this
-class gives the subclasser free timing and timeout mechanisms.
-
-Note that with this subclass you will not be overriding the run() method from Probe - instead
-see setup() and testResults()
-
-=head1 REQUIRES
-
-Probe, Time::HiRes
-
-=cut
-
-package ShellProbe;
-use NOCpulse::PlugFrame::Probe;
-use Time::HiRes qw(gettimeofday tv_interval);
-
-@ISA=qw(Probe);
-
-sub setup
-{
-
-=head1 INSTANCE METHODS
-
-=over 4
-
-=item setup()
-
-Protocol method - you must override it.
-
-Override setup() with a method that makes a call to set_probeCommands() (see below).
-
-=cut
-
- # You *must* override this - at this point you should set up the shell
- # appropriately for execution.
- my $self = shift();
- return 0;
-}
-
-sub testResults {
-
-=item testResults()
-
-Protocol method - you must override it.
-
-Override testResults() with a method that tests the results of the execution of the
-shell commands specified in setup(). You can get access to the stderr, stdout, and exitLevel
-of your command(s) by calling the methods of the same name (see below).
-
-=cut
-
- # You must override this and carry out any analysis you need to on the shell
- # output/exit status etc. This is the stuff you'd normally do in the run
- # method for a non-shell plugin.
- my $self = shift();
- return 0;
-}
-
-
-sub initialize {
-
-=item initialize(<plugin>)
-
-Initializes the probe instance by calling SUPER::initialize(<plugin>), adding a
-switch called 'timeout' with a default of 15 seconds, and setting runTime to zero.
-
-=cut
-
- my ($self,$plugin,@params) = @_;
- $self->SUPER::initialize($plugin,@params);
- $self->addSwitch('timeout','=i',0,15,'Number of seconds before this probe gives up');
- $self->set_runTime(0);
- return $self;
-}
-
-sub instVarDefinitions {
-
-=item instVarDefinitions()
-
-Defines the runTime instance variable which is used to hold the amount of time it took for
-your command(s) to run.
-
-=cut
-
- my $self = shift();
- $self->addInstVar('runTime');
- $self->SUPER::instVarDefinitions;
-}
-
-
-
-sub shell
-{
-
-=item shell()
-
-Returns the an instance of a subclass of CommandShell as instantiated by the plugin. Run
-uses this to execute the commands specified by the subclasser's call to set_ProbeCommands()
-
-=cut
-
- my $self = shift();
- return $self->get_shellModule;
-}
-
-sub needsCommandShell
-{
-
-=item needsCommandShell()
-
-Returns one. Probe based derivatives return 0 (unless of course they subtend this class).
-You will probably never need to override this or access it.
-
-=cut
-
- my $self = shift();
- return 1;
-}
-
-
-sub run
-{
-
-=item run()
-
-Overrides Probe::run(). This method uses the CommandShell subclass instance returned by
-shell() to execute the command(s) specified in the subclasser's call to set_probeCommands().
-
-The execution of the commands is wrapped by an alarm whos timeout is specified by the
-value of the timeout switch (see above).
-
-Additionally, the amount of time it took (in milliseconds) to execute the command is stored
-in the runTime instance variable.
-
-=cut
-
- my $self = shift();
- $self->setup;
- my $start = [gettimeofday];
- $self->shell->set_timeout($self->get_timeout);
- $self->shell->execute;
- my $end = [gettimeofday];
- if ($self->shell->get_failed) {
- $self->handleShellError($self->shell->get_stderr);
- return undef;
- } else {
- my $elapsed = tv_interval($start,$end);
- $self->set_runTime($elapsed);
- return $self->testResults;
- }
-}
-
-
-sub handleShellError
-{
-
-=item handleShellError(<message>)
-
-This method provides default shell error handling. The error message (if any) is
-passed as a parameter. The default behavior is to setStatus('UNKNOWN') and
-to addStatusString(<message>)
-
-=cut
-
- my ($self,$message) = @_;
- $self->setStatus('UNKNOWN');
- $self->addStatusString($message);
-}
-
-sub stdout
-{
-
-=item stdout()
-
-Returns stdout retained by the CommandShell subclass instance subsequent to execution of
-probeCommands.
-
-=cut
-
- return shift()->shell->get_stdout;
-}
-sub stderr
-{
-
-=item stderr()
-
-Returns stderr retained by the CommandShell subclass instance subsequent to execution of
-probeCommands.
-
-=cut
-
- return shift()->shell->get_stderr;
-}
-sub exitLevel
-{
-
-=item stdout()
-
-Returns exit level retained by the CommandShell subclass instance subsequent to execution of
-probeCommands.
-
-=cut
-
- return shift()->shell->get_exit;
-}
-
-sub set_probeCommands
-{
-
-=item set_probeCommands(<@commands>)
-
-Sets the CommandShell subclass' probeCommands to those you pass in. Usually a single string
-(which can contain multiple lines e.g. a shell script) is sufficient.
-
-=cut
-
- shift()->shell->set_probeCommands(@_);
-}
-
-sub set_probeSwitches
-{
-
-=item set_probeSwitches()
-
-Deprecated - don't use.
-
-=cut
-
- shift()->shell->set_probeSwitches(@_);
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/test.pl b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/test.pl
deleted file mode 100644
index 40d14d3..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/test.pl
+++ /dev/null
@@ -1,23 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use Test;
-BEGIN { plan tests => 1 };
-use NOCpulse::PlugFrame::Metric;
-use NOCpulse::PlugFrame::Plugin;
-use NOCpulse::PlugFrame::PortableShellProbe;
-use NOCpulse::PlugFrame::ProbeGenerator;
-use NOCpulse::PlugFrame::Probe;
-use NOCpulse::PlugFrame::ProbeState;
-use NOCpulse::PlugFrame::ShellProbe;
-ok(1); # If we made it this far, we're ok
-
-#########################
-
-# Insert your test code below, the Test module is use()ed here so read
-# its man page ( perldoc Test ) for help writing this test script.
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/TestSwitches.pm b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/TestSwitches.pm
deleted file mode 100644
index 3867a6d..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/TestSwitches.pm
+++ /dev/null
@@ -1,111 +0,0 @@
-use strict;
-use Test qw(ok);
-use NOCpulse::PlugFrame::CommandLineApplicationComponent;
-
-package TestSwitches;
-
-@TestSwitches::ISA=qw(NOCpulse::PlugFrame::CommandLineApplicationComponent);
-
-my %DEFAULT = { RequiredString => 'foo',
- RequiredInteger => '100',
- RequiredFloat => '199.8'
- };
-my @NAMES = ('RequiredString', 'OptionalInteger',
- 'RequiredInteger', 'OptionalString',
- 'RequiredFloat', 'OptionalFloat');
-
-sub registerSwitches
-{
- my $self = shift();
- $self->SUPER::registerSwitches; # good practice
- my $i = 0;
- $self->addSwitch($NAMES[$i], '=s', 1, $DEFAULT{$NAMES[$i++]}, 'Required string');
- $self->addSwitch($NAMES[$i++], ':i', 0, '50', 'Optional integer');
- $self->addSwitch($NAMES[$i], '=i', 1, $DEFAULT{$NAMES[$i++]}, 'Required integer');
- $self->addSwitch($NAMES[$i++], ':s', 0, 'bar', 'Optional string');
- $self->addSwitch($NAMES[$i], '=f', 1, $DEFAULT{$NAMES[$i++]}, 'Required float');
- $self->addSwitch($NAMES[$i++], ':f', 0, '59.8', 'Optional float');
-}
-
-my $self;
-
-sub testValid {
- my $outcome = shift;
- my $descr = shift;
- @ARGV = @_;
- $self = TestSwitches->newInitialized;
- Test::ok($self->commandLineIsValid, $outcome, $descr);
- NOCpulse::PlugFrame::CommandLineApplicationComponent::FreeAllInstances;
-}
-
-sub argsValid {
- testValid(1, @_);
-}
-
-sub argsInvalid {
- testValid(0, @_);
-}
-
-sub argOK {
- my ($self, $argName, $descr) = @_;
- Test::ok($self->switch($argName)->get_isMissing, 0, "$descr: Arg $argName missing");
- Test::ok($self->switch($argName)->get_isWrongType, 0, "$descr: Arg $argName has the wrong type");
-}
-
-sub argMissing {
- my ($self, $argName, $descr) = @_;
- Test::ok($self->switch($argName)->get_isMissing, 1, "$descr: Arg $argName not missing");
-}
-
-sub argWrongType {
- my ($self, $argName, $descr) = @_;
- Test::ok($self->switch($argName)->get_isWrongType, 1,
- "$descr: Arg $argName does not have the wrong type");
-}
-
-sub run {
- # Required strings and type checking
- my $test = 'All required args present';
- argsValid($test, '--RequiredString=abc', '--RequiredInteger=123', '--RequiredFloat=456.78');
- $self->argOK('RequiredString', $test);
- $self->argOK('RequiredInteger', $test);
- $self->argOK('RequiredFloat', $test);
-
- $test = 'No args';
- argsInvalid($test, '');
- $self->argMissing('RequiredString', $test);
- $self->argMissing('RequiredInteger', $test);
- $self->argMissing('RequiredFloat', $test);
-
- $test = 'Single arg';
- argsInvalid($test, '--RequiredString=abc');
- $self->argOK('RequiredString', $test);
- $self->argMissing('RequiredInteger', $test);
- $self->argMissing('RequiredFloat', $test);
-
- $test = 'String for integer switch';
- argsInvalid($test, '--RequiredString=abc', '--RequiredInteger=asdf', '--RequiredFloat=456.78');
- $self->argOK('RequiredString', $test);
- $self->argWrongType('RequiredInteger', $test);
- $self->argOK('RequiredFloat', $test);
-
- $test = 'Float for integer switch';
- argsInvalid($test, '--RequiredString=abc', '--RequiredInteger=123.45', '--RequiredFloat=456.78');
- $self->argOK('RequiredString', $test);
- $self->argWrongType('RequiredInteger', $test);
- $self->argOK('RequiredFloat', $test);
-
- $test = 'String for float switch';
- argsInvalid($test, '--RequiredString=abc', '--RequiredInteger=123', '--RequiredFloat=asdf');
- $self->argOK('RequiredString', $test);
- $self->argOK('RequiredInteger', $test);
- $self->argWrongType('RequiredFloat', $test);
-
- $test = 'Embedded spaces for float switch';
- argsInvalid($test, '--RequiredString=abc', '--RequiredInteger=123', '--RequiredFloat="12 34"');
- $self->argOK('RequiredString', $test);
- $self->argOK('RequiredInteger', $test);
- $self->argWrongType('RequiredFloat', $test);
-}
-
-1
diff --git a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/run.pl b/monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/run.pl
deleted file mode 100644
index 9e7c95d..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/PlugFrame/test/run.pl
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use Test qw(plan);
-use TestSwitches;
-
-#
-# Driver for plugin framework tests. Output of a successful run has
-# the single line "1..1".
-#
-BEGIN { Test::plan tests => 1 }
-
-# Only show problems from tests, not successes.
-sub filter {
- return if my $pid = open(STDOUT, "|-");
- die "Can't fork: $!" unless defined $pid;
- $| = 1;
- while (<STDIN>) {
- print if $_ !~ /^ok [0-9]*/;
- }
- exit;
-}
-
-filter();
-
-TestSwitches->run;
-
-exit;
diff --git a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/BUILD b/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/BUILD
deleted file mode 100644
index 82a6732..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/BUILD
+++ /dev/null
@@ -1,50 +0,0 @@
-# Macros
-
-%define cvs_package PerlModules/NP/ReleaseDB
-
-
-# Package specific stuff
-Name: NOCpulse-ReleaseDB
-Version: 1.15.0
-Release: 1
-Packager: Dave Faraldo <dfaraldo(a)nocpulse.com>
-Summary: Perl debug output package
-Source: NOCpulse-ReleaseDB-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Requires: perl >= 5.00500 NOCpulse-Probe np-config NOCpulse-Debug
-Provides: NOCpulse::ReleaseDB
-Group: unsorted
-Copyright: NOCpulse (c) 2000
-Vendor: NOCpulse
-Prefix: %{_our_prefix}
-Buildroot: %{_tmppath}/%cvs_package
-
-%description
-
-Provides an API for generating varying levels of debugging output
-on various output streams.
-
-%prep
-%entirely_abstract_build_step
-
-%build
-echo "Nothing to build"
-
-%install
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-%find_perl_installsitelib
-mkdir -p $RPM_BUILD_ROOT$installsitelib/NOCpulse
-
-
-
-install -o root -g root -m 444 ReleaseDB.pm $RPM_BUILD_ROOT$installsitelib/NOCpulse/ReleaseDB.pm
-install -o root -g root -m 444 test/TestRelease.pm $RPM_BUILD_ROOT$installsitelib/NOCpulse/test
-%make_file_list
-%point_scripts_to_correct_perl
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-
-%clean
-%abstract_clean_script
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/ReleaseDB.pm b/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/ReleaseDB.pm
deleted file mode 100644
index 5236d48..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/ReleaseDB.pm
+++ /dev/null
@@ -1,1513 +0,0 @@
-package NOCpulse::ReleaseDB;
-
-use strict;
-use Data::Dumper;
-use Error qw(:try);
-use NOCpulse::Config;
-use NOCpulse::Probe::DataSource::AbstractDatabase qw(:constants);
-use NOCpulse::Probe::DataSource::Oracle;
-use NOCpulse::Probe::Error;
-
-use base qw(NOCpulse::Probe::DataSource::Oracle);
-
-use vars qw($VERSION);
-$VERSION = (split(/\s+/,
- q$Id: ReleaseDB.pm,v 1.32 2003-02-21 21:32:33 cvs Exp $,
- 4))[2];
-
-my $cfg = new NOCpulse::Config;
-
-my %INIT_ARGS = (
- ORACLE_HOME => $cfg->get('oracle', 'ora_home'),
- ora_port => $cfg->get('oracle', 'ora_port'),
- ora_host => $cfg->get('release_db', 'host'),
- ora_sid => $cfg->get('release_db', 'name'),
- ora_user => $cfg->get('release_db', 'username'),
- ora_password => $cfg->get('release_db', 'password'),
- );
-
-
-# Constants
-use constant MCLASS => 'MacroComponent';
-use constant DBRANCH => 'main';
-
-
-# Global variable initialization
-use vars qw(%DETAIL);
-&init_details();
-
-
-##########
-sub init {
-##########
- my $self = shift;
- my %args = (%INIT_ARGS, @_);
-
- $self->SUPER::init(%args);
-
- return $self;
-}
-
-
-
-
-
-###################
-# RECORD CREATION #
-###################
-
-sub create_component { shift->_create('COMPONENT', @_) }
-sub create_component_class { shift->_create('COMPONENT_CLASS', @_) }
-sub create_release { shift->_create('RELEASE', @_) }
-
-sub create_release_component_version
- { shift->_create('RELEASE_COMPONENT_VERSION', @_) }
-
-sub create_component_version_dependency
- { shift->_create('COMPONENT_VERSION_DEPENDENCY', @_) }
-
-
-# Special handling
-sub create_component_version {
- my $self = shift;
- my %bindvars = @_;
-
- $bindvars{'SORT_STRING'} = $self->ver2str($bindvars{'COMPONENT_VERSION'});
-
- $self->_create('COMPONENT_VERSION', %bindvars);
-}
-
-
-# Special handling
-sub create_box {
- my $self = shift;
- my %bindvars = @_;
-
- # Override -- MACRO_CLASS *must* be MCLASS
- $bindvars{'MACRO_CLASS'} = MCLASS;
-
- $self->_create('BOX', %bindvars);
-
-}
-
-sub create_macro_component {
- my $self = shift;
- my %bindvars = @_;
-
- # Override -- MACRO_CLASS *must* be MCLASS
- $bindvars{'MACRO_CLASS'} = MCLASS;
-
- $self->_create('MACRO_COMPONENT', %bindvars);
-
-}
-
-
-
-
-
-
-#################################
-# SINGLE-TABLE RECORD SELECTION #
-#################################
-
-# Single record selection
-sub select_box { shift->_select_record('BOX', @_) }
-sub select_component { shift->_select_record('COMPONENT', @_) }
-sub select_component_class { shift->_select_record('COMPONENT_CLASS', @_) }
-sub select_component_version { shift->_select_record('COMPONENT_VERSION', @_) }
-sub select_macro_component { shift->_select_record('MACRO_COMPONENT', @_) }
-sub select_release { shift->_select_record('RELEASE', @_) }
-sub select_screen { shift->_select_record('SCREEN', @_) }
-sub select_component_version_dependency
- { shift->_select_record('COMPONENT_VERSION_DEPENDENCY', @_) }
-sub select_release_component_version
- { shift->_select_record('RELEASE_COMPONENT_VERSION', @_) }
-
-
-
-# Multiple record selection
-sub select_boxes { shift->_select_records('BOX', @_) }
-sub select_components { shift->_select_records('COMPONENT', @_) }
-sub select_component_classes { shift->_select_records('COMPONENT_CLASS', @_) }
-sub select_component_versions{ shift->_select_records('COMPONENT_VERSION', @_) }
-sub select_macro_components { shift->_select_records('MACRO_COMPONENT', @_) }
-sub select_releases { shift->_select_records('RELEASE', @_) }
-sub select_screens { shift->_select_records('SCREEN', @_) }
-sub select_component_version_dependencies
- { shift->_select_records('COMPONENT_VERSION_DEPENDENCY', @_) }
-sub select_release_component_versions
- { shift->_select_records('RELEASE_COMPONENT_VERSION', @_) }
-
-
-
-# Complex selection
-
-##################
-sub expand_macro {
-##################
- my $self = shift;
- my %args = @_;
- my @bindvals;
-
- $self->_check_reqs(['MACRO_NAME'], \%args);
-
- my $sql = <<EOSQL;
- SELECT component_class, component_name
- FROM macro_component
- WHERE macro_class = ?
- AND macro_name = ?
-EOSQL
- push(@bindvals, MCLASS, $args{'MACRO_NAME'});
-
- my @components;
- my $rv = $self->execute($sql, 'MACRO_COMPONENT', FETCH_ARRAYREF, @bindvals);
- push(@components, @$rv);
-
- if ($args{'RECURSIVE'}) {
-
- my @macros = grep($_->{'COMPONENT_CLASS'} eq MCLASS, @components);
-
- foreach my $macro (@macros) {
- my $rv = $self->expand_macro(
- MACRO_NAME => $macro->{'COMPONENT_NAME'},
- RECURSIVE => 1,
- );
- push(@components, @$rv);
- }
-
- }
-
- if ($args{'NO_MACRO'}) {
-
- @components = grep($_->{'COMPONENT_CLASS'} ne MCLASS, @components);
-
- } elsif ($args{'MACRO_ONLY'}) {
-
- @components = grep($_->{'COMPONENT_CLASS'} eq MCLASS, @components);
-
- }
-
- return \@components;
-
-}
-
-###############################
-sub select_all_cvs_paths {
-###############################
- my $self = shift;
- my @bindvals;
- my $sql = <<EOSQL;
- SELECT UNIQUE CVS_PATH
- FROM COMPONENT
- WHERE CVS_PATH IS NOT NULL
- AND NAME IN (
- SELECT UNIQUE COMPONENT_NAME
- FROM MACRO_COMPONENT
- WHERE COMPONENT_NAME IS NOT NULL
- )
-EOSQL
-
- my $arryref = $self->execute($sql,
- [qw(COMPONENT)],
- FETCH_ARRAYREF, @bindvals);
- my @result = map { $_->{'CVS_PATH'} } @$arryref;
- return \@result;
-}
-
-###############################
-sub select_release_components {
-###############################
- my $self = shift;
- my %args = @_;
- my @bindvals;
-
- my($pk) = $self->_details('RELEASE', 'pk');
-
- $self->_check_reqs($pk, \%args);
-
- my($wherephrase, $bindvals) = $self->_wherephrase(\%args);
-
- my $sql = <<EOSQL;
- SELECT BOX_TYPE, BOX_NAME, VERSION, RELEASE_NUMBER,
- rcv.COMPONENT_CLASS as COMPONENT_CLASS,
- rcv.COMPONENT_NAME as COMPONENT_NAME,
- rcv.COMPONENT_VERSION as COMPONENT_VERSION,
- rcv.CVS_BRANCH as CVS_BRANCH,
- SORT_STRING, INSTALL_SWITCHES, PACKAGE_FILENAME,
- BUILD_DATE, BUILD_USER
- FROM component_version cv, release_component_version rcv
- WHERE $wherephrase
- AND rcv.COMPONENT_CLASS = cv.COMPONENT_CLASS
- AND rcv.COMPONENT_NAME = cv.COMPONENT_NAME
- AND rcv.COMPONENT_VERSION = cv.COMPONENT_VERSION
- AND rcv.CVS_BRANCH = cv.CVS_BRANCH
-EOSQL
-
- return $self->execute($sql,
- [qw(COMPONENT_VERSION RELEASE_COMPONENT_VERSION)],
- FETCH_ARRAYREF, @$bindvals);
-
-}
-
-
-######################################
-sub select_current_component_version {
-######################################
- my $self = shift;
- my %args = @_;
-
- $args{'CVS_BRANCH'} ||= DBRANCH;
-
- my($wherephrase, $bindvals) = $self->_wherephrase(\%args);
-
- my $sql = <<EOSQL;
- SELECT *
- FROM component_version cv
- WHERE cv.sort_string = (
- SELECT max(sort_string)
- FROM component_version
- WHERE component_name = cv.component_name
- AND component_class = cv.component_class
- AND cvs_branch = cv.cvs_branch)
-EOSQL
-
- $sql .= "AND " . $wherephrase if ($wherephrase);
-
- return $self->execute($sql, 'RELEASE_COMPONENT_VERSION',
- FETCH_ARRAYREF, @$bindvals);
-}
-
-
-
-
-################################
-# MULTI-TABLE RECORD SELECTION #
-################################
-
-
-###################################
-sub select_current_macro_versions {
-###################################
-
- my $self = shift;
- my %args = @_;
- my @bindvals;
-
- $self->_check_reqs(['MACRO_NAME'], \%args);
-
- $args{'CVS_BRANCH'} ||= DBRANCH;
-
- my $sql = <<EOSQL;
- SELECT *
- FROM component_version outer
- WHERE cvs_branch = ?
- AND component_class || component_name in (
- SELECT component_class || component_name
- FROM macro_component
- START WITH macro_name = ?
- CONNECT BY prior component_class = macro_class
- AND prior component_name = macro_name)
- AND sort_string = (
- SELECT max(sort_string)
- FROM component_version v
- WHERE v.component_class = outer.component_class
- AND v.component_name = outer.component_name
- AND v.cvs_branch = outer.cvs_branch)
-EOSQL
-
- push(@bindvals, $args{'CVS_BRANCH'}, $args{'MACRO_NAME'});
-
- my @tables = qw(COMPONENT_VERSION MACRO_COMPONENT);
-
- return $self->execute($sql, \@tables, FETCH_ARRAYREF, @bindvals);
-
-}
-
-
-
-################################
-# SINGLE-TABLE RECORD DELETION #
-################################
-
-# Single record deletion
-sub delete_box { shift->_delete_record('BOX', @_) }
-sub delete_component { shift->_delete_record('COMPONENT', @_) }
-sub delete_component_class { shift->_delete_record('COMPONENT_CLASS', @_) }
-sub delete_component_version { shift->_delete_record('COMPONENT_VERSION', @_) }
-sub delete_macro_component { shift->_delete_record('MACRO_COMPONENT', @_) }
-sub delete_release { shift->_delete_record('RELEASE', @_) }
-sub delete_screen { shift->_delete_record('SCREEN', @_) }
-sub delete_component_version_dependency
- { shift->_delete_record('COMPONENT_VERSION_DEPENDENCY', @_) }
-sub delete_release_component_version
- { shift->_delete_record('RELEASE_COMPONENT_VERSION', @_) }
-
-
-
-# Multiple record deletion
-sub delete_boxes { shift->_delete_records('BOX', @_) }
-sub delete_components { shift->_delete_records('COMPONENT', @_) }
-sub delete_component_classes { shift->_delete_records('COMPONENT_CLASS', @_) }
-sub delete_component_versions{ shift->_delete_records('COMPONENT_VERSION', @_) }
-sub delete_macro_components { shift->_delete_records('MACRO_COMPONENT', @_) }
-sub delete_releases { shift->_delete_records('RELEASE', @_) }
-sub delete_screens { shift->_delete_records('SCREEN', @_) }
-sub delete_component_version_dependencies
- { shift->_delete_records('COMPONENT_VERSION_DEPENDENCY', @_) }
-sub delete_release_component_versions
- { shift->_delete_records('RELEASE_COMPONENT_VERSION', @_) }
-
-
-
-###############################
-# SINGLE-TABLE RECORD UPDATES #
-###############################
-
-# Single record update
-sub update_box { shift->_update_record('BOX', @_) }
-sub update_component { shift->_update_record('COMPONENT', @_) }
-sub update_component_class { shift->_update_record('COMPONENT_CLASS', @_) }
-sub update_component_version { shift->_update_record('COMPONENT_VERSION', @_) }
-sub update_macro_component { shift->_update_record('MACRO_COMPONENT', @_) }
-sub update_release { shift->_update_record('RELEASE', @_) }
-sub update_screen { shift->_update_record('SCREEN', @_) }
-sub update_component_version_dependency
- { shift->_update_record('COMPONENT_VERSION_DEPENDENCY', @_) }
-sub update_release_component_version
- { shift->_update_record('RELEASE_COMPONENT_VERSION', @_) }
-
-
-
-# Multiple record update
-sub update_boxes { shift->_update_records('BOX', @_) }
-sub update_components { shift->_update_records('COMPONENT', @_) }
-sub update_component_classes { shift->_update_records('COMPONENT_CLASS', @_) }
-sub update_component_versions{ shift->_update_records('COMPONENT_VERSION', @_) }
-sub update_macro_components { shift->_update_records('MACRO_COMPONENT', @_) }
-sub update_releases { shift->_update_records('RELEASE', @_) }
-sub update_screens { shift->_update_records('SCREEN', @_) }
-sub update_component_version_dependencies
- { shift->_update_records('COMPONENT_VERSION_DEPENDENCY', @_) }
-sub update_release_component_versions
- { shift->_update_records('RELEASE_COMPONENT_VERSION', @_) }
-
-
-######################
-# COMPLEX OPERATIONS #
-######################
-
-#############################
-sub verify_macro_components {
-#############################
- my $self = shift;
- my %args = @_;
- my @bindvals;
-
-
- my ($DEFAULT) = $self->_details('COMPONENT_VERSION', 'defaults');
- $args{'CVS_BRANCH'} ||= $DEFAULT->{'CVS_BRANCH'};
-
- $self->_check_reqs(['MACRO_NAME'], \%args);
-
- # Three steps:
- # 1) Verify that macro exists;
- my $rec = $self->select_component(
- CLASS => MCLASS,
- NAME => $args{'MACRO_NAME'},
- );
-
- throw NOCpulse::Probe::DataSource::ConfigError(
- "Cannot verify '$args{'MACRO_NAME'}': nonexistent macro\n"
- ) unless ($rec);
-
-
- # 2) Verify all non-macro components;
- my $sql = <<EOSQL;
- SELECT mc.component_class, mc.component_name
- FROM macro_component mc
- WHERE mc.macro_class = ?
- AND mc.macro_name = ?
- AND mc.component_class != ?
- AND not exists (
- SELECT 1
- FROM component_version
- WHERE component_class = mc.component_class
- AND component_name = mc.component_name
- AND cvs_branch = ?)
-EOSQL
-
- push(@bindvals, MCLASS, $args{'MACRO_NAME'}, MCLASS, $args{'CVS_BRANCH'});
-
- my $missing = $self->execute($sql, 'MACRO_COMPONENT', FETCH_ARRAYREF,
- @bindvals);
- my @missing = map($_->{'COMPONENT_NAME'}, @$missing);
-
- if (scalar(@$missing)) {
-
- throw NOCpulse::Probe::DataSource::CommandFailedError(
- "\n The following $args{MACRO_NAME} components have no version " .
- "on the '$args{CVS_BRANCH}' branch:\n " . join(" ", @missing) . "\n"
- );
- }
-
-
-
- # 3) Recursively verify macro components;
- my $macro_components = $self->expand_macro(
- MACRO_NAME => $args{'MACRO_NAME'},
- MACRO_ONLY => 1);
- my @macros = map($_->{'COMPONENT_NAME'}, @$macro_components);
-
- try {
-
- foreach my $macro (@macros) {
- $self->verify_macro_components(MACRO_NAME => $macro,
- CVS_BRANCH => $args{'CVS_BRANCH'});
- }
-
- } catch NOCpulse::Probe::DataSource::CommandFailedError with {
-
- my $err = shift;
- my $msg = $err->{'-message'};
- throw NOCpulse::Probe::DataSource::CommandFailedError(
- "\n Failure verifying $args{'MACRO_NAME'}$msg"
- );
-
- }
-
-}
-
-
-
-##################
-sub make_release {
-##################
- my $self = shift;
- my %args = @_;
- my @bindvals;
-
- # 1) Fetch box record to get macro
- # 2) Verify release macro
- # 3) Create a RELEASE record
- # 4) Fetch the latest versions of the components for the release
- # 5) Create RELEASE_COMPONENT_VERSION records for the release
- # components
-
- my ($DEFAULT) = $self->_details('RELEASE', 'defaults');
- $args{'RELEASE_DATE'} ||= $DEFAULT->{'RELEASE_DATE'};
- $args{'RELEASED'} ||= $DEFAULT->{'RELEASED'};
- $args{'CVS_BRANCH'} ||= DBRANCH;
-
- my $boxkey = $self->_details('BOX', 'pk');
- my @relfields = qw(VERSION RELEASE_NUMBER RELEASE_USER);
-
- $self->_check_reqs([@$boxkey, @relfields], \%args);
-
-
- # 1) Fetch box record to get macro
- my %boxkey;
- foreach my $field (@$boxkey) {
- $boxkey{$field} = $args{$field};
- }
-
- my $boxrec = $self->select_box(%boxkey);
-
- $args{'MACRO_NAME'} = $boxrec->{'MACRO_NAME'};
-
- # 2) Verify release macro
- $self->verify_macro_components(%args);
-
- # 3) Create a RELEASE record
- $self->create_release(%args);
-
- # 4) Fetch the latest versions of the components for the release
- my $components = $self->select_current_macro_versions(%args);
-
-
- # 5) Create RELEASE_COMPONENT_VERSION records for the release
- # components
- foreach my $crec (@$components) {
- $self->create_release_component_version(%args, %$crec);
- }
-
- return $components;
-
-}
-
-
-
-#################
-sub make_branch {
-#################
- my $self = shift;
- my %args = @_;
- my @bindvals;
-
- $args{'TRUNK'} ||= DBRANCH;
-
- $self->_check_reqs([qw(CVS_BRANCH)], \%args);
-
- # 1) Bail out if the branch already exists
- my $sql = <<EOSQL;
- SELECT count(*) as RECORDS
- FROM component_version
- WHERE cvs_branch = ?
-EOSQL
-
- my $rv = $self->execute($sql, 'COMPONENT_VERSION', FETCH_SINGLE,
- $args{'CVS_BRANCH'});
- if ($rv->{'RECORDS'}) {
- throw NOCpulse::Probe::DataSource::ConfigError(
- "Branch '$args{CVS_BRANCH}' already exists.\n"
- );
- }
-
-
- # 2) Create branch by copying COMPONENT_VERSION
- # records from the trunk to the branch
- $sql = <<EOSQL;
- INSERT INTO component_version (
- COMPONENT_CLASS, COMPONENT_NAME, COMPONENT_VERSION, SORT_STRING,
- CVS_BRANCH, INSTALL_SWITCHES, PACKAGE_FILENAME, BUILD_DATE, BUILD_USER)
- SELECT cv.component_class, cv.component_name, cv.component_version,
- cv.sort_string, ?, cv.install_switches,
- cv.package_filename, cv.build_date, cv.build_user
- FROM component_version cv
- WHERE cv.cvs_branch = ?
- AND cv.sort_string = (
- SELECT max(sort_string)
- FROM component_version
- WHERE component_name = cv.component_name
- AND component_class = cv.component_class
- AND cvs_branch = cv.cvs_branch)
-EOSQL
-
- $rv = $self->execute($sql, 'COMPONENT_VERSION', FETCH_ROWCOUNT,
- $args{'CVS_BRANCH'}, $args{'TRUNK'});
-
- return $rv;
-
-}
-
-
-##################
-sub merge_branch {
-##################
- my $self = shift;
- my %args = @_;
- my @bindvals;
-
- $args{'TRUNK'} ||= DBRANCH;
-
- $self->_check_reqs([qw(CVS_BRANCH)], \%args);
-
- # 1) Bail out if the trunk doesn't exist
- my $sql = <<EOSQL;
- SELECT count(*) as RECORDS
- FROM component_version
- WHERE cvs_branch = ?
-EOSQL
- my $rv = $self->execute($sql, 'COMPONENT_VERSION', FETCH_SINGLE,
- $args{'TRUNK'});
- unless ($rv->{'RECORDS'}) {
- throw NOCpulse::Probe::DataSource::ConfigError(
- "Trunk '$args{TRUNK}' does not exist.\n"
- );
- }
-
-
-
- # 2) Merge the branch by copying COMPONENT_VERSIONS to the
- # branch thus:
- # a) Change on trunk, no change on branch: do nothing (trunk
- # is current)
- # b) Change on branch, no change on trunk: COPY LATEST VERSION
- # FROM BRANCH TO TRUNK.
- # c) Changes on branch and on trunk: do nothing (as a rebuild
- # on the trunk will be necessary, making the trunk current)
- # d) No changes: do nothing (trunk is current)
- #
- # Situation b) is indicated when the latest version on the trunk
- # exists on the branch and is not equal to the latest version on
- # the branch.
-
- $sql = <<EOSQL;
- INSERT INTO component_version (
- COMPONENT_CLASS, COMPONENT_NAME, COMPONENT_VERSION, SORT_STRING,
- CVS_BRANCH, INSTALL_SWITCHES, PACKAGE_FILENAME, BUILD_DATE, BUILD_USER)
- SELECT branch.component_class, branch.component_name,
- branch.component_version, branch.sort_string, ?,
- branch.install_switches, branch.package_filename,
- branch.build_date, branch.build_user
- FROM component_version branch
- WHERE cvs_branch = ?
- AND sort_string = (
- SELECT max(sort_string)
- FROM component_version
- WHERE component_class = branch.component_class
- AND component_name = branch.component_name
- AND cvs_branch = branch.cvs_branch)
- AND sort_string != (
- SELECT max(sort_string)
- FROM component_version
- WHERE component_class = branch.component_class
- AND component_name = branch.component_name
- AND cvs_branch = ?)
- AND (
- SELECT 1
- FROM component_version
- WHERE component_name = branch.component_name
- AND component_class = branch.component_class
- AND cvs_branch = branch.cvs_branch
- AND sort_string = (
- SELECT max(sort_string)
- FROM component_version
- WHERE component_class = branch.component_class
- AND component_name = branch.component_name
- AND cvs_branch = ?)
- ) = 1
-EOSQL
-
- $rv = $self->execute($sql, 'COMPONENT_VERSION', FETCH_ROWCOUNT,
- $args{'TRUNK'}, $args{'CVS_BRANCH'},
- $args{'TRUNK'}, $args{'TRUNK'});
-
- return $rv;
-
-}
-
-
-
-####################
-sub copy_to_branch {
-####################
- my $self = shift;
- my %args = @_;
-
- my $cvkey = $self->_details('COMPONENT_VERSION', 'pk');
-
- $self->_check_reqs($cvkey, \%args);
-
- my $branch = $args{'CVS_BRANCH'};
- $args{'CVS_BRANCH'} = delete($args{'TRUNK'}) || DBRANCH;
-
- my($wherephrase, $bindvals) = $self->_wherephrase(\%args);
-
- # Copy a single component version to a branch.
- my $sql = <<EOSQL;
- INSERT INTO component_version (
- COMPONENT_CLASS, COMPONENT_NAME, COMPONENT_VERSION, SORT_STRING,
- CVS_BRANCH, INSTALL_SWITCHES, PACKAGE_FILENAME, BUILD_DATE, BUILD_USER)
- SELECT cv.component_class, cv.component_name, cv.component_version,
- cv.sort_string, ?, cv.install_switches,
- cv.package_filename, cv.build_date, cv.build_user
- FROM component_version cv
- WHERE $wherephrase
-EOSQL
-
- my $rv = $self->execute($sql, 'COMPONENT_VERSION', FETCH_ROWCOUNT,
- $branch, @$bindvals);
-
- return $rv;
-
-}
-
-
-
-##########################
-sub delete_whole_release {
-##########################
- my $self = shift;
- my %args = @_;
-
- my $rkey = $self->_details('RELEASE', 'pk');
-
- $self->_check_reqs($rkey, \%args);
-
- my($wherephrase, $bindvals) = $self->_wherephrase(\%args);
-
- # 1) Delete release_component_version records
- my $sql = <<EOSQL;
- DELETE FROM release_component_version
- WHERE $wherephrase
-EOSQL
-
- $self->execute($sql, 'RELEASE_COMPONENT_VERSION', FETCH_ROWCOUNT, @$bindvals);
-
-
- # 2) Delete release record
- $sql = <<EOSQL;
- DELETE FROM release
- WHERE $wherephrase
-EOSQL
-
- my $rv = $self->execute($sql, 'RELEASE', FETCH_ROWCOUNT, @$bindvals);
-
- return $rv;
-
-}
-
-
-
-
-
-##################
-# SCHEMA DETAILS #
-##################
-
-##################
-sub init_details {
-##################
- %DETAIL = (
-
- 'BOX' => {
-
- 'cols' => [qw(BOX_TYPE BOX_NAME
- MACRO_CLASS MACRO_NAME
- PARTITIONING SCREEN_NAME
- KERNEL_PKG_NAME KERNEL_PKG_CLASS
- LAST_UPDATE_USER LAST_UPDATE_DATE)],
-
- 'pk' => [qw(BOX_TYPE BOX_NAME)],
-
- 'defaults' => {
- LAST_UPDATE_USER => 'nouser',
- LAST_UPDATE_DATE => 'sysdate',
- },
- },
-
-
-
- 'COMPONENT' => {
-
- 'cols' => [qw(CLASS NAME CVS_PATH DEFAULT_SWITCHES)],
-
- 'pk' => [qw(CLASS NAME)],
-
- 'defaults' => { },
- },
-
-
- 'COMPONENT_CLASS' => {
-
- 'cols' => [qw(CLASS DESCRIPTION)],
-
- 'pk' => [qw(CLASS)],
-
- 'defaults' => { },
- },
-
-
- 'COMPONENT_VERSION' => {
-
- 'cols' => [qw(COMPONENT_CLASS COMPONENT_NAME COMPONENT_VERSION
- SORT_STRING CVS_BRANCH INSTALL_SWITCHES
- PACKAGE_FILENAME BUILD_USER BUILD_DATE)],
-
- 'pk' => [qw(COMPONENT_CLASS COMPONENT_NAME
- COMPONENT_VERSION CVS_BRANCH)],
-
- 'defaults' => {
- CVS_BRANCH => DBRANCH,
- BUILD_DATE => 'sysdate',
- BUILD_USER => 'nouser',
- },
- },
-
-
- 'COMPONENT_VERSION_DEPENDENCY' => {
-
- 'cols' => [qw(COMPONENT_CLASS COMPONENT_NAME COMPONENT_VERSION
- TYPE RESOURCE_NAME CVS_BRANCH)],
-
- 'pk' => [qw(COMPONENT_CLASS COMPONENT_NAME COMPONENT_VERSION
- TYPE RESOURCE_NAME CVS_BRANCH)],
-
- 'defaults' => {
- CVS_BRANCH => DBRANCH,
- },
- },
-
-
- 'MACRO_COMPONENT' => {
-
- 'cols' => [qw(MACRO_CLASS MACRO_NAME COMPONENT_CLASS COMPONENT_NAME)],
-
- 'pk' => [qw(MACRO_CLASS MACRO_NAME COMPONENT_CLASS COMPONENT_NAME)],
-
- 'defaults' => { },
- },
-
-
- 'RELEASE' => {
-
- 'cols' => [qw( BOX_TYPE BOX_NAME VERSION RELEASED
- RELEASE_NUMBER RELEASE_USER RELEASE_DATE)],
-
- 'pk' => [qw(BOX_TYPE BOX_NAME VERSION RELEASE_NUMBER)],
-
- 'defaults' => {
- RELEASED => 0,
- RELEASE_USER => 'nouser',
- RELEASE_DATE => 'sysdate',
- },
- },
-
-
- 'SCREEN' => {
-
- 'cols' => [qw( NAME FKEY DESCRIPTION )],
-
- 'pk' => [qw(NAME)],
-
- 'defaults' => {
- },
- },
-
-
- 'RELEASE_COMPONENT_VERSION' => {
-
- 'cols' => [qw(BOX_TYPE BOX_NAME
- VERSION RELEASE_NUMBER
- COMPONENT_CLASS COMPONENT_NAME
- COMPONENT_VERSION CVS_BRANCH)],
-
- 'pk' => [qw(BOX_TYPE BOX_NAME
- VERSION RELEASE_NUMBER
- COMPONENT_CLASS COMPONENT_NAME
- COMPONENT_VERSION CVS_BRANCH)],
-
- 'defaults' => { },
- },
-
-
- );
-}
-
-
-
-
-######################
-# INTERNAL FUNCTIONS #
-######################
-
-##############
-sub _details {
-##############
- my $self = shift;
- my($table, @req) = @_;
- $table = uc($table);
- my @rv;
-
- foreach my $req (@req) {
- if (exists($DETAIL{$table}->{$req})) {
-
- push(@rv, $DETAIL{$table}->{$req});
-
- } else {
-
- throw NOCpulse::Probe::DataSource::ConfigError(
- "Unknown field '$req' requested from $table details\n"
- );
-
- }
- }
-
- return wantarray ? @rv : $rv[0];
-
-}
-
-
-
-
-#############
-sub _create {
-#############
- my $self = shift;
- my $table = shift;
- my %fields = @_;
-
- my ($COLS, $DEFAULT) =
- $self->_details($table, 'cols', 'defaults');
-
- my($COLSTR) = join(',', @$COLS);
-
- my(@bindvars, @bindvals);
- foreach my $col (@$COLS) {
- $fields{$col} = $DEFAULT->{$col} unless (exists($fields{$col}));
- if ($DEFAULT->{$col} eq 'sysdate') {
- # Fancy stuff for sysdate
- push(@bindvars,
- "DECODE(?, 'sysdate', sysdate, TO_DATE(?, 'YYYY-MM-DD HH24:MI:SS'))");
- push(@bindvals, $fields{$col}, $fields{$col});
- } else {
- push(@bindvars, '?');
- push(@bindvals, $fields{$col});
- }
- }
- my $BVSTR = join(',', @bindvars);
-
-
- my $sql = "INSERT INTO $table ($COLSTR) VALUES ($BVSTR)";
-
- return $self->execute($sql, $table, FETCH_ROWCOUNT, @bindvals);
-}
-
-
-####################
-sub _select_record {
-####################
- my $self = shift;
- my $table = shift;
- my %args = @_;
-
- my $pk = $self->_details($table, 'pk');
-
- $self->_check_reqs($pk, \%args, 2);
-
- my $records = $self->_select_records($table, %args);
-
- return $records->[0];
-
-}
-
-
-#####################
-sub _select_records {
-#####################
- my $self = shift;
- my $table = shift;
- my %args = @_;
-
- my($wherephrase, $bindvals) = $self->_wherephrase(\%args);
-
- my $sql = <<EOSQL;
- SELECT *
- FROM $table
- WHERE $wherephrase
-EOSQL
-
-
- return $self->execute($sql, $table, FETCH_ARRAYREF, @$bindvals);
-}
-
-
-
-####################
-sub _delete_record {
-####################
- my $self = shift;
- my $table = shift;
- my %args = @_;
-
- my $pk = $self->_details($table, 'pk');
-
- $self->_check_reqs($pk, \%args, 2);
-
- return $self->_delete_records($table, %args);
-
-}
-
-
-#####################
-sub _delete_records {
-#####################
- my $self = shift;
- my $table = shift;
- my %args = @_;
-
- my($wherephrase, $bindvals) = $self->_wherephrase(\%args);
-
- my $sql = <<EOSQL;
- DELETE
- FROM $table
- WHERE $wherephrase
-EOSQL
-
- return $self->execute($sql, $table, FETCH_ROWCOUNT, @$bindvals);
-}
-
-
-
-
-####################
-sub _update_record {
-####################
- my $self = shift;
- my $table = shift;
- my %args = @_;
-
- my $pk = $self->_details($table, 'pk');
-
- $self->_check_reqs($pk, \%args, 2);
-
- return $self->_update_records($table, %args);
-
-}
-
-
-#####################
-sub _update_records {
-#####################
- my $self = shift;
- my $table = shift;
- my %args = @_;
-
- $self->_check_reqs(['set'], \%args, 3);
-
- my $set = delete($args{'set'});
-
- my($setphrase, $sbindvals) = $self->_wherephrase($set, ',');
- my($wherephrase, $wbindvals) = $self->_wherephrase(\%args);
-
- my $sql = <<EOSQL;
- UPDATE $table
- SET $setphrase
- WHERE $wherephrase
-EOSQL
-
- return $self->execute($sql, $table, FETCH_ROWCOUNT, @$sbindvals, @$wbindvals);
-
-}
-
-
-
-#################
-sub _check_reqs {
-#################
- my($self, $reqs, $args, $clvl) = @_;
- $clvl ||= 1;
-
- foreach my $req (@$reqs) {
- unless (exists($args->{$req})) {
- my ($package, $filename, $line, $subroutine) = caller($clvl);
- throw NOCpulse::Probe::DataSource::ConfigError(
- "\n Missing required params for $subroutine: @$reqs\n"
- );
- }
- }
-}
-
-
-
-##################
-sub _wherephrase {
-##################
- my($self, $args, $conj) = @_;
- $conj ||= 'AND';
-
- # Construct part of a WHERE clause with bind variables
- # given a hash of column => value pairs
-
- my(@bindvals, @wherephrases);
- while (my($col, $val) = each %$args) {
- push(@wherephrases, "$col = ?");
- push(@bindvals, $val);
- }
-
- return (join(" $conj ", @wherephrases), \@bindvals);
-
-}
-
-
-#####################
-# UTILITY FUNCTIONS #
-#####################
-
-#############
-sub ver2str {
-#############
- my $self = shift;
-
- # Given a version string ("<version>-<relnum>"), compute a sort
- # string.
- my $verrel = shift;
- my($ver, $relnum) = split(/-/, $verrel, 2);
- my @verstr;
-
- foreach my $comp (split(/\./, $ver), '-', split(/\./, $relnum)) {
-
- if ($comp eq '-') {
- push(@verstr, $comp);
- } elsif ($comp =~ /\D/) {
- my $x = "0" x 10;
- substr($x, 10 - length($comp), length($comp)) = $comp;
- push(@verstr, $x);
- } else {
- push(@verstr, sprintf("%010d", $comp));
- }
-
- }
-
- return join('', @verstr);
-}
-
-
-
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-NOCpulse::ReleaseDB - access to the NOCpulse release database
-
-=head1 SYNOPSIS
-
- use NOCpulse::ReleaseDB;
-
- # INITIALIZATION
-
- my $rdb = NOCpulse::ReleaseDB->new();
-
-
- # COMMIT OR ROLLBACK - autocommit is *OFF*
-
- # Commit changes to the database
- $rdb->commit();
-
- # Abort changes to the database
- $rdb->rollback();
-
-
- # RELEASE HANDLING
-
- # Create a branch from a trunk
- my $nrec = $rdb->make_branch(TRUNK => $trunk, CVS_BRANCH => $branch);
-
- # Merge a branch onto a trunk
- my $nrec = $rdb->merge_branch(TRUNK => $trunk, CVS_BRANCH => $branch);
-
- # Copy a component_version record from a trunk to the branch
- my $nrec = $rdb->merge_branch(%key_fields, TRUNK => $trunk);
-
- # Select a list of release component versions
- my $ary = $rdb->select_release_components(%release_fields);
-
- # Create a new release from current component versions
- my $ary = $rdb->make_release(%release_fields);
-
- # Select the current version of a component on a branch
- my $ary = $rdb->select_current_component_version(%key_fields);
-
- # Delete an entire release
- my $nrec = $rdb->delete_whole_release(%key_fields);
-
-
-
- # MACRO HANDLING
-
- # Expand a macro into its constitutent components
- my $ary = $rdb->expand_macro(MACRO_NAME => $macro_name);
-
- # Verify that all components of a macro have been built
- $rdb->verify_macro_components(MACRO_NAME => $macro_name);
-
- # Select a list of current component versions for a macro
- my $ary = $rdb->select_current_macro_versions(
- MACRO_NAME => $macro_name
- );
-
-
-
- # LOW-LEVEL FUNCTIONS
-
- # Create a record in any table (e.g. COMPONENT) in the database
- my $nrec = $rdb->create_component(%component_fields);
-
- # Select a single record from a table (e.g. COMPONENT) in the database
- my $rec = $rdb->select_component(%key_fields);
-
- # Select multiple records from a table (e.g. COMPONENT) in the database
- my $ary = $rdb->select_components(%key_fields);
-
- # Delete a single record from a table (e.g. COMPONENT) in the database
- my $nrec = $rdb->delete_component(%key_fields);
-
- # Delete multiple records from a table (e.g. COMPONENT) in the database
- my $nrec = $rdb->delete_components(%key_fields);
-
-
-
- # UTILITY FUNCTIONS
-
- # Convert a <version>-<relnum> string to a sort string
- my $sortstring = $rdb->ver2str($version);
-
-
-=head1 DESCRIPTION
-
-NOCpulse::ReleaseDB provides DBI-like access methods to the NOCpulse
-release database.
-
-Each method returns an array ($ary) of DBI-style database hash
-records (keys == colunm names, values == column values) or a count
-($nrec) of the number of rows affected.
-
-
-=head1 METHODS
-
-=over 4
-
-=item NOCpulse::ReleaseDB->new()
-
-Connects to the release database and returns a NOCpulse::ReleaseDB object.
-
-
-=item make_branch()
-
- my $nrec = $rdb->make_branch(
- CVS_BRANCH => $branch,
- [TRUNK => $trunk]
- );
-
-Create a branch from a trunk. This method copies the latest versions
-of each component from the TRUNK (default 'main') to the CVS_BRANCH
-(which must not yet exist). Returns the number of records copied.
-
-
-=item merge_branch()
-
- my $nrec = $rdb->merge_branch(
- CVS_BRANCH => $branch,
- [TRUNK => $trunk || 'main']
- );
-
-Merge a branch onto a trunk. This method merges the branch onto
-the trunk (default 'main') by copying the latest record from the
-branch onto the trunk, where appropriate. (Specifically, when
-a build was done on the branch but none was done on the trunk.)
-Returns the number of records merged (may be zero).
-
-
-=item copy_to_branch()
-
- my $nrec = $rdb->copy_to_branch(
- COMPONENT_CLASS => $cclass,
- COMPONENT_NAME => $component,
- COMPONENT_VERSION => $version,
- CVS_BRANCH => $branch,
- [TRUNK => $trunk || 'main']
- );
-
-Copy a component version from a trunk (default 'main') to a branch.
-Use this method when you need to add to a branch (e.g. when you've
-created a new module in CVS and want to branch just that module).
-TRUNK is the source branch; CVS_BRANCH is the destination branch.
-
-=item select_release_components()
-
- my $ary = $rdb->select_release_components(
- BOX_TYPE => $boxtype,
- BOX_NAME => $boxname,
- VERSION => $version,
- RELEASE_NUMBER => $relnum,
- );
-
-Selects a list of component versions associated with a release.
-Returns an array of hash records.
-
-
-=item make_release()
-
- my $ary = $rdb->make_release(
- BOX_TYPE => $boxtype,
- BOX_NAME => $boxname,
- VERSION => $version,
- RELEASE_NUMBER => $relnum,
- RELEASE_USER => $reluser,
- [RELEASE_DATE => <YYYY-MM-DD HH24:MI:SS>,]
- [RELEASED => {1|0},]
- [CVS_BRANCH => $branch,]
- );
-
-Creates a new release by selecting the latest versions of all
-components related to the box macro on the branch (default main).
-Returns an array of hash records representing the component
-versions for the release.
-
-
-=item delete_whole_release()
-
- my $rv = $rdb->delete_whole_release(
- BOX_TYPE => $boxtype,
- BOX_NAME => $boxname,
- VERSION => $version,
- RELEASE_NUMBER => $relnum,
- );
-
-Deletes an entire release (a RELEASE record and its associated
-RELEASE_COMPONENT_VERSION records). Returns number of records
-deleted on success, throws an error on failure.
-
-
-
-=item select_current_component_version()
-
- my $ary = $rdb->select_current_component_version(
- [COMPONENT_CLASS => $component_class],
- [COMPONENT_NAME => $component_name],
- [COMPONENT_VERSION => $component_version],
- [SORT_STRING => $sort_string],
- [CVS_BRANCH => $cvs_branch || 'main'],
- [INSTALL_SWITCHES => $install_switches],
- [PACKAGE_FILENAME => $package_filename],
- [BUILD_USER => $build_user],
- [BUILD_DATE => $build_date],
- );
-
-Select the current version(s) of one or more component(s) on a branch
-(default 'main').
-
-
-
-=item expand_macro()
-
- my $ary = $rdb->expand_macro(
- MACRO_NAME => $macro_name,
- [RECURSIVE => 1],
- [NO_MACRO => 1],
- [MACRO_ONLY => 1],
- );
-
-Expand a macro into its constitutent components. Returns an
-arrayref of hashes with COMPONENT_NAME and COMPONENT_CLASS
-fields representing the components that make up the macro.
-With RECURSIVE => 1, recursively expands macro components
-within macro $macro_name. With MACRO_ONLY => 1, only returns
-macro components; with NO_MACRO => 1 (overrides MACRO_ONLY),
-only returns non-macro components.
-
-
-=item verify_macro_components()
-
- $rdb->verify_macro_components(
- MACRO_NAME => $macro_name,
- [CVS_BRANCH => $cvs_branch || 'main'],
- );
-
-Verify that all components of a macro have been built on the
-branch (default 'main'). If verification fails, throws an
-error which can be caught with Error's try/catch mechanism.
-
-
-=item select_current_macro_versions()
-
- my $ary = $rdb->select_current_macro_versions(
- MACRO_NAME => $macro_name,
- [CVS_BRANCH => $cvs_branch || 'main'],
- );
-
-Select a list of current component versions for a macro from a branch
-(default 'main'). Returns an arrayref of COMPONENT_VERSION records
-representing the current versions of components for the macro on the
-named branch.
-
-
-
-=item create_<TABLE>()
-
- my $nrec = create_box(%key_fields);
- my $nrec = create_component_class(%key_fields);
- my $nrec = create_component(%key_fields);
- my $nrec = create_component_version_dependency(%key_fields);
- my $nrec = create_component_version(%key_fields);
- my $nrec = create_macro_component(%key_fields);
- my $nrec = create_release_component_version(%key_fields);
- my $nrec = create_release(%key_fields);
-
-Create a record in the database. Returns 1 on success; throws an
-error on failure.
-
-=item select_<TABLE>()
-
- my $rec = select_box(%key_fields);
- my $rec = select_component_class(%key_fields);
- my $rec = select_component(%key_fields);
- my $rec = select_component_version_dependency(%key_fields);
- my $rec = select_component_version(%key_fields);
- my $rec = select_macro_component(%key_fields);
- my $rec = select_release_component_version(%key_fields);
- my $rec = select_release(%key_fields);
-
-Select a single record from a table in the database. Returns a hash
-ref representing the record on success; returns undef if there are no
-matching records; throws an error on failure (e.g. failure to supply
-values for all of the table's key fields).
-
-
-=item select_<TABLE PLURAL>()
-
- my $ary = select_boxes(%key_fields);
- my $ary = select_component_classes(%key_fields);
- my $ary = select_components(%key_fields);
- my $ary = select_component_version_dependencies(%key_fields);
- my $ary = select_component_versions(%key_fields);
- my $ary = select_macro_components(%key_fields);
- my $ary = select_release_component_versions(%key_fields);
- my $ary = select_releases(%key_fields);
-
-Select multiple records from a table in the database. Returns an
-array of hash refs representing the records on success.
-
-
-=item delete_<TABLE>()
-
- my $nrec = delete_box(%key_fields);
- my $nrec = delete_component_class(%key_fields);
- my $nrec = delete_component(%key_fields);
- my $nrec = delete_component_version_dependency(%key_fields);
- my $nrec = delete_component_version(%key_fields);
- my $nrec = delete_macro_component(%key_fields);
- my $nrec = delete_release_component_version(%key_fields);
- my $nrec = delete_release(%key_fields);
-
-Delete a record from the database. Returns the number of records
-deleted on success, throws an error on failure.
-
-
-=item delete_<TABLE PLURAL>()
-
- my $ary = delete_boxes(%key_fields);
- my $ary = delete_component_classes(%key_fields);
- my $ary = delete_components(%key_fields);
- my $ary = delete_component_version_dependencies(%key_fields);
- my $ary = delete_component_versions(%key_fields);
- my $ary = delete_macro_components(%key_fields);
- my $ary = delete_release_component_versions(%key_fields);
- my $ary = delete_releases(%key_fields);
-
-Delete multiple records from the database. Returns the number of
-rows deleted on success, throws an error on failure.
-
-
-=item ver2str()
-
- my $sortstring = $rdb->ver2str($version);
-
-Create a sort string (suitable for the SORT_STRING column of
-the COMPONENT_VERSION table) from a <version>-<relnum> string.
-
-
-=back
-
-=head1 BUGS
-
- Dates are not handled in a useful way. It is currently impossible to
- select by date, and date fields always use the database's default date
- format.
-
-=head1 AUTHOR
-
- Dave Faraldo <dfaraldo(a)nocpulse.com>
- Last update: $Date: 2003-02-21 21:32:33 $
-
-=head1 SEE ALSO
-
-NOCpulse::Probe::DataSource::Oracle
-NOCpulse::Probe::DataSource::AbstractDatabase
-NOCpulse::Log::LogManager (for debugging)
-
-=cut
diff --git a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/TO_DO b/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/TO_DO
deleted file mode 100644
index c998ea2..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/TO_DO
+++ /dev/null
@@ -1,20 +0,0 @@
-- Need to handle dates better, both in output and in input.
- For input, here's an idea:
-
-> if ($val =~ /TO_DATE\(('[^']+'),\s*('[^']+')\)/i) {
-> my($date, $fmt) = ($1, $2);
-> push(@wherephrases, "TO_CHAR($col, $fmt) = $date");
-> } else {
-> push(@wherephrases, "$col = ?");
-> push(@bindvals, $val);
-> }
-
-
- For output, might want to replace 'SELECT *' with
- my $colstr = _cols_for_select($table);
- my $sql = "SELECT $colstr FROM $table ...";
-
- where _cols_for_select() would translate date columns
- to 'TO_DATE(' . $col . ',' . $self->dateformat() . ')'.
- (Probably want to add dateformat() to AbstractDatabase.)
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/UTILITIES b/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/UTILITIES
deleted file mode 100644
index 9704738..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/UTILITIES
+++ /dev/null
@@ -1,151 +0,0 @@
-ReleaseDB Utilities Wish List
------------------------------
-
-Objects:
- BOX
- COMPONENT / COMPONENT_VERSION / COMPONENT_VERSION_DEPENDENCY
- MACRO_COMPONENT
- RELEASE / RELEASE_COMPONENT_VERSION
-
-Use cases:
-
- - Create a new BOX
- - Show boxes
- - all
- - by type
- - by name
-
- - Create a new COMPONENT out of whole cloth
- - Create a new COMPONENT_VERSION out of whole cloth
- - Create a new COMPONENT_VERSION (and COMPONENT, if necessary)
- out of an RPM file
-
- - Show COMPONENT records
- - by name
- - by class
-
- - Show COMPONENT_VERSION records
- - by COMPONENT name
- - by class
- - by branch
-
- - Create a new MACRO_COMPONENT
- - out of whole cloth
- - out of a list of components
- - out of a list of RPM files (-> COMPONENT_VERSION records)
-
- - View MACRO_COMPONENT records
- - all (expanding list) (TOP DOWN)
- - by name
- - by type
- - by COMPONENT name (BOTTOM UP)
-
- - Show RELEASE records
- - all
- - by BOX_NAME
- - by VERSION + RELEASE_NUMBER
- - by branch (from RELEASE_COMPONENT_VERSION)
-
-
-#--------------------------------- Cut Here ---------------------------------#
-
-Here are the tables:
-BOX
----
- Name Null? Type
- ----------------------------------------- -------- ----------------------------
- BOX_TYPE NOT NULL VARCHAR2(30)
- BOX_NAME NOT NULL VARCHAR2(30)
- MACRO_CLASS NOT NULL VARCHAR2(30)
- MACRO_NAME NOT NULL VARCHAR2(1024)
- PARTITIONING VARCHAR2(1024)
- KERNEL_PKG_NAME VARCHAR2(1024)
- KERNEL_PKG_CLASS VARCHAR2(30)
- LAST_UPDATE_USER VARCHAR2(50)
- LAST_UPDATE_DATE DATE
- POSTINSTALL VARCHAR2(4000)
- DESCRIPTION VARCHAR2(256)
- SCREEN_NAME VARCHAR2(30)
-
-COMPONENT
----------
- Name Null? Type
- ----------------------------------------- -------- ----------------------------
- CLASS NOT NULL VARCHAR2(30)
- NAME NOT NULL VARCHAR2(1024)
- CVS_PATH VARCHAR2(1024)
- DEFAULT_SWITCHES VARCHAR2(512)
-
-COMPONENT_CLASS
----------------
- Name Null? Type
- ----------------------------------------- -------- ----------------------------
- CLASS NOT NULL VARCHAR2(30)
- DESCRIPTION VARCHAR2(128)
-
-COMPONENT_VERSION
------------------
- Name Null? Type
- ----------------------------------------- -------- ----------------------------
- COMPONENT_CLASS NOT NULL VARCHAR2(30)
- COMPONENT_NAME NOT NULL VARCHAR2(1024)
- COMPONENT_VERSION NOT NULL VARCHAR2(20)
- SORT_STRING NOT NULL VARCHAR2(255)
- CVS_BRANCH NOT NULL VARCHAR2(20)
- INSTALL_SWITCHES VARCHAR2(512)
- PACKAGE_FILENAME VARCHAR2(255)
- BUILD_DATE DATE
- BUILD_USER VARCHAR2(50)
-
-COMPONENT_VERSION_DEPENDENCY
-----------------------------
- Name Null? Type
- ----------------------------------------- -------- ----------------------------
- COMPONENT_CLASS NOT NULL VARCHAR2(30)
- COMPONENT_NAME NOT NULL VARCHAR2(1024)
- COMPONENT_VERSION NOT NULL VARCHAR2(20)
- TYPE NOT NULL VARCHAR2(20)
- RESOURCE_NAME NOT NULL VARCHAR2(255)
- CVS_BRANCH NOT NULL VARCHAR2(20)
-
-MACRO_COMPONENT
----------------
- Name Null? Type
- ----------------------------------------- -------- ----------------------------
- MACRO_CLASS NOT NULL VARCHAR2(30)
- MACRO_NAME NOT NULL VARCHAR2(1024)
- COMPONENT_CLASS NOT NULL VARCHAR2(30)
- COMPONENT_NAME NOT NULL VARCHAR2(1024)
-
-RELEASE
--------
- Name Null? Type
- ----------------------------------------- -------- ----------------------------
- BOX_TYPE NOT NULL VARCHAR2(30)
- BOX_NAME NOT NULL VARCHAR2(30)
- VERSION NOT NULL VARCHAR2(20)
- RELEASE_NUMBER NOT NULL NUMBER
- RELEASED VARCHAR2(1)
- RELEASE_DATE DATE
- RELEASE_USER VARCHAR2(50)
-
-RELEASE_COMPONENT_VERSION
--------------------------
- Name Null? Type
- ----------------------------------------- -------- ----------------------------
- BOX_TYPE NOT NULL VARCHAR2(30)
- BOX_NAME NOT NULL VARCHAR2(30)
- VERSION NOT NULL VARCHAR2(20)
- RELEASE_NUMBER NOT NULL NUMBER
- COMPONENT_CLASS NOT NULL VARCHAR2(30)
- COMPONENT_NAME NOT NULL VARCHAR2(1024)
- COMPONENT_VERSION NOT NULL VARCHAR2(20)
- CVS_BRANCH NOT NULL VARCHAR2(20)
-
-SCREEN
-------
- Name Null? Type
- ----------------------------------------- -------- ----------------------------
- NAME NOT NULL VARCHAR2(30)
- FKEY NOT NULL VARCHAR2(2)
- DESCRIPTION VARCHAR2(256)
diff --git a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/test/TestRelease.pm b/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/test/TestRelease.pm
deleted file mode 100644
index d9cdca6..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/test/TestRelease.pm
+++ /dev/null
@@ -1,1000 +0,0 @@
-package TestRelease;
-use Data::Dumper;
-use NOCpulse::Probe::DataSource::AbstractDatabase qw(:constants);
-use Error qw(:try);
-
-use strict;
-
-use NOCpulse::ReleaseDB;
-
-use base qw(Test::Unit::TestCase);
-
-
-# GLOBAL VARIABLES
-my $CCLASS = 'RPMComponent';
-my $MCLASS = 'MacroComponent';
-
-############
-sub set_up {
-############
- # Run before each test
-}
-
-###############
-sub tear_down {
-###############
- # Run after each test
-}
-
-# Within tests, use:
-# $self->assert(<boolean>[,<message>]);
-# $self->assert(qr/<pattern>/, $result);
-# $self->assert(sub {$_[0] == $_[1] || die "Expected $_[0], got $_[1]"},
-# 1, 2);
-# $self->fail(); # Should not have gotten here
-
-
-######################
-sub test_constructor {
-######################
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
-
- # Make sure creation succeeded
- $self->assert(defined($rdb), "Couldn't create RDB: $@");
-
- # Make sure we got the right type of object
- $self->assert(qr/NOCpulse::ReleaseDB=/, "$rdb");
-
- # Make sure we can talk to the database (autoconnect is on
- # by default)
- my $rv = $rdb->execute('SELECT sysdate FROM dual', [qw(dual)], FETCH_SINGLE);
- $self->assert(keys %$rv);
-
-
-}
-
-
-
-########################################
-sub test_create_select_component_class {
-########################################
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
-
- my $table = 'component_class';
- my $testcol = 'CLASS';
- my $testval = 'ReleaseDB_Test';
-
- my $rv = $rdb->create_component_class(
- $testcol => $testval,
- DESCRIPTION => 'Unit test record, please ignore'
- );
- $self->assert($rv, "Failed to create $table record");
-
-
- my $rec = $rdb->select_component_class($testcol => $testval);
- $self->assert($rec->{$testcol} eq $testval,
- "Bad value for $testcol (expected '$testval', " .
- "got '$rec->{$testcol}')");
-
-}
-
-
-
-
-
-####################################################
-sub test_create_select_shitload_of_related_records {
-####################################################
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
-
- # Values for all records
- my $boxtype = 'Linux';
- my $boxname = 'ReleaseDB_Test';
- my $mname = 'ReleaseDB_Macro';
- my $rversion = '0.BOGUS_REL';
- my $rnumber = 0;
- my $cname = 'ReleaseDB_Component';
- my $cversion = '0.0.0.BOGUS';
- my $branch = 'BOGUS';
- my($table, $testcol, $testval, $rv, $rec);
-
- # COMPONENT record for the macro
- $table = 'component';
- $testcol = 'NAME';
- $testval = $mname;
-
- $rv = $rdb->create_component(
- CLASS => $MCLASS,
- $testcol => $testval,
- );
- $self->assert($rv, "Failed to create $table record");
-
-
- $rec = $rdb->select_component(CLASS => $MCLASS, $testcol => $testval);
- $self->assert($rec->{$testcol} eq $testval,
- "Bad value for $testcol (expected '$testval', " .
- "got '$rec->{$testcol}')");
-
-
- # COMPONENT record for the macro member
- $table = 'component';
- $testcol = 'NAME';
- $testval = $cname;
-
- $rv = $rdb->create_component(
- CLASS => $CCLASS,
- $testcol => $testval,
- );
- $self->assert($rv, "Failed to create $table record");
-
-
- $rec = $rdb->select_component(CLASS => $CCLASS, $testcol => $testval);
- $self->assert($rec->{$testcol} eq $testval,
- "Bad value for $testcol (expected '$testval', " .
- "got '$rec->{$testcol}')");
-
-
-
- # MACRO_COMPONENT record
- $table = 'macro_component';
- $testcol = 'COMPONENT_NAME';
- $testval = $cname;
-
- $rv = $rdb->create_macro_component(
- MACRO_CLASS => 'BOOGA', # Should be overriden
- MACRO_NAME => $mname,
- COMPONENT_CLASS => $CCLASS,
- $testcol => $testval,
- );
- $self->assert($rv, "Failed to create $table record");
-
- $rec = $rdb->select_macro_component(
- MACRO_CLASS => $MCLASS,
- MACRO_NAME => $mname,
- COMPONENT_CLASS => $CCLASS,
- $testcol => $testval,
- );
- $self->assert($rec->{$testcol} eq $testval,
- "Bad value for $testcol (expected '$testval', " .
- "got '$rec->{$testcol}')");
-
-
-
- # COMPONENT_VERSION record
- $table = 'component_version';
- $testcol = 'COMPONENT_NAME';
- $testval = $cname;
-
- $rv = $rdb->create_component_version(
- COMPONENT_CLASS => $CCLASS,
- $testcol => $testval,
- COMPONENT_VERSION => $cversion,
- CVS_BRANCH => $branch,
- PACKAGE_FILENAME => 'booga',
- );
- $self->assert($rv, "Failed to create $table record");
-
- $rec = $rdb->select_component_version(
- COMPONENT_CLASS => $CCLASS,
- $testcol => $testval,
- COMPONENT_VERSION => $cversion,
- CVS_BRANCH => $branch,
- );
- $self->assert($rec->{$testcol} eq $testval,
- "Bad value for $testcol (expected '$testval', " .
- "got '$rec->{$testcol}')");
-
- # - Check default
- $self->assert(qr/-.*-/, $rec->{'BUILD_DATE'});
-
-
-
- # COMPONENT_VERSION_DEPENDENCY record
- $table = 'component_version_dependency';
- $testcol = 'COMPONENT_NAME';
- $testval = $cname;
-
- $rv = $rdb->create_component_version_dependency(
- COMPONENT_CLASS => $CCLASS,
- $testcol => $testval,
- COMPONENT_VERSION => $cversion,
- TYPE => 'requires',
- RESOURCE_NAME => 'booga',
- CVS_BRANCH => $branch,
- );
- $self->assert($rv, "Failed to create $table record");
-
- $rec = $rdb->select_component_version_dependency(
- COMPONENT_CLASS => $CCLASS,
- $testcol => $testval,
- COMPONENT_VERSION => $cversion,
- TYPE => 'requires',
- RESOURCE_NAME => 'booga',
- CVS_BRANCH => $branch,
- );
- $self->assert($rec->{$testcol} eq $testval,
- "Bad value for $testcol (expected '$testval', " .
- "got '$rec->{$testcol}')");
-
-
- # BOX record
- $table = 'box';
- $testcol = 'BOX_NAME';
- $testval = $boxname;
-
- $rv = $rdb->create_box(
- BOX_TYPE => $boxtype,
- $testcol => $testval,
- MACRO_CLASS => $MCLASS,
- MACRO_NAME => $mname,
- );
- $self->assert($rv, "Failed to create $table record");
-
-
- $rec = $rdb->select_box(
- BOX_TYPE => $boxtype,
- $testcol => $testval,
- );
- $self->assert($rec->{$testcol} eq $testval,
- "Bad value for $testcol (expected '$testval', " .
- "got '$rec->{$testcol}')");
-
- # - Check default
- $self->assert(qr/-.*-/, $rec->{'LAST_UPDATE_DATE'});
-
-
- # RELEASE record
- $table = 'release';
- $testcol = 'VERSION';
- $testval = $rversion;
-
- $rv = $rdb->create_release(
- BOX_TYPE => $boxtype,
- BOX_NAME => $boxname,
- VERSION => $rversion,
- RELEASE_NUMBER => $rnumber,
- );
- $self->assert($rv, "Failed to create $table record");
-
- $rec = $rdb->select_release(
- BOX_TYPE => $boxtype,
- BOX_NAME => $boxname,
- VERSION => $rversion,
- RELEASE_NUMBER => $rnumber,
- );
- $self->assert($rec->{$testcol} eq $testval,
- "Bad value for $testcol (expected '$testval', " .
- "got '$rec->{$testcol}')");
-
- # - Check defaults
- $self->assert(qr/-.*-/, $rec->{'RELEASE_DATE'});
- $self->assert($rec->{'RELEASED'} eq 0, "Failed to default RELEASED");
-
-
- # RELEASE_COMPONENT_VERSION record
- $table = 'release';
- $testcol = 'BOX_NAME';
- $testval = $boxname;
-
- $rv = $rdb->create_release_component_version(
- BOX_TYPE => $boxtype,
- $testcol => $testval,
- VERSION => $rversion,
- RELEASE_NUMBER => $rnumber,
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => $cname,
- COMPONENT_VERSION => $cversion,
- CVS_BRANCH => $branch
- );
- $self->assert($rv, "Failed to create $table record");
-
- $rec = $rdb->select_release_component_version(
- BOX_TYPE => $boxtype,
- $testcol => $testval,
- VERSION => $rversion,
- RELEASE_NUMBER => $rnumber,
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => $cname,
- COMPONENT_VERSION => $cversion,
- CVS_BRANCH => $branch
- );
- $self->assert($rec->{$testcol} eq $testval,
- "Bad value for $testcol (expected '$testval', " .
- "got '$rec->{$testcol}')");
-
-
- # Test deletion of an entire release
- $rv = $rdb->delete_whole_release(
- BOX_TYPE => $boxtype,
- BOX_NAME => $boxname,
- VERSION => $rversion,
- RELEASE_NUMBER => $rnumber,
- );
-
- $self->assert($rv, "Failed to delete $boxname $rversion-$rnumber release");
-
-
-}
-
-
-###################
-sub test_deletion {
-###################
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
- my $rv;
-
- # Test deletion
- my $class = 'BOGUS_DELTEST';
- my $ctemp = 'BOGUS_DELTEST%d';
-
-
- # Create a COMPONENT_CLASS record to parent COMPONENT records
- $rv = $rdb->create_component_class(
- CLASS => $class,
- DESCRIPTION => 'Unit test record, please ignore',
- );
- $self->assert($rv, "Failed to create COMPONENT_CLASS record");
-
-
-
- # - Create COMPONENT records to delete
- for (my $i = 0; $i < 3; $i++) {
- $rv = $rdb->create_component(
- CLASS => $class,
- NAME => sprintf($ctemp, $i),
- );
- $self->assert($rv, "Failed to create component record $i");
- }
-
-
- # - Single-row deletion
- # - with insufficient data (should fail)
- my $err;
- try {
-
- $rv = $rdb->delete_component(
- CLASS => $class,
- );
-
- } catch NOCpulse::Probe::DataSource::ConfigError with {
-
- $err = 1;
-
- };
- $self->assert($err, "Single record deletion (missing key) failed to fail");
-
-
- # - with data (should succeed)
- $rv = $rdb->delete_component(
- CLASS => $class,
- NAME => sprintf($ctemp, 0),
- );
- $self->assert($rv, "Failed to delete component record 0");
-
-
-
- # - Multiple-row deletion
- $rv = $rdb->delete_components(
- CLASS => $class,
- );
- $self->assert($rv == 2, "Expected to delete 2 records, deleted $rv");
-
-}
-
-
-
-##########################
-sub test_macro_selection {
-##########################
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
-
- my $versions = $self->create_multilevel_macro($rdb);
- my $expected = scalar(keys %$versions);
-
- # Fetch macro components
- my $rv = $rdb->expand_macro(
- MACRO_NAME => 'TOP_MACRO',
- RECURSIVE => 1,
- );
- $self->assert(scalar(@$rv) == 6,
- "ALL COMPONENTS: expected 6, got " . scalar(@$rv) . "\n");
-
-
- $rv = $rdb->expand_macro(
- MACRO_NAME => 'TOP_MACRO',
- RECURSIVE => 1,
- MACRO_ONLY => 1,
- );
- $self->assert(scalar(@$rv) == 2,
- "MACRO COMPONENTS: expected 2, got " . scalar(@$rv) . "\n");
-
-
- $rv = $rdb->expand_macro(
- MACRO_NAME => 'TOP_MACRO',
- RECURSIVE => 1,
- NO_MACRO => 1,
- );
- $self->assert(scalar(@$rv) == 4,
- "NON-MACRO COMPONENTS: expected 4, got " . scalar(@$rv) . "\n");
-
-}
-
-
-
-#############################
-sub test_macro_verification {
-#############################
-
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
-
- # NONEXISTENT MACRO (should fail)
- my $err = 0;
- try {
-
- $rdb->verify_macro_components(MACRO_NAME => 'NOSUCHMACRO');
-
- } catch NOCpulse::Probe::DataSource::ConfigError with {
-
- $err = 1;
-
- };
- $self->assert($err, "Nonexistent macro verification failed to fail");
-
- my $version = $self->create_multilevel_macro($rdb);
-
- # TOP_MACRO verification (should succeed)
- my $rv = $rdb->verify_macro_components(MACRO_NAME => 'TOP_MACRO');
-
- # Now delete the COMPONENT_VERSION records for a component and try again
- $rv = $rdb->execute("DELETE FROM component_version
- WHERE component_name = ?",
- 'component_version', FETCH_ROWCOUNT,
- 'SUB_SUB_COMPONENT');
- $self->assert($rv, "Failed to delete COMPONENT_VERSION record ($rv)\n");
-
-
- $err = 0;
- try {
-
- $rv = $rdb->verify_macro_components(MACRO_NAME => 'TOP_MACRO');
-
- } catch NOCpulse::Probe::DataSource::CommandFailedError with {
-
- $err = 1;
-
- };
- $self->assert($err, "Macro component verification failed to fail");
-
-
-}
-
-
-########################################
-sub test_select_current_macro_versions {
-########################################
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
-
- my $versions = $self->create_multilevel_macro($rdb);
- my $expected = scalar(keys %$versions);
-
- my $rv = $rdb->select_current_macro_versions(MACRO_NAME => 'TOP_MACRO');
-
-
- $self->assert(scalar(@$rv) == $expected,
- "Expected $expected component_version records, got " . scalar(@$rv));
-
- foreach my $rec (@$rv) {
- my $name = $rec->{'COMPONENT_NAME'};
- my $ver = $rec->{'COMPONENT_VERSION'};
- my $exp = $versions->{$name}->[0];
-
- $self->assert($ver eq $exp, "Expected $name version $exp, got $ver");
- }
-
-}
-
-
-#######################
-sub test_make_release {
-#######################
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
-
- my $boxname = 'TESTBOX';
- my $boxtype = 'Linux';
- my $macro = 'TOP_MACRO';
- my $version = '1.0BOGUS';
- my $relnum = 0;
- my $user = 'UNIT_TEST';
-
- # Create a macro
- my $versions = $self->create_multilevel_macro($rdb);
- my $expected = scalar(keys %$versions);
-
- # Create a box to build
- my $rv = $rdb->create_box(
- BOX_NAME => $boxname,
- BOX_TYPE => $boxtype,
- MACRO_NAME => $macro,
- LAST_UPDATE_USER => $user,
- );
- $self->assert($rv, "Failed to create BOX record\n");
-
- $rv = $rdb->make_release(
- BOX_NAME => $boxname,
- BOX_TYPE => $boxtype,
- MACRO_NAME => $macro,
- VERSION => $version,
- RELEASE_NUMBER => $relnum,
- RELEASE_USER => $user,
- );
- my $nrec = scalar(@$rv);
- $self->assert($nrec == $expected, "make_release failure: expected $expected records, got $nrec\n");
-
- $rv = $rdb->select_release(
- BOX_NAME => $boxname,
- BOX_TYPE => $boxtype,
- VERSION => $version,
- RELEASE_NUMBER => $relnum,
- );
- $self->assert(defined($rv), "make_release/select_release failure\n");
-
-
- $rv = $rdb->select_release_components(
- BOX_NAME => $boxname,
- BOX_TYPE => $boxtype,
- VERSION => $version,
- RELEASE_NUMBER => $relnum,
- );
- $nrec = scalar(@$rv);
- $self->assert($nrec == $expected, "make_release failure: expected $expected records, got $nrec\n");
-
- my $cname = $rv->[0]->{'COMPONENT_NAME'};
- my $c_ver = $rv->[0]->{'COMPONENT_VERSION'};
- my $e_ver = $versions->{$cname}->[0];
- $self->assert($c_ver eq $e_ver, "make_release failure: component $cname, expected version $e_ver, got version $c_ver\n");
-
-
-}
-
-
-#######################
-sub test_branch_merge {
-#######################
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
- my $trunk = 'UNIT_TEST_TRUNK';
- my $branch = 'UNIT_TEST_BRANCH';
- my $rv;
-
- # Create a macro
- my $versions = $self->create_multilevel_macro($rdb, $trunk);
- my $expected = scalar(keys %$versions);
-
- # Branch
- my $ncreated = $rdb->make_branch(
- TRUNK => $trunk,
- CVS_BRANCH => $branch,
- );
- $self->assert($ncreated, "Failed to create branch");
-
- # Verify that the branch succeeded
- $rv = $rdb->select_component_versions(
- CVS_BRANCH => $branch,
- );
- my $nselected = scalar(@$rv);
- $self->assert($nselected == $ncreated,
- "Branched $ncreated records, selected $nselected");
-
- # Make sure we branched the right records
- foreach my $rec (@$rv) {
- my $name = $rec->{'COMPONENT_NAME'};
- my $ver = $rec->{'COMPONENT_VERSION'};
- my $exp = $versions->{$name}->[0];
- $self->assert($ver eq $exp,
- "Branched $name record $ver, expected $exp");
- }
-
-
-
-
- # Delete a record from the branch and copy it from the main
- # to verify sub copy_to_branch()
- my($cname, $cversions) = each %$versions;
- my $cver = $cversions->[0]; # Delete latest version
- $rv = $rdb->delete_component_version(
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => $cname,
- COMPONENT_VERSION => $cver,
- CVS_BRANCH => $branch,
- );
- $self->assert($rv, "Failed to delete $cname $cver from '$branch' branch");
-
- my $rec = $rdb->select_component_version(
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => $cname,
- COMPONENT_VERSION => $cver,
- CVS_BRANCH => $branch,
- );
- $self->assert(! defined($rec), "Delete succeeded but there's still a " .
- "$cname $cver record on the '$branch' branch");
-
- my $ncopied = $rdb->copy_to_branch(
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => $cname,
- COMPONENT_VERSION => $cver,
- CVS_BRANCH => $branch,
- TRUNK => $trunk,
- );
- $self->assert($ncopied,
- "Failed to copy $cname $cver from '$trunk' to '$branch' branch");
-
- $rec = $rdb->select_component_version(
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => $cname,
- COMPONENT_VERSION => $cver,
- CVS_BRANCH => $branch,
- );
- $self->assert(defined($rec), "Copy succeeded but couldn't select " .
- "$cname $cver from '$branch' branch\n");
-
-
- # END OF BRANCH TESTS
-
-
- # BEGIN MERGE TESTS
-
- # Merge logic copies COMPONENT_VERSIONS to the branch thus:
- # a) Change on trunk, no change on branch: do nothing (trunk
- # is current)
- # b) Change on branch, no change on trunk: COPY LATEST VERSION
- # FROM BRANCH TO TRUNK.
- # c) Changes on branch and on trunk: do nothing (as a rebuild
- # on the trunk will be necessary, making the trunk current)
- # d) No changes: do nothing (trunk is current)
- #
- # Situation b) is indicated when the latest version on the trunk
- # exists on the branch and is not equal to the latest version on
- # the branch.
-
- my %merged_version;
-
- # Create the four situations above to test merging
-
- # a) Change on trunk, no change on branch
-
- # Component: TOP_COMPONENT
- $rv = $rdb->create_component_version(
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => 'TOP_COMPONENT',
- COMPONENT_VERSION => '1.1BOGUS-1',
- CVS_BRANCH => $trunk,
- );
- $self->assert($rv, "Failed to create TOP_COMPONENT record");
- $merged_version{'TOP_COMPONENT'} = '1.1BOGUS-1';
-
-
- # b) Change on branch, no change on trunk (SUB_COMPONENT)
- $rv = $rdb->create_component_version(
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => 'SUB_COMPONENT',
- COMPONENT_VERSION => '1.3BOGUS-1',
- CVS_BRANCH => $branch,
- );
- $self->assert($rv, "Failed to create SUB_COMPONENT record");
- $merged_version{'SUB_COMPONENT'} = '1.3BOGUS-1';
-
-
- # c) Changes on branch and on trunk (SUB_SUB_COMPONENT)
- $rv = $rdb->create_component_version(
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => 'SUB_SUB_COMPONENT',
- COMPONENT_VERSION => '2.0BOGUS-3',
- CVS_BRANCH => $branch,
- );
- $self->assert($rv, "Failed to create SUB_SUB_COMPONENT record (1)");
-
- $rv = $rdb->create_component_version(
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => 'SUB_SUB_COMPONENT',
- COMPONENT_VERSION => '2.1BOGUS-2',
- CVS_BRANCH => $trunk,
- );
- $self->assert($rv, "Failed to create SUB_SUB_COMPONENT record (2)");
- $merged_version{'SUB_SUB_COMPONENT'} = '2.1BOGUS-2';
-
- # d) No changes: do nothing (trunk is current) (SUB_SUB_COMPONENT2)
- $merged_version{'SUB_SUB_COMPONENT2'} = $versions->{'SUB_SUB_COMPONENT2'}->[0];
-
-
- # Do the merge
- $rv = $rdb->merge_branch(
- TRUNK => $trunk,
- CVS_BRANCH => $branch,
- );
- $self->assert($rv, "Merge failed");
-
-
- # Verify the merged records
- # Only one record (case b above) should've been merged
- $self->assert($rv == 1, "Expected 1 merge record, got $rv");
-
-
- foreach my $cname (sort keys %$versions) {
- $rv = $rdb->select_current_component_version(
- COMPONENT_NAME => $cname,
- CVS_BRANCH => $trunk,
- );
-
- my $expected = $merged_version{$cname};
- my $selected = $rv->[0]->{'COMPONENT_VERSION'};
-
- $self->assert($expected eq $selected, "After merge, expected version $expected of $cname on trunk, got version $selected");
-
-
- }
-
-
-}
-
-
-
-#################
-sub test_update {
-#################
- my $self = shift;
-
- my $rdb = NOCpulse::ReleaseDB->new();
-
- # Create records to update
- my $boxtype = 'Linux';
- my $boxname = 'ReleaseDB_Test';
- my $mname = 'ReleaseDB_Macro';
- my $teststr = 'BOOGA BOOGA BOOGA';
- my $rv;
-
- # COMPONENT record for the macro
- $rv = $rdb->create_component(
- CLASS => $MCLASS,
- NAME => $mname,
- );
- $self->assert($rv, "Failed to create component record");
-
- # BOX record
- $rv = $rdb->create_box(
- BOX_TYPE => $boxtype,
- BOX_NAME => $boxname,
- MACRO_CLASS => $MCLASS,
- MACRO_NAME => $mname,
- );
- $self->assert($rv, "Failed to create box record");
-
- # Update records
- $rv = $rdb->update_box(
- BOX_TYPE => $boxtype,
- BOX_NAME => $boxname,
- set => {
- POSTINSTALL => $teststr,
- PARTITIONING => $teststr,
- },
- );
- $self->assert($rv, "Failed to update box record");
-
- # Make sure record was updated
- my $rec = $rdb->select_box(
- BOX_TYPE => $boxtype,
- BOX_NAME => $boxname,
- );
-
- $self->assert($rec->{'POSTINSTALL'} eq $teststr,
- "Box record not updated: expected '$teststr', got " .
- "POSTINSTALL = '$rec->{POSTINSTALL}'");
-
- $self->assert($rec->{'PARTITIONING'} eq $teststr,
- "Box record not updated: expected '$teststr', got " .
- "PARTITIONING = '$rec->{PARTITIONING}'");
-
-
-}
-
-
-
-
-
-
-#######################
-# Utility subroutines #
-#######################
-sub create_simple_macro {
- my $self = shift;
-
- my($rdb, $MCLASS, $mname, @components) = @_;
-
- # COMPONENT record for the macro
- my $rv = $rdb->create_component(
- CLASS => $MCLASS,
- NAME => $mname
- );
- $self->assert($rv, "Failed to create $mname record");
-
-
- # COMPONENT record for the macro member(s)
- while (@components) {
- my $CCLASS = shift(@components);
- my $cname = shift(@components);
- $rv = $rdb->create_component(
- CLASS => $CCLASS,
- NAME => $cname,
- );
- $self->assert($rv, "Failed to create $cname record");
-
- # MACRO_COMPONENT record
- $rv = $rdb->create_macro_component(
- MACRO_NAME => $mname,
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => $cname,
- );
- $self->assert($rv, "Failed to create MACRO_COMPONENT record");
- }
-
-
-}
-
-#############################
-sub create_multilevel_macro {
-#############################
- my $self = shift;
- my $rdb = shift;
- my $vbr = shift || 'main';
-
-
- # Version records to create -- LATEST FIRST
- my %version = (
- 'TOP_COMPONENT' => [qw(1.0BOGUS-1)],
- 'SUB_COMPONENT' => [qw(1.21.BOGUS-1 1.2.BOGUS-1)],
- 'SUB_SUB_COMPONENT' => [qw(2.0BOGUS-2 1.0BOGUS-1)],
- 'SUB_SUB_COMPONENT2' => [qw(3.4BOGUS-2 2.9BOGUS-1)],
- );
-
- # COMPONENT record for the top macro
- my $rv = $rdb->create_component(
- CLASS => $MCLASS,
- NAME => 'TOP_MACRO'
- );
- $self->assert($rv, "Failed to create TOP_MACRO COMPONENT record");
-
-
- # COMPONENT record for the top macro member
- $rv = $rdb->create_component(
- CLASS => $CCLASS,
- NAME => 'TOP_COMPONENT',
- );
- $self->assert($rv, "Failed to create TOP_COMPONENT COMPONENT record");
-
-
- # COMPONENT record for the sub macro
- $rv = $rdb->create_component(
- CLASS => $MCLASS,
- NAME => 'SUB_MACRO'
- );
- $self->assert($rv, "Failed to create SUB_MACRO COMPONENT record");
-
-
- # COMPONENT record for the sub macro member
- $rv = $rdb->create_component(
- CLASS => $CCLASS,
- NAME => 'SUB_COMPONENT',
- );
- $self->assert($rv, "Failed to create SUB_COMPONENT COMPONENT record");
-
-
- # COMPONENT record for the sub sub macro
- $rv = $rdb->create_component(
- CLASS => $MCLASS,
- NAME => 'SUB_SUB_MACRO'
- );
- $self->assert($rv, "Failed to create SUB_SUB_MACRO COMPONENT record");
-
-
- # COMPONENT records for the sub sub macro members
- $rv = $rdb->create_component(
- CLASS => $CCLASS,
- NAME => 'SUB_SUB_COMPONENT',
- );
- $self->assert($rv, "Failed to create SUB_SUB_COMPONENT COMPONENT record");
-
- $rv = $rdb->create_component(
- CLASS => $CCLASS,
- NAME => 'SUB_SUB_COMPONENT2',
- );
- $self->assert($rv, "Failed to create SUB_SUB_COMPONENT2 COMPONENT record");
-
-
- # MACRO_COMPONENT records for the top macro
- $rv = $rdb->create_macro_component(
- MACRO_NAME => 'TOP_MACRO',
- COMPONENT_CLASS => $MCLASS,
- COMPONENT_NAME => 'SUB_MACRO',
- );
- $self->assert($rv, "Failed to create SUB_MACRO MACRO_COMPONENT record");
-
- $rv = $rdb->create_macro_component(
- MACRO_NAME => 'TOP_MACRO',
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => 'TOP_COMPONENT',
- );
- $self->assert($rv, "Failed to create TOP_COMPONENT MACRO_COMPONENT record");
-
- # Create MACRO_COMPONENT record for the sub macro
- $rv = $rdb->create_macro_component(
- MACRO_NAME => 'SUB_MACRO',
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => 'SUB_COMPONENT',
- );
- $self->assert($rv, "Failed to create SUB_COMPONENT MACRO_COMPONENT record");
-
- # Create MACRO_COMPONENT record for the sub macro
- $rv = $rdb->create_macro_component(
- MACRO_NAME => 'SUB_MACRO',
- COMPONENT_CLASS => $MCLASS,
- COMPONENT_NAME => 'SUB_SUB_MACRO',
- );
- $self->assert($rv, "Failed to create SUB_SUB_MACRO MACRO_COMPONENT record");
-
- # Create MACRO_COMPONENT record for the sub macro
- $rv = $rdb->create_macro_component(
- MACRO_NAME => 'SUB_SUB_MACRO',
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => 'SUB_SUB_COMPONENT',
- );
- $self->assert($rv, "Failed to create SUB_SUB_COMPONENT MACRO_COMPONENT record");
-
- # Create MACRO_COMPONENT record for the sub macro
- $rv = $rdb->create_macro_component(
- MACRO_NAME => 'SUB_SUB_MACRO',
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => 'SUB_SUB_COMPONENT2',
- );
- $self->assert($rv, "Failed to create SUB_SUB_COMPONENT2 MACRO_COMPONENT record");
-
-
-
-
- # Create COMPONENT_VERSION records
- foreach my $comp (keys %version) {
- foreach my $version (@{$version{$comp}}) {
-
- $rv = $rdb->create_component_version(
- COMPONENT_CLASS => $CCLASS,
- COMPONENT_NAME => $comp,
- COMPONENT_VERSION => $version,
- CVS_BRANCH => $vbr,
- );
- $self->assert($rv, "Failed to create $comp $version COMPONENT_VERSION record");
- }
- }
-
- return \%version;
-
-}
-
-
-
-
-1;
diff --git a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/tst b/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/tst
deleted file mode 100755
index 628e648..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/ReleaseDB/tst
+++ /dev/null
@@ -1,20 +0,0 @@
-#!/usr/bin/perl
-
-# tst - simple template for using ReleaseDB with debug capability
-
-use Data::Dumper;
-use NOCpulse::ReleaseDB;
-use Getopt::Long;
-use NOCpulse::Log::LogManager;
-
-my %args = ();
-GetOptions(\%args, ('log=s%')) or die;
-
-NOCpulse::Log::LogManager->instance->configure(%{$args{log}});
-
-
-my $rdb = new NOCpulse::ReleaseDB();
-
-
-# Do stuff here
-print $rdb->ver2str('1.4a12-1'), "\n";
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/BUILD b/monitoring/PerlModules/NP/NOT-USED/Spread/BUILD
deleted file mode 100644
index abddb56..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/BUILD
+++ /dev/null
@@ -1,51 +0,0 @@
-# Macros
-
-%define cvs_package PerlModules/NP/Spread
-
-# Package specific stuff
-Name: NOCpulse-Spread
-Version: 1.10.0
-Release: 1
-Packager: Karen Jacqmin-Adams <kja(a)redhat.com>
-Summary: %{name} network utilities
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Group: unsorted
-Copyright: (c) 2002-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Buildroot: %{_tmppath}/%cvs_package
-Prefix: %{_our_prefix}
-
-%description
-
-NOCpulse-Spread provides NP authored libraries and utilities for the
-Spread network.
-
-%prep
-%entirely_abstract_build_step
-
-%build
-echo "Nothing to build"
-
-%install
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-%find_perl_installsitelib
-
-mkdir -p $RPM_BUILD_ROOT$installsitelib/NOCpulse
-
-cp SpreadNetwork.pm $RPM_BUILD_ROOT$installsitelib/NOCpulse
-cp SpreadServers.pm $RPM_BUILD_ROOT$installsitelib/NOCpulse
-cp Filters.pm $RPM_BUILD_ROOT$installsitelib/NOCpulse
-
-%point_scripts_to_correct_perl
-
-%make_file_list
-
-%files -f %{name}-%{version}-%{release}-filelist
-%defattr(-,root,root,-)
-
-
-%clean
-
-%abstract_clean_script
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/Filters.pm b/monitoring/PerlModules/NP/NOT-USED/Spread/Filters.pm
deleted file mode 100644
index 6de5309..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/Filters.pm
+++ /dev/null
@@ -1,112 +0,0 @@
-package Filter;
-use NOCpulse::Object;
-@ISA=qw(NOCpulse::Object);
-
-sub initialize
-{
- my ($self,$next) = @_;
- $self->SUPER::initialize();
- $self->set_next($next);
- if (defined($next)) {
- $next->set_prev($self);
- }
- return $self;
-}
-
-sub instVarDefinitions
-{
- my $self = shift;
- $self->addInstVar('next');
- $self->addInstVar('prev');
- $self->addInstVar('tailCache');
-}
-
-sub tail
-{
- my $self = shift();
- if (! defined($self->get_next)) {
- return $self;
- } else {
- if (! $self->get_tailCache) {
- $self->set_tailCache($self->get_next->tail);
- }
- return $self->get_tailCache;
- }
-}
-
-
-sub _encode
-{
- my ($self,$string) = @_;
- # Abstract - subclasses should override
- return $string;
-}
-
-sub _decode
-{
- my ($self,$string) = @_;
- # Abstract - subclasses should override
- return $string;
-}
-
-sub encode
-{
- my ($self,$string) = @_;
- $string = $self->_encode($string);
- if (defined($self->get_next)) {
- return $self->get_next->encode($string);
- } else {
- return $string;
- }
-}
-
-sub decode
-{
- my ($self,$string) = @_;
- $string = $self->_decode($string);
- if (defined($self->get_prev)) {
- return $self->get_prev->decode($string);
- } else {
- return $string;
- }
-}
-
-package BlowfishFilter;
-@ISA=qw(Filter);
-use strict;
-use Crypt::CBC;
-
-sub initialize
-{
- my ($self,$next,$key) = @_;
- $self->set_cipher(
- Crypt::CBC->new( {
- 'key' => $key,
- 'cipher' => 'Blowfish',
- 'regenerate_key' => 1
- } )
- );
- return $self->SUPER::initialize($next);
-}
-
-sub instVarDefinitions
-{
- my $self = shift();
- $self->SUPER::instVarDefinitions;
- $self->addInstVar('cipher');
-}
-
-sub _encode
-{
- my ($self,$string) = @_;
- return $self->get_cipher->encrypt($string);
-}
-
-sub _decode
-{
- my ($self,$string) = @_;
- return $self->get_cipher->decrypt($string);
-}
-
-1
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/SpreadNetwork.pm b/monitoring/PerlModules/NP/NOT-USED/Spread/SpreadNetwork.pm
deleted file mode 100644
index f5eb23a..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/SpreadNetwork.pm
+++ /dev/null
@@ -1,944 +0,0 @@
-use Spread qw(:MESS); # Need to export message service types
-
-
-=head1 NAME
-
-SpreadNetwork - a collection of classes for working with Spread networks
-
-=item
-
-=head1 SYNOPSIS
-
-
-
-my $connection = SpreadConnection->newInitialized({
- 'privateName'=>'mycon',
- 'readTimeout'=>90
- });
-
-SpreadMessage->newInitialized({
- 'contents'=>'hello world',
- 'addressee'=>['someone']
- })->sendVia($connection);
-
-$message = $connection->nextMessage;
-
-
-=head1 DESCRIPTION
-
-=over
-=item
-SpreadNetwork defines three classes: SpreadConnection, SpreadMessage, and SpreadMembershipInfo, thus:
-
-=item
-SpreadConnection - a class who's instances encapsulate all interaction with the spread network. It
-is capable of generating instances of SpreadMessage.
-
-=item
-SpreadMessage - a class who's instances represent a message received from the spread network. SpreadMessage
-is capable of generating instances of SpreadMembershipInfo.
-
-=item
-SpreadObjectMessage - a class who's instances serialize themselves when encoded and deserialize when
-decoded. (This is just a subclass of SpreadMessage that overrides encode() and decoded())
-
-=item
-SpreadMembershipInfo - a class who's instances encapsulate all the logic required to understand Spread
-membership messages.
-
-=item
-For more information on spread proper see http://www.spread.org/docs/docspread.html
-
-=back
-
-=head1 CLASS SpreadConnection
-
-=head2 Instance variables
-
-All instance variables are accessable by calling get_xxx (where xxx is the instance variable name). All instance variables are settable by calling set_xxx. All instance variable values can be set on construction by passing a hash reference in with key-value pairs appropriately (see newInitialized)
-
-=item
-mbox [default=undef]: The filehandle of connection to spread. This is mostly meaningful only to the SpreadConnection class.
-
-=item
-mailbox [default=undef]: The fully qualified private group name per Spread::connect()
-
-=item
-address [default='127.0.0.1']: The address of Spread server to connect to
-
-=item
-port [default=4803]: The port to connect to on address
-
-=item
-privateName [default=undef]: The unqualified private group name per constructor
-
-=item
-priority [default=0]: Currently undefined (no effect).
-
-=item
-receiveMembershipInfo [default=0]: Whether or not to receive membership messages
-
-=item
-joinedGroups [default={}]: List of all groups this connection belongs to
-
-=item
-readTimeout [default=60]: Seconds before timeout in nextMessage (0 = infinite)
-
-=item
-doAutoDisconnect [default=1]: If true, disconnect when connection object is destroyed
-
-=item
-discardSelfMessages [default=0]: If true, messages from self are discarded
-
-=head2 Class Methods
-
-=item newInitialized({key=>value,[...]}): Takes as it's argument a ref to a hash that contains key-value pairs describing initial instance variable values. Returns an instance of SpreadConnection where the instance will (barring erorrs) be connected to the spread network.
-
-=head2 Instance Methods
-
-=item
-spreadError(): returns spread error number for the last operation
-
-=item
-spreadErrorMessage(): returns spread error message for the last operation
-
-=item
-connect({key=>value,[...]}): Called by the constructor (so you normally won't need to call this). Takes as it's parameter a ref to a hash that contains instance variable key-value pairs.
-
-=item
-disconnect(): Call this to explicity disconnect from the spread network.
-
-=item
-reconnect(): Call this to reconnect to the spread network. This method first ensures the instance is disconnected by calling disconnect(), then attempts to connect via connect(). Once it succeeds, it re-joins all groups that the connection had been joined to prior to the call. Note that this method contains a loop - it will try forever if there's some problem talking to the spread server.
-
-=item
-isConnected(): Returns true if the connection is connected, false if it isn't.
-
-=item
-join('groupname1'[,'groupname2'[,'groupnameN']]): Causes the connection to join whatever group(s) are provided.
-
-=item
-leave('groupname1'[,'groupname2'[,'groupnameN']]): Causes the connection to leave whatever group(s) are provided.
-
-=item
-send($message): Sends the instance of SpreadMessage you pass in.
-
-=item
-incomingBytes(): Returns however many bytes are waiting to be received by this connection.
-
-=item
-messageWaiting(): Returns true if there's more than 0 incomingBytes().
-
-=item
-nextMessage(aClass): Returns the next message from the connection in the form of an instance of either SpreadMessage or whatever class name you pass in (assumes that you pass in the name of a class that answers all of SpreadMessage's protocols). If messageWaiting() is false at the time of the call, this will be a blocking call up to readTimeout seconds. If discardSelfMessages is true, a message from self will cause this method to return undef.
-
-=item
-DESTROY(): If doAutoDisconnect is true (which is the default), the object will do a Spread::disconnect before it is garbage collected.
-
-
-=head1 CLASS SpreadMessage
-
-=head2 Instance variables
-
-All instance variables are accessable by calling get_xxx (where xxx is the instance variable name). All instance variables are settable by calling set_xxx. All instance variable values can be set on construction by passing a hash reference in with key-value pairs appropriately (see newInitialized)
-
-=item
-serviceType [default= SAFE_MESS]: One of AGREED_MESS, CAUSAL_MESS, FIFO_MESS, RELIABLE_MESS, SAFE_MESS, TRANSITION_MESS, UNRELIABLE_MESS (see Spread documentation)
-
-=item
-addressee [default=undef]: List of one or more recipients for this message
-
-=item
-type [default=0]: A 16 bit "subject" field - currently unused by this framework (and thus available). In the future this framework might implement an optional "large message mode" that would claim all or some of these bits.
-
-=item
-contents [default=undef]: Message contents - can be up to maxMessageSize bytes. Returns true (1) if the contents were actually set. They might not have been if the message is greater than maxMessageSize bytes and failOversizeMessages is true, in which case returns 0. Also, if truncateOversizeMessages is true, the contents might have been truncated - if this happened, the return will be 2.
-
-=item
-sender [default=undef]: Only meaningful for inbound messages - contains the private name of the sender
-
-=item
-endian [default=undef]: Whether or not there's an endian mismatch between the machine the sender of this message is on and the current machine
-
-=item
-maxMessageSize [default=100000]: Max content size for a message. This is something of a "mysterious" value in the spread world - see Spread documentation for details. The default value should work in most situations.
-
-=item
-failOversizeMessages [default=0]: If this is true, behavior of set_contents changes. See contents (above)
-
-=item
-truncateOversizeMessages [default=1]: If this is true, behavior of set_contents changes. See contents (above)
-
-=item
-oversizeContents [default=0]: True if too much data was given to set_contents
-
-=head2 Class Methods
-
-=item newInitialized({key=>value,[...]}): Takes as it's argument a ref to a hash that contains key-value pairs describing initial instance variable values. Returns an instance of SpreadMessage.
-
-=head2 Instance Methods
-
-=item
-NextFrom(<aSpreadConnection>): Another way to say $connection->nextMessage(aClass). In this case aClass will be whatever class the caller is an instance of.
-
-=item
-sendVia(<aSpreadConnection>): Sends this message via aSpreadConnection
-
-=item
-encoded(): Returns contents encoded appropriately. Base class returns contents, subclasses can override
-
-=item
-decoded(): Decode message contents appropriately and return decoded instance. Base does nothing and returns
-self. Subclasses can override. Bear in mind that whatever is returned from this method is what nextMessage
-returns!
-
-=item
-asObject(): If the contents of the message are a perl entity serialized by the FreezeThaw package, returns the object in question, otherwise returns the contents as they are.
-
-=item
-isAgreed(): Returns true if this is an AGREED_MESS (see Spread docs for details)
-
-=item
-isCausal(): Returns true if this is a CAUSAL_MESS (see Spread docs for details)
-
-=item
-isFifo(): Returns true if this is a FIFO_MESS (see Spread docs for details)
-
-=item
-isMembership(): Returns true if this is a MEMBERSHIP_MESS (see Spread docs for details). If this is true, membershipInfo will return an instance of SpreadMembershipInfo.
-
-=item
-isRegular(): Returns true if this is a REGULAR_MESS (see Spread docs for details)
-
-=item
-isReliable(): Returns true if this is a RELIABLE_MESS (see Spread docs for details)
-
-=item
-isSafe(): Returns true if this is a SAFE_MESS (see Spread docs for details)
-
-=item
-isUnreliable(): Returns true if this is an UNRELIABLE_MESS (see Spread docs for details)
-
-=item
-setAgreed(): Sets serviceType to AGREED_MESS (see Spread docs for details)
-
-=item
-setCausal(): Sets serviceType to CAUSAL_MESS (see Spread docs for details)
-
-=item
-setFifo(): Sets serviceType to FIFO_MESS (see Spread docs for details)
-
-=item
-setReliable(): Sets serviceType to RELIABLE_MESS (see Spread docs for details)
-
-=item
-setSafe(): Sets serviceType to SAFE_MESS (see Spread docs for details)
-
-=item
-setUnreliable(): Sets serviceType to UNRELIABLE_MESS (see Spread docs for details)
-
-=item
-membershipInfo(): If $message->isMembership, returns an instance of SpreadMembershipInfo
-
-=head1 CLASS SpreadMembershipInfo
-
-=head2 Instance variables
-
-All instance variables are accessable by calling get_xxx (where xxx is the instance variable name). All instance variables are settable by calling set_xxx.
-
-=item
-message [default=undef]: Contains the message from which the info is derived
-
-=item
-groupId [default=[] ]: Contains the three-byte group id of the group that had the membership change.
-
-=item
-numMembers [default=0]: Contains the number of members in the group
-
-=item
-transMembers [default='']: Contains a list of the members involved in the transition.
-
-=head2 Class Methods
-
-=item newInitialized(<aSpreadMessage>): Takes as it's argument an instance of SpreadMessage, returns an instance of SpreadMembershipInfo
-
-=head2 Instance Methods
-
-=item
-isSelfLeave(): True if this is a "self leave" message
-
-=item
-get_serviceType():
-
-=item
-isRegularMembership(): True if this is a "regular membership" message
-
-=item
-isTransition(): True if this is a "transition" message - in this case the only other valid question to ask is groupInQuestion() (below).
-
-=item
-isCausedByJoin(): True if this membership message was caused by someone joining the groupInQuestion().
-
-=item
-isCausedByLeave(): True if this membership message was caused by someone leaving the groupInQuestion().
-
-=item
-isCausedByDisconnect(): True if this membership message was caused by someone disconnecting (and thus leaving the groupInQuestion()).
-
-=item
-isCausedByNetwork(): True if this membership message was caused by a network partition (and thus having potentially several connections leave the groupInQuestion()).
-
-=item
-groupInQuestion(): Returns the group in which the membership change occurred.
-
-=item
-whoDisconnected(): Returns the name of the connection that disconnected.
-
-=item
-whoJoined(): Returns the name of the connection that joined.
-
-=item
-whoLeft(): Returns the name of the connection that left.
-
-=item
-whoIsNotPartitioned(): Returns a list of those connections that are NOT partitioned.
-
-=item
-whoIsInTheGroup(): Returns a list of those connections who are in the group as of this message
-
-=item
-isSelfJoin(<privateName>): True or false depending on whether or not the message was caused by the given private name's having joined a group
-
-=cut
-
-########################################################################################
-# CODE STARTS HERE
-########################################################################################
-
-package SpreadConnection;
-use Spread qw(:MESS :ERROR);
-use NOCpulse::Object;
-@ISA=qw(NOCpulse::Object);
-
-sub instVarDefinitions
-{
- my $self = shift();
- $self->addInstVar('mbox',undef); # filehandle of connection
- $self->addInstVar('mailbox',undef); # fully qualified private group naem
- $self->addInstVar('address','127.0.0.1'); # address of server to connect to
- $self->addInstVar('port',4803); # port to connect to
- $self->addInstVar('privateName',undef); # unqualified private group name per constructor
- $self->addInstVar('priority',0); # currently undefined (no effect)
- $self->addInstVar('receiveMembershipInfo',0); # whether or not to receive membership msgs
- $self->addInstVar('joinedGroups',{}); # list of all groups this connection belongs to
- $self->addInstVar('readTimeout',60); # seconds before timeout in nextMessage (0 = infinite)
- $self->addInstVar('doAutoDisconnect',1); # If true, disconnect when conn obj is destroyed
- $self->addInstVar('discardSelfMessages',0); # If true, messages from self are discarded
- $self->addInstVar('filter',undef); # Filter instance through which content will pass
- # To be implemented
- $self->addInstVar('autoSplitBigMessages',0); # If true, big msgs will be auto-split
-}
-
-sub initialize
-{
- my ($self,@params) = @_;
- $self->connect(@params);
- return $self;
-}
-
-sub spreadError
-{
- return $Spread::sperrno;
-}
-
-sub spreadErrorMessage
-{
- return "$Spread::sperrno";
-}
-
-sub connect
-{
- my ($self,$options) = @_;
- if (defined($options)) {
- # $options should be a hash containing any of
- # address,port,privateName,priority,receiveMembershipInfo
- my ($key,$value);
- while (($key,$value) = each(%$options)) {
- $self->set($key,$value);
- }
- }
- my $server = $self->get_port;
- if ($self->get_address) {
- $server = $server.'@'.$self->get_address;
- }
- my ($mbox,$mailbox) =
- Spread::connect({
- spread_name=>$server,
- private_name=>$self->get_privateName,
- priority=>$self->get_priority,
- group_membership=>$self->get_receiveMembershipInfo
- });
- if ($mbox) {
- # Strange situation requires this:
- # IF sperrno is nonzero when a successful
- # connection occurs (we get an MBOX number),
- # it seems that sperrno is not properly updated
- # by the library. So we clear it here. I strongly
- # suspect it's a problem with the perl to C
- # interface which I think is the XS stuff.
- $Spread::sperrno = 0;
- }
- $self->set_mbox($mbox);
- $self->set_mailbox($mailbox);
- return $self->isConnected;
-}
-
-sub disconnect
-{
- my $self = shift();
- my $result = 1;
- if ($self->get_mbox) {
- $result = Spread::disconnect($self->get_mbox);
- $self->set_mbox(undef);
- }
- return ($result == 0);
-}
-
-sub reconnect
-{
- my ($self,$attempts) = @_;
- # undef for attempts == infinite
- $self->disconnect;
- while (($attempts gt 0) or (! defined($attempts))) {
- sleep(1);
- if ($self->connect) {
- my $groupHash = $self->get_joinedGroups;
- my @groups = keys(%$groupHash);
- $self->set_joinedGroups({});
- $self->join(@groups);
- $attempts = 0;
- } else {
- if (defined($attempts)) {
- $attempts = $attempts - 1;
- }
- }
- }
- return $self->isConnected;
-}
-
-sub isConnected
-{
- my $self = shift();
- my $spreadError = $self->spreadError;
- # Other/different flags might be appropriate here as well.
- # Need to investigate. Note that Java classes don't appear
- # to try to answer this.
- my $badSession = ($spreadError == CONNECTION_CLOSED or
- $spreadError == ILLEGAL_SESSION or
- $spreadError == COULD_NOT_CONNECT or
- $spreadError == REJECT_NOT_UNIQUE);
- return ($self->get_mbox && (! $badSession));
-}
-
-sub _addGroup
-{
- my ($self,$groupName) = @_;
- my $groups = $self->get_joinedGroups;
- $groups->{$groupName} = time();
-}
-
-sub _delGroup
-{
- my ($self,$groupName) = @_;
- my $groups = $self->get_joinedGroups;
- delete($groups->{$groupName});
-}
-
-sub join
-{
- my ($self,@groupNames) = @_;
- return undef if (! $self->isConnected);
- my @joinedGroups = grep(
- Spread::join(
- $self->get_mbox,
- $_
- ),
- @groupNames
- );
- map($self->_addGroup($_),@joinedGroups);
- return (scalar(@joinedGroups) == scalar(@groupNames));
-}
-
-sub leave
-{
- my ($self,@groupNames) = @_;
- return undef if (! $self->isConnected);
- my @leftGroups = grep(
- Spread::leave(
- $self->get_mbox,
- $_
- ),
- @groupNames
- );
- map($self->_delGroup($_),@leftGroups);
- return (scalar(@leftGroups) == scalar(@groupNames));
-}
-
-sub filter
-{
- my ($self,$data) = @_;
- $self->dprint(3,'Filter input = '.$data."\n");
- if ($self->get_filter) {
- return $self->get_filter->encode($data);
- } else {
- return $data;
- }
-}
-
-sub unfilter
-{
- my ($self,$data) = @_;
- $self->dprint(3,'Un-Filter input = '.$data."\n");
- if ($self->get_filter) {
- return $self->get_filter->tail->decode($data);
- } else {
- return $data;
- }
-}
-
-sub send
-{
- my ($self,$message) = @_;
- return undef if (! $self->isConnected);
- my $contents = $message->encoded;
- $contents = $self->filter($contents);
- $self->dprint(9,"Sending $message to addressee(s)".$message->get_addressee."\n");
- my $addressee = $message->get_addressee;
- my @addrs;
- if (ref($addressee)) {
- @addrs = @$addressee;
- } elsif (defined($addressee)) {
- push(@addrs,$addressee);
- }
- return (Spread::multicast(
- $self->get_mbox,
- $message->get_serviceType,
- @addrs,
- $message->get_type,
- $contents
- ) > 0);
-}
-
-sub incomingBytes
-{
- my $self = shift();
- return undef if (! $self->isConnected);
- return Spread::poll($self->get_mbox);
-}
-
-sub messageWaiting
-{
- return shift()->incomingBytes;
-}
-
-sub nextMessage
-{
- # This blocks
- my ($self,$msgClass) = @_;
- if (! $msgClass) {
- $msgClass = 'SpreadMessage';
- }
- return undef if (! $self->isConnected);
- my $rv = eval {
- local $SIG{"ALRM"} = sub {die undef};
- # if zero, no alarm is scheduled
- alarm($self->get_readTimeout);
- my ($service_type,$sender,$groups,$mess_type,$endian,$message) = Spread::receive($self->get_mbox);
- if (($sender eq $self->get_mailbox) && ($self->get_discardSelfMessages)) {
- return undef
- }
- $self->dprint(9,"$$|$service_type|$sender|$groups|$mess_type|$endian|$message\n");
- $message = $self->unfilter($message);
- $result = $msgClass->newInitialized({
- serviceType=>$service_type,
- addressee=>$groups,
- sender=>$sender,
- endian=>$endian,
- type=>$mess_type,
- contents=>$message
- });
- alarm(0);
- return $result->decoded;
- };
- if ($@) {
- return undef
- } else {
- return $rv
- }
-}
-
-sub uniquePrivateName
-{
- return substr(time(),-4,4).substr(rand(),-5,5)
-}
-
-sub DESTROY
-{
- my $self = shift();
- if ($self->get_doAutoDisconnect) {
- $self->disconnect;
- }
-}
-
-package SpreadMessage;
-use Spread qw(:MESS :ERROR);
-use NOCpulse::Object;
-@ISA=qw(NOCpulse::Object);
-
-
-sub NextFrom
-# A constructor - really just calls $connection->nextMessage, but passing in ref($self) so
-# that SpreadConnection can know that it needs to return an instance of whatever we are
-# (possibly) instead of a plain old SpreadMessage
-{
- my($selfishness,$connection) = @_;
- my $class = ref($selfishness)||$selfishness;
- return $connection->nextMessage($class);
-}
-
-sub instVarDefinitions
-{
- my $self = shift();
- $self->addInstVar('serviceType',SAFE_MESS);
- $self->addInstVar('addressee'); # can be an array
- $self->addInstVar('type',0); # 16 bits available
- $self->addInstVar('contents',undef);
- $self->addInstVar('sender',undef); # Only meaningful for received messages
- $self->addInstVar('endian',undef); # Whether or not there's an endian mismatch
- $self->addInstVar('maxMessageSize',100000); # Max content size for a message
- $self->addInstVar('failOversizeMessages',0); # Too big = don't set contents, return 0
- $self->addInstVar('truncateOversizeMessages',1); # Too big = truncate to maxMessageSize and return 2
- $self->addInstVar('oversizeContents',0); # True if too much data was given to set_contents
-}
-
-sub set
-{
- my ($self,$name,$value) = @_;
- if ($name eq 'contents') {
- if (length($value) > $self->get_maxMessageSize) {
- $self->set_oversizeContents(1);
- if ($self->get_failOversizeMessages) {
- return 0;
- }
- if ($self->get_truncateOversizeMessages) {
- $self->SUPER::set('contents',substr($value,0,$self->get_maxMessageSize));
- return 2;
- }
- $self->SUPER::set('contents',$value); # the call to multicast will fail
- } else {
- $self->set_oversizeContents(0);
- $self->dprint(8,ref($self).": Setting $name to $value\n");
- $self->SUPER::set('contents',$value);
- return 1;
- }
- } else {
- $self->dprint(8,ref($self).": Setting $name to $value\n");
- return $self->SUPER::set($name,$value);
- }
-}
-
-sub initialize
-{
- my ($self,$options) = @_;
- my ($key,$value);
- while (($key,$value) = each(%$options)) {
- $self->set($key,$value);
- }
- return $self;
-}
-
-sub encoded
-{
- return shift()->get_contents;
-}
-
-sub decoded
-{
- return shift();
-}
-
-sub get_groups
-{
- return shift()->get_addressee;
-}
-
-sub sendVia
-{
- my ($self,$connection) = @_;
- return $connection->send($self);
-}
-
-sub asObject
-{
- my $self = shift();
- if (substr($self->get_contents,0,4) eq 'FrT;') {
- return NOCpulse::Object->fromStoreString($self->get_contents);
- } else {
- return $self->get_contents
- }
-}
-sub isAgreed
-{
- my $self = shift();
- return ($self->isRegular & AGREED_MESS);
-}
-sub isCausal
-{
- my $self = shift();
- return ($self->isRegular & CAUSAL_MESS);
-}
-sub isFifo
-{
- my $self = shift();
- return ($self->isRegular & FIFO_MESS);
-}
-sub isMembership
-{
- my $self = shift();
- return ($self->get_serviceType & MEMBERSHIP_MESS);
-}
-sub isRegular
-{
- my $self = shift();
- return ($self->get_serviceType & REGULAR_MESS);
-}
-sub isReliable
-{
- my $self = shift();
- return ($self->isRegular & RELIABLE_MESS);
-}
-sub isSafe
-{
- my $self = shift();
- return ($self->isRegular & SAFE_MESS);
-}
-sub isUnreliable
-{
- my $self = shift();
- return ($self->isRegular & UNRELIABLE_MESS);
-}
-sub setAgreed
-{
- my $self = shift();
- $self->set_serviceType(AGREED_MESS);
-}
-sub setCausal
-{
- my $self = shift();
- $self->set_serviceType(CAUSAL_MESS);
-}
-sub setFifo
-{
- my $self = shift();
- $self->set_serviceType(FIFO_MESS);
-}
-sub setReliable
-{
- my $self = shift();
- $self->set_serviceType(RELIABLE_MESS);
-}
-sub setSafe
-{
- my $self = shift();
- $self->set_serviceType(SAFE_MESS);
-}
-sub setUnreliable
-{
- my $self = shift();
- $self->set_serviceType(UNRELIABLE_MESS);
-}
-
-sub membershipInfo
-{
- my $self = shift();
- if ($self->isMembership) {
- return SpreadMembershipInfo->newInitialized($self);
- } else {
- return undef;
- }
-}
-
-
-
-package SpreadObjectMessage;
-use FreezeThaw qw(freeze thaw);
-@ISA=qw(SpreadMessage);
-
-sub encoded
-{
- my $self = shift();
- return freeze($self);
-}
-sub decoded
-{
- my $self = shift();
- my $result = $self->asObject;
- if ($result->can('addInstVar')) {
- # These will/may have changed, re-map them
- $result->addInstVar('sender',$self->get_sender);
- $result->addInstVar('addressee',$self->get_addressee);
- $result->addInstVar('endian',$self->get_endian);
- }
- return $result;
-}
-
-
-
-
-package SpreadMembershipInfo;
-use Spread qw(:MESS :ERROR);
-use Config;
-use NOCpulse::Object;
-@ISA=qw(NOCpulse::Object);
-
-sub instVarDefinitions
-{
- my $self = shift();
- $self->addInstVar('message');
- $self->addInstVar('groupId',\[]);
- $self->addInstVar('numMembers',0);
- $self->addInstVar('transMembers','');
-}
-
-sub initialize
-{
- my ($self,$message) = @_;
- $self->set_message($message);
- my $contents = $message->get_contents;
- my $byteOrder = $Config{'byteorder'}; #1234 - little endian, 4321 - big endian
- my $longType;
- if ($byteOrder == 1234) {
- $longType = 'V'
- } elsif ($byteOrder == 4321) {
- $longType = 'N'
- } else {
- die("Unknown byte ordering on this platform ($byteOrder)");
- }
- if ($self->get_message->get_endian) { # endian mismatch, so unpack opposite of whatever we are
- if ($longType eq 'V') {
- $longType = 'N'
- } else {
- $longType = 'V'
- }
- }
- # First three longs are group id, fourth long is number of members, remainder is Z string of group(s)
- my $packaging = $longType.
- $longType.
- $longType.
- $longType.
- 'a*';
- my @parts = unpack($packaging,$contents);
- my @groupId;
- push (@groupId,shift(@parts));
- push (@groupId,shift(@parts));
- push (@groupId,shift(@parts));
- $self->set_groupId(\@groupId);
- $self->set_numMembers(shift(@parts));
- my $rawMembers = shift(@parts);
- my @members = split(/\0+/,$rawMembers);
- $self->set_transMembers(\@members);
- return $self;
-}
-
-sub isSelfLeave
-{
- my $self = shift();
- return ((! $self->isTransition) && (! $self->isRegularMembership))
-}
-
-sub get_serviceType
-{
- my $self = shift();
- return $self->get_message->isMembership;
-}
-
-sub isRegularMembership
-{
- my $self = shift();
- return ($self->get_serviceType & REG_MEMB_MESS);
-}
-
-sub isTransition
-{
- my $self = shift();
- # If this is true, getGroup is the only valid get function for the instance.
- return ($self->get_serviceType & TRANSITION_MESS);
-}
-
-sub isCausedByJoin
-{
- my $self = shift();
- return ($self->isRegularMembership && ($self->get_serviceType & CAUSED_BY_JOIN));
-}
-
-sub isCausedByLeave
-{
- my $self = shift();
- return ($self->isRegularMembership && ($self->get_serviceType & CAUSED_BY_LEAVE));
-}
-
-sub isCausedByDisconnect
-{
- my $self = shift();
- return ($self->isRegularMembership && ($self->get_serviceType & CAUSED_BY_DISCONNECT));
-}
-
-sub isCausedByNetwork
-{
- my $self = shift();
- return ($self->isRegularMembership && ($self->get_serviceType & CAUSED_BY_NETWORK));
-}
-
-sub groupInQuestion
-{
- my $self = shift();
- return $self->get_message->get_sender;
-}
-
-sub whoDisconnected
-{
- my $self = shift();
- return $self->get_transMembers;
-}
-
-sub whoJoined
-{
- my $self = shift();
- return $self->get_transMembers;
-}
-
-sub whoLeft
-{
- my $self = shift();
- return $self->get_transMembers;
-}
-
-sub whoIsNotPartitioned
-{
- my $self = shift();
- return $self->get_transMembers;
-}
-
-sub whoIsInTheGroup
-{
- my $self = shift();
- return $self->get_message->get_groups;
-}
-
-sub isSelfJoin
-{
- my ($self,$myPrivName) = @_;
- return ($self->isCausedByJoin && ($self->whoJoined->[0] eq $myPrivName));
-}
-
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/SpreadServers.pm b/monitoring/PerlModules/NP/NOT-USED/Spread/SpreadServers.pm
deleted file mode 100644
index 3eb6282..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/SpreadServers.pm
+++ /dev/null
@@ -1,296 +0,0 @@
-=head1 NAME
-
-SpreadServers - a collection of classes that implement abstract stand-alone Spread servers
-
-
-=head1 SYNOPSIS
-
-
-my $server = SpreadServer->newInitialized({
- 'privateName'=>'mycon',
- 'readTimeout'=>0,
- 'messageProcessor'=>\&myMessageProcessor(),
- 'groups'=>['myservice']
- });
-
-$server->processEvents;
-
-
-
-=head1 DESCRIPTION
-
-
-SpreadNetwork defines two classes: SpreadServer and ForkingSpreadServer
-
-
-=item
-SpreadServer - a class who's instances encapsulate behavior required to implement a non-forking spread server. Users can either specify a messageProcessor (a vector to a method to run whenever a message is received) or write a subclass that overrides the processMessage() method.
-
-
-=item
-ForkingSpreadServer - a subclass of SpreadServer that runs message processing in a forked process.
-
-
-=item
-SpreadServer is a subclass of SpreadNetwork's SpreadConnection class.
-
-
-=head1 CLASS SpreadServer
-
-
-
-=head2 Instance variables
-
-
-
-=item
-All instance variables are accessable by calling get_xxx (where xxx is the instance variable name). All instance variables are settable by calling set_xxx. All instance variable values can be set on construction by passing a hash reference in with key-value pairs appropriately (see newInitialized)
-
-
-
-=item
-messageProcessor [default=undef]: Can contain a vector to a method to call when a message is received. The base class' default behavior is to call this or do nothing. Another option is to subclass SpreadServer (or ForkingSpreadServer).
-
-=item
-shouldProcessEvents [default=1]: When you set this false (0), processEvents will return.
-
-=item
-autoReconnect [default=1]: If true and a disconnection is detected, the server will automatically try to reconnect with the SpreadConnection reconnect() method.
-
-=item
-groups [default=[] ]: Groups that this server should belong to - you should specify this in the constructor call.
-
-
-=head2 Class Methods
-
-
-=item
-newInitialized({key=>value,[...]}): Takes as it's argument a ref to a hash that contains key-value pairs describing initial instance variable values. Returns an instance of SpreadServer that will be connected to the spread network. To cause this server to serve requests, run processEvents().
-
-
-
-=head2 Instance Methods
-
-
-
-=item
-processMessage(<aSpreadMessage>): This method is where an incoming message is processed. The base class will call any method specified by the messageProcessor instance variable, passing to it the message in question. You can also choose to subclass SpreadServer and override this method.
-
-=item
-joinGroups(): Joins all the groups listed in the groups instance variable. This happens when the instance is constructed.
-
-=item
-topOfLoopTasks(): This does nothing in SpreadServer, but you can choose to override it if you want. It gets called before any spread network stuff happens. ForkingSpreadServer has child-culling behavior here.
-
-=item
-routeMessage(<aSpreadMessage>): This is called nextMessage() returns. In the base class it checks to see if the message is defined, and if so calls callProcessMessage(), else does nothing. There's probably not much use to overriding this, but you can if you want.
-
-=item
-callProcessMessage(<aSpreadMessage>): This is called after routeMessage has determined that the message needs to be handled. In the base class this is just a call to processMessage(). In ForkingSpreadServer the actual forking occurs here.
-
-=item
-processEvents(): This is the server loop. It looks like this:
-
- while ($self->get_shouldProcessEvents) {
-
- $self->topOfLoopTasks;
-
- if ($self->isConnected) {
- my $message = SpreadMessage->NextFrom($self);
- $self->routeMessage($message);
- } else {
- if ($self->get_autoReconnect) {
- $self->reconnect;
- }
- }
- }
-
-
-=item
-replyConnection(): Returns a connection through which you can send a reply. In the base class this simply returns self. ForkingSpreadConnection creates a new connection with a unique name.
-
-
-
-
-=head1 CLASS ForkingSpreadServer
-
-
-
-=head2 Instance variables
-
-
-
-=item
-All instance variables are accessable by calling get_xxx (where xxx is the instance variable name). All instance variables are settable by calling set_xxx. All instance variable values can be set on construction by passing a hash reference in with key-value pairs appropriately (see newInitialized).
-
-ForkingSpreadServer adds no new instance variables - see SpreadServer for details.
-
-
-
-=head2 Class Methods
-
-
-=item
-newInitialized({key=>value,[...]}): Takes as it's argument a ref to a hash that contains key-value pairs describing initial instance variable values. Returns an instance of ForkingSpreadServer that will be connected to the spread network. To cause this server to serve requests, run processEvents().
-
-
-
-=head2 Instance Methods
-
-
-
-=item
-topOfLoopTasks(): Override of SpreadServer's behavior - this method does dead child reaping.
-
-=item
-callProcessMessage(): Override of SpreadServer's behavior - this method does the forking, and ensures that the child's copy of self won't call disconnect when its' destroyed.
-
-=item
-replyConnection(): Override of SpreadServer's behavior. This method returns a new connection. By default (with no parameters) the method returns a connection to a spread server at localhost on the default spread port with a unique name that's based on the current unix time + a 5 position random number. You can pass to this method any/all of the things you can pass to a SpreadConnection, each of which will override any default behavior this method might otherwise provide.
-
-
-
-
-
-=cut
-
-
-
-#################################################################################
-# CODE STARTS HERE
-#################################################################################
-
-package SpreadServer;
-use NOCpulse::SpreadNetwork;
-use NOCpulse::Object;
-@ISA=qw(SpreadConnection);
-
-
-sub instVarDefinitions {
- my $self = shift();
- $self->addInstVar('messageProcessor',undef);
- $self->addInstVar('shouldProcessEvents',1);
- $self->addInstVar('autoReconnect',1);
- $self->addInstVar('groups',[]);
- $self->SUPER::instVarDefinitions;
-}
-
-sub initialize {
- my ($self,@params) = @_;
- my $result = $self->SUPER::initialize(@params);
- $self->joinGroups;
- return $result;
-}
-
-sub processMessage {
- my ($self,$message) = @_;
- if ($self->get_messageProcessor) {
- my $processor = $self->get_messageProcessor;
- &{$processor}($self,$message);
- }
-}
-
-sub joinGroups {
- my ($self,@groups) = @_;
- my $ogroups = $self->get_groups;
- my $gname;
- foreach $gname (@groups) {
- $self->dprint(3,"Joining group $gname\n");
- $self->join($gname);
- }
- foreach $gname (@$ogroups) {
- $self->dprint(3,"Joining group $gname\n");
- $self->join($gname);
- }
-}
-
-sub topOfLoopTasks {
-}
-
-sub routeMessage {
- my ($self,$message) = @_;
- if (! $message ) {
- $self->dprint(9,".");
- } else {
- $self->callProcessMessage($message);
- }
-}
-
-sub callProcessMessage {
- my ($self,$message) = @_;
- $self->processMessage($message);
-}
-
-
-sub processEvents {
- my $self = shift();
- $self->dprint(3,"Waiting for messages");
- while ($self->get_shouldProcessEvents) {
-
- $self->topOfLoopTasks;
-
- if ($self->isConnected) {
- $self->dprint(3,"Waiting for message\n");
- my $message = SpreadMessage->NextFrom($self);
- $self->routeMessage($message);
- } else {
- if ($self->get_autoReconnect) {
- $self->dprint(3,"Reconnecting...\n");
- $self->reconnect;
- }
- }
- }
-}
-
-sub replyConnection
-{
- my $self = shift();
- return $self;
-}
-
-package ForkingSpreadServer;
-use POSIX ":sys_wait_h";
-@ISA=qw(SpreadServer);
-
-sub topOfLoopTasks {
- my $self = shift();
- $kid = undef;
- do {
- $self->dprint(3,"Collecting offspring\n");
- $kid = waitpid(-1,&WNOHANG);
- $self->dprint(3,"Got $kid\n");
- } until $kid < 1;
-}
-
-sub callProcessMessage {
- my ($self,$message) = @_;
-
- if (fork()) {
- # Parent
- $self->dprint(3,"Forked\n");
- } else {
- # Child
- $self->set_doAutoDisconnect(0);
- $self->processMessage($message);
- exit;
- }
-}
-
-sub replyConnection
-{
- my ($self,$name,$options) = @_;
- if (! $name) {
- $name = $self->uniquePrivateName;
- }
- if (! $options) {
- $options = {};
- }
- if (! exists($$options{'address'})) {
- $$options{'address'} = 'localhost';
- }
- if (! exists($$options{'privateName'})) {
- $$options{'privateName'} = $name;
- }
- return SpreadConnection->newInitialized($options);
-}
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/blitzcom.pl b/monitoring/PerlModules/NP/NOT-USED/Spread/blitzcom.pl
deleted file mode 100755
index 36d6473..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/blitzcom.pl
+++ /dev/null
@@ -1,25 +0,0 @@
-#!/usr/bin/perl
-use NOCpulse::SpreadNetwork;
-
-$cell = SpreadConnection->newInitialized({
- address=>'localhost',
- privateName=>time()
- });
-$|=1;
-
-@nsids = (1015);
-
-while (1) {
- foreach $nsid (@nsids) {
- $request = SpreadMessage->newInitialized({
- addressee=>'cmd'.$nsid,
- contents=>join(' ',@ARGV)
- })->sendVia($cell);
- $message = SpreadMessage->nextFrom($cell);
- if ($message->get_sender) {
- $contents = $message->get_contents;
- chomp($contents);
- print "$contents\n";
- }
- }
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/cmdserv.pl b/monitoring/PerlModules/NP/NOT-USED/Spread/cmdserv.pl
deleted file mode 100755
index 9642098..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/cmdserv.pl
+++ /dev/null
@@ -1,46 +0,0 @@
-#!/usr/bin/perl
-
-package CommandServer;
-use NOCpulse::SpreadServers;
-use NOCpulse::PlugFrame::LocalCommandShell;
-use Data::Dumper;
-@ISA=qw(SpreadServer);
-
-sub processMessage {
- my ($self,$message) = @_;
- my $contents = $message->get_contents;
- print Dumper($message);
- my $command = NOCpulse::PlugFrame::LocalCommandShell->newInitialized;
- if ( $contents =~ /^\|/ ) {
- $contents =~ s/^.//;
- my ($keyword,$value) = split(' ',$contents,2);
- if ($keyword eq 'timeout') {
- $command->set_timeout($value);
- $command->set_stdout("OK, timeout is $value");
- $command->set_stderr('');
- $command->set_exit(0);
- } else {
- $command->set_stdout("ERROR, unknown command $keyword");
- $command->set_stderr('');
- $command->set_exit(1);
- }
- } else {
- $command->set_probeCommands($message->get_contents);
- $command->execute;
- }
- my $reply = SpreadObjectMessage->newInitialized({
- addressee=>$message->get_sender
- });
- $reply->addInstVar('stdout',$command->get_stdout);
- $reply->addInstVar('stderr',$command->get_stderr);
- $reply->addInstVar('exit',$command->get_exit);
- $reply->sendVia($self->replyConnection);
-}
-#####################################################################
-
-package main;
-my $server = CommandServer->newInitialized({
- groups=>['cmdserv'],
- privateName=>'cmdservr',
- });
-$server->processEvents;
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/com.pl b/monitoring/PerlModules/NP/NOT-USED/Spread/com.pl
deleted file mode 100755
index a5b51c1..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/com.pl
+++ /dev/null
@@ -1,25 +0,0 @@
-#!/usr/bin/perl
-use NOCpulse::SpreadNetwork;
-use Data::Dumper;
-$connection = SpreadConnection->newInitialized({
- address=>shift(),
- privateName=>time()
- });
-$|=1;
-
-$request = SpreadMessage->newInitialized({
- addressee=>shift(),
- contents=>join(' ',@ARGV)
- })->sendVia($connection);
-$message = SpreadObjectMessage->NextFrom($connection);
-if ($message) {
- print "-----FROM: ".$message->get_sender."\n";
- print "-----STDOUT\n".$message->get_stdout;
- print "-----STDERR\n".$message->get_stderr;
- print "-----EXIT\n".$message->get_exit;
- print "\n";
- exit($message->get_exit);
-} else {
- print $connection->spreadErrorMessage."\n";
- exit($connection->spreadErrorNumber);
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/memcli.pl b/monitoring/PerlModules/NP/NOT-USED/Spread/memcli.pl
deleted file mode 100755
index 9e49ec2..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/memcli.pl
+++ /dev/null
@@ -1,30 +0,0 @@
-#!/usr/bin/perl
-use NOCpulse::SpreadNetwork;
-
-$host = `uname -n`;
-chomp($host);
-$localMemname = "#memory#$host";
-
-$cell = SpreadConnection->newInitialized({
- address=>'localhost',
- privateName=>time()
- });
-$|=1;
-print $cell->get_mailbox."->$localMemname: ";
-
-$request = SpreadMessage->newInitialized({
- addressee=>$localMemname,
- contents=>join(',',@ARGV)
- })->sendVia($cell);
-$message = SpreadMessage->nextFrom($cell);
-if ($message->get_sender) {
- $contents = $message->get_contents;
- chomp($contents);
- ($status,$op,$key,$value) = split(
- /,/,
- $contents,
- 4);
- $op=uc($op);
- print " |$status|$op|$key| from ".$message->get_sender."\n";
- print "\n$value\n";
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/memserv.pl b/monitoring/PerlModules/NP/NOT-USED/Spread/memserv.pl
deleted file mode 100755
index c3ef024..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/memserv.pl
+++ /dev/null
@@ -1,63 +0,0 @@
-#!/usr/bin/perl
-use NOCpulse::SpreadNetwork;
-
-$host = `uname -n`;
-chomp($host);
-$name = "memory";
-
-$connection = SpreadConnection->newInitialized({
- address=>'localhost',
- privateName=>$name,
- recieveMembershipInfo=>1
- });
-print "Running on $host as ".$connection->get_mailbox."\n";
-
-$connection->join('memory');
-
-$|=1;
-print "Waiting for messages";
-MESSAGE: while (1) {
- if ($connection->isConnected) {
- $message = SpreadMessage->nextFrom($connection);
- if (! $message ) {
- print ".";
- } else {
- if ($message->get_sender eq $connection->get_mailbox) {
- print "Ignoring message from self\n";
- next MESSAGE;
- }
- $contents = $message->get_contents;
- ($op,$key,$value) = split(
- /,/,
- $contents,
- 3);
- $op=uc($op);
- print time()." |$op|$key| from ".$message->get_sender."\n";
- $reply = SpreadMessage->newInitialized({
- addressee=>$message->get_sender
- });
-
- if ( $op eq 'GET') {
- $reply->set_contents("OK,GET,$key,".$Memory{$key});
- } elsif ($op eq 'SET') {
- $Memory{$key} = $value;
- $reply->set_contents("OK,SET,$key");
- SpreadMessage->newInitialized({
- addressee=>'memory',
- contents=>"SET,$key,$value"
- })->sendVia($connection);
- } elsif ($op eq 'DEL') {
- delete($Memory{$key});
- $reply->set_contents("OK,DEL,$key");
- } elsif ($op eq 'LST') {
- $reply->set_contents("OK,LST,$key,".join("\n",keys(%Memory)));
- } else {
- $reply->set_contents("ERROR,$op,$key");
- }
- $reply->sendVia($connection);
- }
- } else {
- print "Reconnecting...\n";
- $connection->reconnect;
- }
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/ootest.pl b/monitoring/PerlModules/NP/NOT-USED/Spread/ootest.pl
deleted file mode 100755
index c766b25..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/ootest.pl
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/usr/bin/perl
-use NOCpulse::SpreadNetwork;
-use NOCpulse::PlugFrame::Probe;
-
-$connection = SpreadConnection->newInitialized({
- address=>'localhost',
- privateName=>'perltest'
- });
-
-$connection->join('scheduler');
-
-my $probe = Probe->new;
-
-SpreadMessage->newInitialized({
- addressee=>'scheduler',
- contents=>$probe->storeString
-})->sendVia($connection);
-
-$probe = undef;
-
-$message = SpreadMessage->nextFrom($connection);
-print $message->printString;
-print $message->asObject->printString;
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/scheduler.pl b/monitoring/PerlModules/NP/NOT-USED/Spread/scheduler.pl
deleted file mode 100755
index e784009..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/scheduler.pl
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/usr/bin/perl
-use NOCpulse::SpreadNetwork;
-use NOCpulse::Scheduler::Event;
-use FreezeThaw qw(freeze);
-
-$connection = SpreadConnection->newInitialized({
- address=>'marvin',
- privateName=>'scheduler'
- });
-$connection->join('scheduler');
-while (1) {
- if ($connection->isConnected) {
- my $message = SpreadMessage->nextFrom($connection);
- if ($message->get_sender) {
- print time().' '.$message->get_contents.' from '.$message->get_sender."\n";
- my $event = NOCpulse::Scheduler::Event->new;
- $event->{'id'} = $message->get_sender.time();
- SpreadMessage->newInitialized({
- addressee=>$message->get_sender,
- contents=>freeze($event)
- })->sendVia($connection);
- }
- } else {
- print "Reconnecting...\n";
- $connection->reconnect;
- }
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/spkernel.pl b/monitoring/PerlModules/NP/NOT-USED/Spread/spkernel.pl
deleted file mode 100755
index 5f509a2..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/spkernel.pl
+++ /dev/null
@@ -1,30 +0,0 @@
-#!/usr/bin/perl
-use NOCpulse::SpreadNetwork;
-use Data::Dumper;
-
-my $connection = SpreadConnection->newInitialized({
- address=>'localhost',
- privateName=>'kernel'.$ARGV[0],
- readTimeout=>5
-});
-
-while (1) {
- if ($connection->isConnected) {
- SpreadMessage->newInitialized({
- addressee=>'scheduler',
- contents=>'WANT_EVENT'
- })->sendVia($connection);
-
- $message = SpreadMessage->nextFrom($connection);
- if ($message) {
- my $thing = $message->asObject;
- print Dumper($thing);
- } else {
- print "Timeout - retrying\n";
- }
- } else {
- print "Reconnecting...\n";
- $connection->reconnect;
- }
-}
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Spread/sputnik b/monitoring/PerlModules/NP/NOT-USED/Spread/sputnik
deleted file mode 100755
index 8ea5594..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Spread/sputnik
+++ /dev/null
@@ -1,62 +0,0 @@
-#!/usr/bin/perl
-
-package CommandServer;
-use NOCpulse::SpreadServers;
-use NOCpulse::PlugFrame::LocalCommandShell;
-use Data::Dumper;
-@ISA=qw(SpreadServer);
-
-sub processMessage {
- my ($self,$message) = @_;
- my $contents = $message->get_contents;
- #print Dumper($message);
- my $command = LocalCommandShell->newInitialized;
- if ( $contents =~ /^\|/ ) {
- $contents =~ s/^.//;
- my ($keyword,$value) = split(' ',$contents,2);
- if ($keyword eq 'timeout') {
- $command->set_timeout($value);
- $command->set_stdout("OK, timeout is $value");
- $command->set_stderr('');
- $command->set_exit(0);
- } else {
- $command->set_stdout("ERROR, unknown command $keyword");
- $command->set_stderr('');
- $command->set_exit(1);
- }
- } else {
- $command->set_probeCommands($message->get_contents);
- $command->execute;
- }
- my $reply = SpreadObjectMessage->newInitialized({
- addressee=>$message->get_sender
- });
- $reply->addInstVar('stdout',$command->get_stdout);
- $reply->addInstVar('stderr',$command->get_stderr);
- $reply->addInstVar('exit',$command->get_exit);
- $reply->sendVia($self->replyConnection);
-}
-#####################################################################
-
-package main;
-use NOCpulse::SatCluster;
-use NOCpulse::Config;
-
-my $cluster = NOCpulse::SatCluster->newInitialized(NOCpulse::Config->new);
-$cluster->refreshHAView;
-my $clustname = 'ccmd'.$cluster->get_id;
-my $satname = 'scmd'.$cluster->get_nodeId;
-my $leadname = 'lcmd'.$cluster->get_id;
-print "cluster: $clustname sat: $satname lead: $leadname\n";
-my @groups;
-push(@groups,$clustname,$satname);
-if ($cluster->get_currentNode->get_isLead) {
- push(@groups,$leadname)
-}
-
-
-my $server = CommandServer->newInitialized({
- groups=>\@groups,
- privateName=>$satname,
- });
-$server->processEvents;
diff --git a/monitoring/PerlModules/NP/NOT-USED/TelAlert/BUILD b/monitoring/PerlModules/NP/NOT-USED/TelAlert/BUILD
deleted file mode 100644
index 7c6e77b..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TelAlert/BUILD
+++ /dev/null
@@ -1,52 +0,0 @@
-# Macros
-
-%define cvs_package PerlModules/NP/TelAlert
-
-
-# Package specific stuff
-Name: NOCpulse-TelAlert
-Version: 1.37.0
-Release: 1
-Packager: Dave Faraldo <dfaraldo(a)nocpulse.com>
-Summary: Perl debug output package
-Source: NOCpulse-TelAlert-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Requires: perl >= 5.00500
-Provides: NOCpulse::TelAlert
-Group: unsorted
-Copyright: NOCpulse (c) 2000
-Vendor: NOCpulse
-Prefix: %{_our_prefix}
-Buildroot: %{_tmppath}/%cvs_package
-
-%description
-
-Provides an API for generating varying levels of debugging output
-on various output streams.
-
-%prep
-%entirely_abstract_build_step
-
-%build
-
-%install
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-mkdir -p %buildroot%{_our_prefix}
-install -o root -g root -m 444 TelAlert.pm %buildroot%{_our_prefix}/TelAlert.pm
-%make_file_list
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-%clean
-%abstract_clean_script
-
-
-%post
-/usr/bin/perl -e '$\="\n\n";' -e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' -e 'print "=over 4";' -e 'while (defined($key = shift) and defined($val = shift)){print "=item *";print "C<$key: $val>";}' -e 'print "=back";' \
- "Module" "NOCpulse::TelAlert" \
- "installed into" "/usr/lib/perl5/site_perl/5.005" \
- LINKTYPE "dynamic" \
- VERSION "1.0" \
- EXE_FILES "" \
- >> /usr/lib/perl5/5.00503/i386-linux/perllocal.pod
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/TelAlert/SQLtest.pl b/monitoring/PerlModules/NP/NOT-USED/TelAlert/SQLtest.pl
deleted file mode 100755
index eb6e2c0..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TelAlert/SQLtest.pl
+++ /dev/null
@@ -1,208 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use NOCpulse::Debug;
-use NOCpulse::TelAlert;
-use Getopt::Long;
-
-$|=1;
-select((select(STDERR), $|=1)[0]);
-
-#
-# Sample command to run this script:
-# ./SQLtest.pl --debug=3 --CUSTOMER_ID=2 --delredir=446 | more
-#
-
-
-#- We need to rollback db changes when we die in case AutoCommit is set to 0.
-#- If AutoCommit is set to 1, we cannot rollback db changes.
-$SIG{__DIE__} = \¨
-
-
-#
-# Pick up command line options
-#
-my @optspec = qw (debug:i CUSTOMER_ID:i delredir:i);
-my %optctl;
-&GetOptions(\%optctl, @optspec);
-my $debugLevel = $optctl{'debug'}; #- Debug level
-my $CUSTOMER_ID = $optctl{'CUSTOMER_ID'}; #- ID of customer to create an alert for
-my $delredir = $optctl{'delredir'}; #- Recid ID of redirect to delete from database
-
-
-#- Create debug object and a stream
-my $debug = new NOCpulse::Debug;
-my $literal = $debug->addstream( CONTEXT => 'literal', LEVEL => $debugLevel );
-$debug->dprint (1, "Created debug & stream objects\n");
-
-
-#- Create our Telalert object
-my $telalert = new NOCpulse::TelAlert;
-$debug->dprint (1, "Connecting to DB\n");
-$telalert->connect( PrintError => 0, RaiseError => 0, AutoCommit => 0 );
-
-
-#- Let's try a telalert command
-my $tacmd = "-show";
-my $results = $telalert->taexec($tacmd);
-$debug->dprint (1, "Telalert command results:\n$results");
-
-
-#- Write to TA trail log file
-my $msg = "$0 is Writing to trail file";
-$results = $telalert->writetrail($msg);
-$debug->dprint (1, "Wrote to Telalert trail file the message:\n $msg\n");
-
-
-#- Try to clear a ticket
-my $ticket_id = "12345";
-$results = $telalert->clearticket($ticket_id);
-$debug->dprint (1, "Attempted to clear Telalert ticket with ID $ticket_id\nResults:$results\n");
-
-
-#- Show a list of available Telalert servers
-my @telalertHosts = $telalert->getServers;
-foreach (@telalertHosts) { $debug->dprint (1, "Telalert Server listed in DB: $_\n") }
-
-
-#- Disconnect from the DB and reconnect
-$debug->dprint (1, "Disconnecting from DB\n");
-$telalert->disconnect;
-$debug->dprint (1, "Reconnecting to DB\n");
-$telalert->connect( {'PrintError'=>0, 'RaiseError'=>0, 'AutoCommit'=>0} );
-
-#- Show the current list of pager types in DB
-my %pagertypes = $telalert->getPagerTypes;
-my @values = sort { lc ($pagertypes{$a}) cmp lc ($pagertypes{$b}) } keys %pagertypes;
-foreach (@values) { $debug->dprint (3, "Telalert Pager Type in DB: $pagertypes{$_}\n") }
-
-
-#- Show the current list of alerts in DB
-my @alerts = $telalert->getAlerts;
-foreach (@alerts) {
- my $alertID = $$_[0];
- my $ticket_id = $$_[1];
- my $alertOwner = $$_[6];
- $debug->dprint (3, "Telalert Alert($alertID) Ticket $ticket_id is currently owned by host $alertOwner\n");
-}
-
-
-#- Show the details of alerts in DB
-my $alertID = 558;
-my @details = $telalert->getAlertValues($alertID);
-my $customer = $details[15];
-my $submitted = $details[0];
-$debug->dprint (1, "Telalert Alert $alertID (submitted on $submitted) belongs to customer $customer\n");
-
-
-#- Read the Telalert config file
-my @configFile = $telalert->getTAConfig;
-$debug->dprint (4, "Telalert Config File:\n", join '', @configFile, "\n");
-
-
-#- Extract the Tetalert Host IP Address
-my $ip = $telalert->getMyIP;
-$debug->dprint (1, "My Tetalert Host IP Address=", $ip, "\n");
-die "Can't determine IP address:$@\n" if (!$ip);
-
-
-#- Determing the Telalert Server's recid in the "telalerts" DB table
-my $server_recid = $telalert->getTelalertServerID;
-die "Can't determine Telalert Server's recid:$@\n" if (!$server_recid);
-$debug->dprint (1, "My Tetalert Server recid=", $server_recid, "\n");
-
-
-#- Create a Telalert ticket
-my $ticket_id = $telalert->newticketid($server_recid);
-die "Can't create a new Telalert ticket id:$@\n" if (!$ticket_id);
-$debug->dprint (1, "New Tetalert Alert Ticket ID=", $ticket_id, "\n");
-
-
-#- Get the list of ALL Telalert destinations
-my %dests = $telalert->getDests;
-die "Can't get list of all Telalert destinations:$@\n" if (!%dests);
-$debug->dprint (3, "List of all Telalert destinations:\n");
-foreach (sort keys %dests) { $debug->dprint (3, "Details for destination name $_: $dests{$_}\n") }
-
-
-#- Get a list of all redirects for a company (e.g., NOCpulse has CUSTOMER_ID=1)
-my $row_ref;
-my @redirs = $telalert->getRedirs($CUSTOMER_ID);
-die "Can't get list of all redirects for customer id $CUSTOMER_ID:$@\n" if (!@redirs);
-foreach $row_ref (@redirs) {
- my @redirect = @$row_ref;
- my $redirid = shift @redirect;
- $debug->dprint (3, "Details for redirect ID $redirid: @redirect\n");
-}
-
-
-#- Get details for an individual redirect
-my $redirid = 421;
-my ($hostpat, $svcpat, $msgpat, $caseins, $optype, $emails, $expire, $expireseconds, $customer) =
- $telalert->getRedirValues($redirid);
-my @details = ($hostpat, $svcpat, $msgpat, $caseins, $optype, $emails, $expire, $expireseconds, $customer);
-die "Can't get details for redirect id $redirid:$@\n" if (!$expire);
-$debug->dprint (3, "Details for individual redirect ID $redirid: @details\n");
-
-
-#- Get list of selected destinations for an individual redirect
-my @selected_dests = $telalert->getSelectedDests($CUSTOMER_ID, $redirid);
-die "Can't get list of selected destinations for individual redirect $redirid:$@\n" if (!@selected_dests);
-$debug->dprint (3, "Selected destinations for individual redirect ID $redirid: @selected_dests\n");
-
-
-#- Time to save a new alert into the "current_alerts" DB table
-#- Order of expected values:
-$debug->dprint (1, "About to save a new alert with ticket $ticket_id\n");
-$telalert->putStates($server_recid,
- $server_recid,
- "-i 1_fpaturzo_phone -ticket $ticket_id -ticketmask xxssssssssssssssssssssss",
- "This is the message to be sent at UNIX time $^T",
- $ticket_id, 'fpaturzo_phone',
- 0,
- 10,
- 'UP',
- 1000,
- 'WARNING',
- $CUSTOMER_ID);
-
-die "Can't save alert for ticket id $ticket_id:$@\n" if ($@);
-$debug->dprint (1, "Saved a new alert with ticket $ticket_id\n");
-
-
-#- Delete a redir?
-if ($delredir) {
- $telalert->deleteRedir($delredir);
- $debug->dprint (1, "Deleting redirect $delredir\n");
-
- # Now show the new list of redirects
- my $row_ref;
- my @redirs = $telalert->getRedirs($CUSTOMER_ID);
- die "Can't get list of all redirects for customer id $CUSTOMER_ID:$@\n" if (!@redirs);
- $debug->dprint (1, "Updated list of redirects for CUSTOMER_ID $CUSTOMER_ID:\n");
- foreach $row_ref (@redirs) {
- my @redirect = @$row_ref;
- my $redirid = shift @redirect;
- $debug->dprint (3, "Details for redirect ID $redirid: @redirect\n");
- }
-}
-
-
-#- Commit all changes
-$telalert->{dbh}->commit;
-$telalert->{dbh}->disconnect;
-
-
-###################
-sub die {
-
- my (@params) = @_;
-
- print "@_";
- if ($telalert->{dbh}) {
- $telalert->{dbh}->rollback;
- $telalert->{dbh}->disconnect;
- }
-
- exit 1;
-}
diff --git a/monitoring/PerlModules/NP/NOT-USED/TelAlert/TelAlert.pm b/monitoring/PerlModules/NP/NOT-USED/TelAlert/TelAlert.pm
deleted file mode 100644
index bd6a41d..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TelAlert/TelAlert.pm
+++ /dev/null
@@ -1,2562 +0,0 @@
-######################################
-package NOCpulse::TelAlert;
-######################################
-
-use vars qw($VERSION);
-$VERSION = (split(/\s+/,
- q$Id: TelAlert.pm,v 1.56 2002-06-17 22:43:30 kjacqmin Exp $,
- 4))[2];
-
-use strict;
-use Data::Dumper; # for debugging
-use DBI;
-use DBD::Oracle;
-use FreezeThaw qw(freeze thaw);
-use IO::File;
-use Sys::Hostname;
-use GDBM_File;
-use NOCpulse::Debug;
-use NOCpulse::Config;
-
-# Globals
-my $cfg = new NOCpulse::Config;
-my $DBD = $cfg->get('cf_db', 'dbd');
-my $DBNAME = $cfg->get('cf_db', 'name');
-my $DBUNAME = $cfg->get('cf_db', 'notification_username');
-my $DBPASS = $cfg->get('cf_db', 'notification_password');
-$ENV{'TELALERTBIN'} = $cfg->get('telalert', 'bin');
-my $TELALERTBIN = $ENV{'TELALERTBIN'};
-$ENV{'TELALERTCFG'} = $cfg->get('telalert', 'cfg');
-$ENV{'TELALERTDIR'} = $cfg->get('telalert', 'dir');
-$ENV{'TELALERTTMP'} = $cfg->get('telalert', 'tmp');
-$ENV{'TELALERTHOME'} = $cfg->get('telalert', 'home');
-$ENV{'ORACLE_HOME'} = $cfg->get('oracle', 'ora_home');
-
-my $DEFAULTDATEFORMAT = 'MM-DD-YYYY HH24:MI:SS';
-
-my $TELALERTCONFIGFILE = "telalert.ini";
-
-# backups for db down state
-my $CONTACT_FORMAT_FILE = $ENV{'TELALERTCFG'} . "/NOCpulse/config/generated/contact_to_format.gdbm";
-my $FORMAT_FILE = $ENV{'TELALERTCFG'} . "/NOCpulse/config/generated/message_formats.gdbm";
-my $REDIRECT_FILE = $ENV{'TELALERTCFG'} . "/NOCpulse/config/generated/redirects.gdbm";
-my $CUSTOMER_REDIRECT_FILE = $ENV{'TELALERTCFG'} . "/NOCpulse/config/generated/customer_redirects.gdbm";
-my $TELALERTS_FILE = $ENV{'TELALERTCFG'} . "/NOCpulse/config/generated/telalerts.gdbm";
-
-# Table cache for load_table
-my %TABLE;
-
-###############################################
-# Misc. Methods
-###############################################
-
-
-#----------------------------------------------
-sub new {
-
- my ($class) = @_;
- my $self = {};
- bless $self, $class;
-
- # Default values
- $self->dateformat($DEFAULTDATEFORMAT);
- $self->ticketcount(0);
- $self->tablecache(1);
- $self->timeout(90);
-
- return $self;
-}
-
-
-# Accessor methods
-sub connected { shift->_elem('connected', @_); }
-sub dateformat { shift->_elem('dateformat', @_); }
-sub dbh { shift->_elem('dbh', @_); }
-sub ip { shift->_elem('ip', @_); }
-sub serverid { shift->_elem('serverid', @_); }
-sub tablecache { shift->_elem('tablecache', @_); }
-sub ticketcount { shift->_elem('ticketcount', @_); }
-sub timeout { shift->_elem('timeout', @_); }
-
-
-sub nextticket {
- my $self = shift;
-
- my $ticketcount = $self->ticketcount();
- $self->ticketcount($ticketcount + 1);
-
- return $ticketcount;
-}
-
-
-# Stolen from LWP::MemberMixin
-sub _elem
-{
- my($self, $elem, $val) = @_;
- my $old = $self->{$elem};
- $self->{$elem} = $val if defined $val;
- return $old;
-}
-
-
-#----------------------------------------------
-sub connect {
-
- # Usage:
- # my $telalert = new NOCpulse::TelAlert;
- # $telalert->connect ( 'PrintError'=>0, 'RaiseError'=>0, 'AutoCommit'=>0 );
-
- my ($self, %paramHash) = @_;
-
- my $PrintError = $paramHash{PrintError} || 0;
- my $RaiseError = $paramHash{RaiseError} || 0;
- my $AutoCommit = $paramHash{AutoCommit} || 0;
-
-
- # Open a connection to the DB
- my $dbh = DBI->connect("DBI:$DBD:$DBNAME", $DBUNAME, $DBPASS, { RaiseError => $RaiseError, AutoCommit => $AutoCommit });
-
- if ($dbh) {
- # Remember dbh
- $self->dbh($dbh);
- $self->connected(1);
- }
- else { $@ = $DBI::errstr ; return undef }
-
- return $self;
-
-}
-
-#----------------------------------------------
-sub disconnect {
-
- my ($self) = @_;
- my $status = 1;
-
- # Close the connection to the DB
- if($self->connected()) {
- $self->dbh->disconnect;
- }
- $self->connected(0);
-
-}
-
-#----------------------------------------------
-sub commit {
-
- my ($self) = @_;
-
- # Commit changes to the database
- if($self->connected()) {
- $self->dbh->commit || return (1,$self->dbh->errstr);
- } else {
- return (1,"database not connected")
- }
- return (0)
-}
-
-#----------------------------------------------
-sub rollback {
-
- my ($self) = @_;
-
- # Roll back changes to the database
- if($self->connected()) {
- $self->dbh->rollback;
- }
-
-}
-
-#----------------------------------------------
-sub dbexecute {
-
- my ($self, $sql_statement, @bindvars) = @_;
-
- my $errcode=0;
- my $errstring="SUCCESS";
- my $dataref = [];
-
-# print STDERR ("Executing: $sql_statement with: @bindvars\n");
-
- # Make sure we have an open DB handle
- $self->connect() unless ($self->connected());
- unless ($self->connected()) {
- $errcode=1;
- $errstring=$@ . ". Not connected to database.";
- return ($dataref,$errcode,$errstring,$sql_statement,@bindvars);
- }
-
- # Prepare the statement handle
- my $statement_handle;
- $statement_handle = $self->dbh->prepare($sql_statement);
- if (!$statement_handle) {
- $errcode=1;
- $errstring = $DBI::errstr;
- $@=$errstring;
- $errstring .= ". Unable to prepare statement handle.";
- print STDERR "$sql_statement\n$errstring\n";
- return ($dataref,$errcode,$errstring,$sql_statement,@bindvars);
- }
-
- # Execute the query
- my $rc;
- $rc = $statement_handle->execute(@bindvars);
- if (!$rc) {
- $errcode=1;
- $errstring = $DBI::errstr;
- $@=$errstring;
- $errstring .= ". Unable to execute the query.";
- print STDERR "$sql_statement\n$errstring\n";
- return ($dataref,$errcode,$errstring,$sql_statement,@bindvars);
- }
-
- # Fetch the data, if any
-
- if ($statement_handle->{NUM_OF_FIELDS}) {
- $dataref = $statement_handle->fetchall_arrayref;
- if ($statement_handle->err) {
- $dataref= [];
- $errcode=1;
- $errstring = $DBI::errstr;
- $@=$errstring;
- $errstring .= ". Unable to fetch the data.";
- print STDERR "$sql_statement\n$errstring\n";
- return ($dataref,$errcode,$errstring,$sql_statement,@bindvars);
- }
- }
-
- # Close the statement handle
- if (!$errcode) {
- $statement_handle->finish;
- if ($DBI::err) {
- $errcode=1;
- $errstring = $DBI::errstr;
- $@=$errstring;
- $errstring .= ". Unable to close the statement handle.";
- print STDERR "$sql_statement\n$errstring\n";
- return ($dataref,$errcode,$errstring,$sql_statement,@bindvars);
- }
- }
-
- return ($dataref,$errcode,$errstring,$sql_statement,@bindvars);
-}
-
-#----------------------------------------------
-sub dbexec {
- my ($self,@rest)=@_;
- my @array=$self->dbexecute(@rest);
- return wantarray ? @array : shift(@array);
-}
-
-#----------------------------------------------
-sub taexec {
-
- my ($self, @params) = @_;
-
- # Prepare command for shell
- my $cmd = "$TELALERTBIN/telalert @params";
-
- # Don't let it take too long!
- my $tomsg = "Timed out!\n";
- my $results;
- my $exitstatus;
- my $attempts = 1;
-
- #Repeat once if telalert doesn't respond
-
- while ($attempts > 0 && $attempts < 3) {
- eval {
- $SIG{'ALRM'} = sub {die $tomsg};
- alarm($self->timeout);
-
- # Execute command and capture STDOUT & STDERR
- $results .= `$cmd 2>&1`;
-
- alarm(0);
- };
-
- if ($@ eq $tomsg) {
-
- $results .= "Error: Timed out\n";
- $exitstatus = 4;
- $attempts = 0;
-
- } elsif ($@) {
-
- $results .= "Error: $@\n";
- $exitstatus = 4;
- $attempts = 0;
-
-
- } else {
- # Interpret the exit status
- $exitstatus = $? >> 8;
-
- if ($exitstatus && $results =~ /Can\'t read from host/) {
- $attempts++;
- } else {
- $attempts = 0;
- }
- }
- }
-
- # Return results
- return($results, $exitstatus, $cmd);
-}
-
-#----------------------------------------------
-sub clearticket {
-
- my ($self, $ticket_id) = @_;
- $ticket_id =~ s/'/'"'"'/g;
-
- my($results) = $self->taexec("-clear -ticket '$ticket_id'");
-
- return $results;
-}
-
-#----------------------------------------------
-sub clear {
-
- my ($self, $ticket_id) = @_;
- $ticket_id =~ s/'/'"'"'/g;
-
- my($results) = $self->taexec("-clear '$ticket_id'");
-
- return $results;
-}
-
-#----------------------------------------------
-sub ack {
-
- my ($self, $ticket_id) = @_;
- $ticket_id =~ s/'/'"'"'/g;
-
- my($results) = $self->taexec("-ack '$ticket_id'");
-
- return $results;
-}
-
-#----------------------------------------------
-sub nak {
-
- my ($self, $ticket_id) = @_;
- $ticket_id =~ s/'/'"'"'/g;
-
- my($results) = $self->taexec("-nak '$ticket_id'");
-
- return $results;
-}
-
-#----------------------------------------------
-sub writetrail {
-
- my ($self, $message) = @_;
- $message =~ s/'/'"'"'/g;
-
- my($results) = $self->taexec("-writetrail '$message'");
-
- return $results;
-}
-
-
-#----------------------------------------------
-sub listsection {
-
- my ($self, $section, $withvalue) = @_;
- $withvalue = "-value" if ($withvalue);
- $section =~ s/'/'"'"'/g;
-
- my($results) = $self->taexec("-list '$section' $withvalue");
-
- return $results;
-}
-
-#----------------------------------------------
-sub stop {
-
- my ($self) = shift;
-
- my($results) = $self->taexec("-stop");
-
- return $results;
-}
-
-#----------------------------------------------
-sub start {
-
- my ($self, $init) = @_;
- $init = "-init" if $init;
-
- my($results) = $self->taexec("-start $init");
-
- return $results;
-}
-
-#----------------------------------------------
-sub show {
-
- my ($self, $option) = @_;
- $option = '-'.$option if ($option && $option !~ /^-.*/);
-
- my($results) = $self->taexec("-show $option");
-
- return $results;
-}
-
-#----------------------------------------------
-sub activateport {
-
- my ($self, $portname) = @_;
-
- my($results) = $self->taexec("-activate -port $portname");
-
- return $results;
-}
-
-#----------------------------------------------
-sub deactivateport {
-
- my ($self, $portname) = @_;
-
- my($results) = $self->taexec("-deactivate -port $portname");
-
- return $results;
-}
-
-#----------------------------------------------
-sub getMyIP {
-
- my ($self) = @_;
- my $ip='';
-
- # Return cached IP if it exists
- if (defined($self->ip())) {
-
- return($self->ip());
-
- } else {
-
- # Determine my IP address by hook or by crook
-
- # First attempt is to parse the TelAlert list license command
- my $results = $self->listsection('license', 1);
- my @results = split (/\n/, $results);
- $ip = (grep { /^HostIPAddress=/ } @results)[0];
- $ip = (split (/HostIPAddress=/, $ip, 2) )[1];
- $ip =~ s/\n//g;
-
-
- unless (defined($ip)) {
-
- # Second attempt is to parse the TelAlert config file
- my @configFile = $self->getTAConfig;
-
- # Extract the Tetalert Host IP Address
- my @ip = grep { /^HostIPAddress=/ } @configFile;
- $ip = (split (/HostIPAddress=/, $ip[0], 2) )[1];
- $ip =~ s/\n//g;
-
- }
-
-
-
-
- unless (defined($ip)) {
-
- # Third attempt is to use ifconfig command
- my @ip = ();
- my $cmd = "/sbin/ifconfig eth0"; # Tested only on Linux
- $results = `$cmd 2>&1`;
- @results = split (/\n/, $results);
- @ip = grep { /inet addr:/ } @results;
- $ip = $ip[0];
- $ip =~ s/^\s+//;
- $ip =~ s/\s+/ /g;
- $ip = (split (/inet addr:/, $ip, 2) )[1];
- $ip = (split (/ /, $ip) )[0];
- $ip =~ s/\n//g;
-
- }
-
-
- unless (defined($ip)) {
-
- # Fourth and final attempt, use Perl's system library routines
- my $hostname = hostname();
- my $packedIP = gethostbyname $hostname;
- $ip = join ".", unpack("C4", $packedIP);
-
-
- }
-
- $self->ip($ip) if (defined($ip));
- return $ip;
-
- }
-
-} # End of getMyIP
-
-#----------------------------------------------
-sub getTAConfig {
- return &readfile("$ENV{'TELALERTCFG'}/$TELALERTCONFIGFILE") if (wantarray);
- return join '', &readfile("$ENV{'TELALERTCFG'}/$TELALERTCONFIGFILE");
-}
-
-sub readfile {
- my $file = shift;
- my @configfile;
-
- my $fh = new IO::File;
- $fh->open ("< $file") or die "Couldn't open $file: $!\n";
-
- while (<$fh>) {
- if (/^\s*\$include/) {
- my ($op, $file) = split(' ', $_);
- push (@configfile, "# Including file '$file'\n");
- push (@configfile, &readfile("$ENV{'TELALERTCFG'}/$file") );
-
- }
- else { push (@configfile, $_) }
- }
-
- $fh->close;
-
- return @configfile;
-}
-
-#----------------------------------------------
-sub DESTROY {
- my $self = shift;
- $self->disconnect();
-}
-
-#----------------------------------------------
-sub newticketid
-{
-
- # $server_recid is the recid of the TelAlert server in the "telalerts" DB table
-
- my ($self) = @_;
- $self->serverid($self->getTelAlertServerID()) unless (defined($self->serverid())); my $server_recid = $self->serverid();
- my $ticketcount = $self->nextticket();
- my $ticket = sprintf ( "%02d_%010d_%06d_%03d", $server_recid, time(), $$,
- $ticketcount );
-
- return $ticket;
-
-} # End of newticketid
-
-#----------------------------------------------
-
-
-###############################################
-# TelAlert/SQL Methods
-###############################################
-
-sub dbIsOkay {
- my $self = shift;
-
- $self->dbexec('select * from dual');
- return !$@
-}
-
-#----------------------------------------------
-sub activeAlertExists {
-
- my ($self, $ticket_id) = @_;
-
- # Are there any alerts matching this ticket_id?
- my $sql_statement = sprintf<<EOSQL;
-SELECT count(*)
-FROM current_alerts
-WHERE current_alerts.ticket_id = ?
- AND current_alerts.date_completed is NULL
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $ticket_id);
-
-
- #-- Return the count of matching active alerts
- return $rows_ref->[0]->[0];
-
-
-} # End of activeAlertExists
-
-#----------------------------------------------
-sub getActiveAlerts {
-
- my ($self) = @_;
-
-
- # Fetch all alerts from the DB
- my $dateformat = $self->dateformat();
-
- my $sql_statement = sprintf<<EOSQL;
-SELECT
- alerts.recid,
- alerts.ticket_id,
- alerts.destination_name,
- alerts.escalation_level,
- TO_CHAR (alerts.date_submitted, '$dateformat') AS datesubmitted,
- oowner.telalert_name AS origip,
- cowner.telalert_name AS curgip,
- TO_CHAR (alerts.last_server_change, '$dateformat'),
- TO_CHAR (alerts.date_completed, '$dateformat'),
- SUBSTR (alerts.message, 0, 15),
- cowner.recid,
- alerts.customer_id,
- customer.description
-FROM
- telalerts oowner,
- telalerts cowner,
- current_alerts alerts,
- customer
-WHERE
- alerts.current_server = cowner.recid
- AND alerts.original_server = oowner.recid
- AND alerts.customer_id = customer.recid
- AND alerts.date_completed is NULL
-ORDER BY
- curgip ASC, datesubmitted ASC, alerts.ticket_id
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement);
- my @alerts = @$rows_ref;
-
- return @alerts;
-
-} # End of getActiveAlerts
-
-#----------------------------------------------
-sub getAlertValues {
-
- #--- Fetch the values for this alert from DB
-
- my ($self, $alert_recid) = @_;
-
-
- my $dateformat = $self->dateformat();
- my $sql_statement = sprintf<<EOSQL;
-SELECT recid,
- TO_CHAR (alerts.date_submitted, '$dateformat'),
- TO_CHAR (alerts.last_server_change, '$dateformat'),
- TO_CHAR (alerts.date_completed, '$dateformat'),
- oowner.telalert_name as origip,
- cowner.telalert_name as curgip,
- alerts.tel_args,
- alerts.message,
- alerts.ticket_id,
- alerts.destination_name,
- alerts.escalation_level,
- alerts.host_probe_id,
- alerts.host_state,
- alerts.service_probe_id,
- alerts.service_state,
- alerts.customer_id,
- alerts.netsaint_id,
- alerts.probe_type
- customer.description
-FROM
- telalerts oowner,
- telalerts cowner,
- current_alerts alerts,
- customer
-WHERE
- alerts.recid = ?
- AND alerts.current_server = cowner.recid
- AND alerts.original_server = oowner.recid
- AND alerts.customer_id = customer.recid
-EOSQL
-
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $alert_recid);
-
- if (scalar(@$rows_ref)) {
-
- my @columns = qw(
- recid date_submitted last_server_change date_completed
- original_server current_server tel_args message
- ticket_id destination_name escalation_level host_probe_id
- host_state service_probe_id service_state customer_id
- netsaint_id probe_type customer_description);
-
- my %values;
- @values{@columns} = @{$rows_ref->[0]};
-
- return \%values;
-
- } else {
-
- return undef;
-
- }
-
-
-} # End of getAlertValues
-
-
-
-#----------------------------------------------
-sub getLastAlertByType {
-
- #--- Fetch the values for this alert from DB
-
- my ($self, $type, $id) = @_;
-
- my $dateformat = $self->dateformat();
-
- my $column = ($type eq 'HostProbe' ? 'host_probe_id' : 'service_probe_id');
-
- my $sql_statement = sprintf<<EOSQL;
-SELECT *
-FROM (
- SELECT alerts.recid,
- TO_CHAR (alerts.date_submitted, '$dateformat'),
- TO_CHAR (alerts.last_server_change, '$dateformat'),
- TO_CHAR (alerts.date_completed, '$dateformat'),
- oowner.telalert_name as origip,
- cowner.telalert_name as curgip,
- alerts.tel_args,
- alerts.message,
- alerts.ticket_id,
- alerts.destination_name,
- alerts.escalation_level,
- alerts.host_probe_id,
- alerts.host_state,
- alerts.service_probe_id,
- alerts.service_state,
- alerts.customer_id,
- alerts.netsaint_id,
- alerts.probe_type,
- customer.description
- FROM
- telalerts oowner,
- telalerts cowner,
- current_alerts alerts,
- customer
- WHERE
- alerts.current_server = cowner.recid
- AND alerts.original_server = oowner.recid
- AND alerts.customer_id = customer.recid
- AND alerts.probe_type = ?
- AND alerts.$column = ?
- ORDER BY
- date_submitted DESC )
-WHERE rownum = 1
-EOSQL
-
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $type, $id);
-
- if (scalar(@$rows_ref)) {
-
- my @columns = qw(
- recid date_submitted last_server_change date_completed
- original_server current_server tel_args message
- ticket_id destination_name escalation_level host_probe_id
- host_state service_probe_id service_state customer_id
- netsaint_id probe_type customer_description);
-
- my %values;
- @values{@columns} = @{$rows_ref->[0]};
-
- return \%values;
-
- } else {
-
- return undef;
-
- }
-
-} # End of getLastAlertByType
-
-
-
-#----------------------------------------------
-sub getDestsByCustomer {
-
- # Get a list of all TelAlert destinations in the DB.
- # Returns a hash keyed on destination name.
-
- my ($self, $custid) = @_;
-
- my $sql_statement = "
- SELECT
- contact_methods.recid || ':' || contact_methods.method_name ref,
- contact_methods.method_name || '(i)' name
- FROM contact_methods, contact
- WHERE contact_methods.contact_id = contact.recid
- AND contact.customer_id = $custid
-
- UNION
-
- SELECT
- contact_groups.recid || ':' || contact_groups.contact_group_name ref,
- contact_groups.contact_group_name || '(g)' name
- FROM contact_groups
- WHERE contact_groups.customer_id = $custid
-
- ORDER BY name";
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- # Build a hash
- my %dests;
- map($dests{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%dests;
-
-} # End of getDestsByCustomer
-
-#----------------------------------------------
-sub getContactsByCustomer {
-
- # Returns a hash of row value hashes keyed on recid.
-
- my ($self, $custid) = @_;
-
- my $sql_statement = "
- SELECT recid, contact_last_name || ', ' || contact_first_name name
- FROM contact
- WHERE customer_id = ?";
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $custid);
-
- # Build a hash
- my %contacts;
- map($contacts{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%contacts;
-
-} # End of getContactsByCustomer
-
-
-#----------------------------------------------
-sub getContactMethodsByCustomer {
-
- # Get a list of all TelAlert contact method destinations in the DB.
- # Returns a hash of row value hashes keyed on recid.
-
- my ($self, $custid) = @_;
-
- my $sql_statement = "
- SELECT contact_methods.recid, contact_methods.method_name
- FROM contact_methods, contact
- WHERE contact_methods.contact_id = contact.recid
- AND contact.customer_id = ?";
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $custid);
-
- # Build a hash
- my %methods;
- map($methods{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%methods;
-
-} # End of getContactMethodsByCustomer
-
-
-#----------------------------------------------
-sub getContactMethodNameById {
-
- # Get the hostname for a particular host
-
- my ($self, $id) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT method_name
- FROM contact_methods
- WHERE recid = ?
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $id);
-
- # Return the hostname
- if (scalar(@$rows_ref)) {
- return $rows_ref->[0]->[0];
- } else {
- return undef;
- }
-} #end getContactMethodNameById
-
-#----------------------------------------------
-sub getContactGroupsByCustomer {
-
- # Get a list of all TelAlert group destinations in the DB.
- # Returns a hash of row value hashes keyed on recid
-
- my ($self, $custid) = @_;
-
- my $sql_statement = "
- SELECT recid, contact_group_name
- FROM contact_groups
- WHERE customer_id = ?";
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement,$custid);
-
- # Build a hash
- my %groups;
- map($groups{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%groups;
-
-} # End of getContactGroupsByCustomer
-
-#----------------------------------------------
-sub getContactGroupNameById {
-
- # Get the hostname for a particular host
-
- my ($self, $id) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT contact_group_name
- FROM contact_groups
- WHERE recid = ?
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $id);
-
- # Return the hostname
- if (scalar(@$rows_ref)) {
- return $rows_ref->[0]->[0];
- } else {
- return undef;
- }
-} #end getContaceGroupNameById
-
-#----------------------------------------------
-sub getHostnameByHostid {
-
- # Get the hostname for a particular host
-
- my ($self, $hostid) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT host_name
- FROM probes
- WHERE recid = ?
- AND probe_type = ?
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $hostid, 'HostProbe');
-
- # Return the hostname
- if (scalar(@$rows_ref)) {
- return $rows_ref->[0]->[0];
- } else {
- return undef;
- }
-} # End of getHostnameByHostid
-#----------------------------------------------
-sub getHostsByCustomer {
-
- # Get a list of all TelAlert destinations in the DB.
- # Returns a hash keyed on destination name.
-
- my ($self, $custid) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT
- host.recid,
- host.host_name
- FROM
- probes host,
- sat_cluster
- WHERE
- host.probe_type = ?
- AND host.netsaint_id = sat_cluster.recid
- AND sat_cluster.customer_id = ?
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, 'HostProbe', $custid);
-
- # Build a hash
- my %hosts;
- map($hosts{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%hosts;
-
-} # End of getHostsByCustomer
-
-
-
-#----------------------------------------------
-sub getPagerTypes {
-
- # Fetch pager type list from DB
- my ($self) = @_;
-
-
- my $sql_statement = sprintf<<EOSQL;
-SELECT Recid, Pager_Type_Name FROM pager_types
-EOSQL
-
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- # Build a hash
- my %pagertypes;
- map($pagertypes{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%pagertypes;
-
-} # End of sun getPagerTypes
-
-#----------------------------------------------
-
-sub getProbeTypeById {
-
- # Get the probe type for a particular probe
-
- my ($self, $id) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT probe_type
- FROM probes
- WHERE recid = ?
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $id);
-
- # Return the probe type
- if (scalar(@$rows_ref)) {
- return $rows_ref->[0]->[0];
- } else {
- return undef;
- }
-} #end getProbeTypeId
-
-
-#----------------------------------------------
-sub getProbeTypes {
-
- # Fetch probe type list from DB
- my ($self) = @_;
-
-
- my $sql_statement = sprintf<<EOSQL;
-SELECT probe_type, type_description FROM probe_types
-EOSQL
-
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- # Build a hash
- my %probetypes;
- map($probetypes{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%probetypes;
-
-} # End of sun getProbeTypes
-
-#----------------------------------------------
-sub getRedirectTypes {
-
- my $self=shift;
-
- my $sql_statement = "
- SELECT name, name || ' - ' || description as descr
- FROM redirect_types";
-
- my $rows_ref = $self->dbexec($sql_statement);
-
- my %types;
- map($types{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%types;
-}
-#----------------------------------------------
-sub getNextRedirectId {
-
- my ($self) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
-SELECT REDIRECTS_RECID_SEQ.NEXTVAL
-FROM dual
-EOSQL
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- if (scalar(@$rows_ref)) {
-
- my $id = $rows_ref->[0]->[0];
- return($id);
-
- } else {
-
- return undef; # $@ contains DB error
-
- }
-
-} # End of getNextRedirectId
-
-#----------------------------------------------
-sub addRedirect {
- my ($self, @args)= @_;
-
- my $sql_statement = "
- INSERT INTO redirects
- (recid, customer_id, contact_id, redirect_type, description, reason,
- expiration,
- last_update_user, last_update_date, start_date)
-
- VALUES
- (? , ?, ?, ?, ?, ?,
- TO_DATE(?,'yyyy-mm-dd hh24:mi:ss'),
- ?, SYSDATE, TO_DATE(?,'yyyy-mm-dd hh24:mi:ss'))";
-
- $self->dbexec($sql_statement, @args);
-
-}
-#----------------------------------------------
-sub updateRedirect {
- my ($self, $recid, $customer_id, $contact_id, $redirect_type,
- $description, $reason, $expiration, $last_update_user, $start_date) = @_;
-
- my $sql_statement = "
- UPDATE redirects
- SET
- customer_id = $customer_id,
- contact_id = $contact_id,
- redirect_type = \'$redirect_type\',
- description = \'$description\',
- reason = \'$reason\',
- expiration = TO_DATE(\'$expiration\', 'yyyy-mm-dd hh24:mi:ss'),
- last_update_user = \'$last_update_user\',
- last_update_date = SYSDATE,
- start_date = TO_DATE(\'$start_date\', 'yyyy-mm-dd hh24:mi:ss')
- WHERE
- recid = $recid";
-
- $self->dbexec($sql_statement);
-
-}
-
-#----------------------------------------------
-sub getNextRedirectCriteriaId {
-
- my ($self) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
-SELECT REDIRECT_CRITERIA_RECID_SEQ.NEXTVAL
-FROM dual
-EOSQL
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- if (scalar(@$rows_ref)) {
-
- my $id = $rows_ref->[0]->[0];
- return($id);
-
- } else {
-
- return undef; # $@ contains DB error
-
- }
-
-} # End of getNextRedirectId
-
-#----------------------------------------------
-sub addRedirectCriteria {
- my ($self, @args)= @_;
- my $recid = $self->getNextRedirectCriteriaId;
-
- my $sql_statement = "
- INSERT INTO redirect_criteria
- (recid, redirect_id, match_param, match_value, inverted)
-
- VALUES
- (?, ?, ?, ?, ?)";
-
- $self->dbexec($sql_statement, $recid, @args);
-
-}
-
-#----------------------------------------------
-sub addRedirectGroup {
- my ($self, @args)= @_;
-
- my $sql_statement = "
- INSERT INTO redirect_group_targets
- (redirect_id, contact_group_id)
-
- VALUES
- (?, ?)";
-
- $self->dbexec($sql_statement, @args);
-
-}
-
-#----------------------------------------------
-sub addRedirectMethod {
- my ($self, @args)= @_;
-
- my $sql_statement = "
- INSERT INTO redirect_method_targets
- (redirect_id, contact_method_id)
-
- VALUES
- (?, ?)";
-
- $self->dbexec($sql_statement, @args);
-
-}
-
-#----------------------------------------------
-sub addRedirectEmail {
- my ($self, @args)= @_;
-
- my $sql_statement = "
- INSERT INTO redirect_email_targets
- (redirect_id, email_address)
-
- VALUES
- (?, ?)";
-
- $self->dbexec($sql_statement, @args);
-
-}
-
-
-#----------------------------------------------
-sub deleteRedirectData {
- my ($self, $redir_id)= @_;
-
- my $archive_begin_statement = "
- INSERT INTO archive_master
- (customer_id, activity_code, table_name, key_col_1)
- VALUES (?,?,?,?)";
-
- my $archive_end_statement = "
- DELETE FROM archive_master
- WHERE customer_id = ?
- AND activity_code = ?
- AND table_name = ?
- AND key_col_1 = ?";
-
- my $sql_statement;
-
- $sql_statement = "
- DELETE FROM redirect_email_targets
- WHERE redirect_id = ?";
-
- $self->dbexec($archive_begin_statement, 1, 'DEL', 'redirect_email_targets', 'redirect_id');
- $self->dbexec($sql_statement, $redir_id);
- $self->dbexec($archive_end_statement, 1, 'DEL', 'redirect_email_targets', 'redirect_id');
-
- $sql_statement = "
- DELETE FROM redirect_method_targets
- WHERE redirect_id = ?";
-
- $self->dbexec($archive_begin_statement, 1, 'DEL', 'redirect_method_targets', 'redirect_id');
- $self->dbexec($sql_statement, $redir_id);
- $self->dbexec($archive_end_statement, 1, 'DEL', 'redirect_method_targets', 'redirect_id');
-
- $sql_statement = "
- DELETE FROM redirect_group_targets
- WHERE redirect_id = ?";
-
- $self->dbexec($archive_begin_statement, 1, 'DEL', 'redirect_group_targets', 'redirect_id');
- $self->dbexec($sql_statement, $redir_id);
- $self->dbexec($archive_end_statement, 1, 'DEL', 'redirect_group_targets', 'redirect_id');
-
- $sql_statement = "
- DELETE FROM redirect_criteria
- WHERE redirect_id = ?";
-
- $self->dbexec($archive_begin_statement, 1, 'DEL', 'redirect_criteria', 'redirect_id');
- $self->dbexec($sql_statement, $redir_id);
- $self->dbexec($archive_end_statement, 1, 'DEL', 'redirect_criteria', 'redirect_id');
-}
-
-#----------------------------------------------
-sub deleteRedirect {
- my ($self, $redir_id)= @_;
-
- my $sql_statement = "
- DELETE FROM redirects
- WHERE recid = ?";
-
- $self->dbexec($sql_statement, $redir_id);
-}
-
-#----------------------------------------------
-sub getRedirectById {
-
-#Fetch all the redirect with the specified recid
-
- my ($self, $recid) = @_;
-
- my $sql_statement = "
- SELECT redirects.recid,
- redirects.redirect_type,
- redirects.expiration,
- redirects.contact_id,
- redirects.reason,
- redirects.description,
- customer.recid,
- customer.description,
- TO_CHAR (redirects.expiration, 'yyyy-mm-dd hh24:mi:ss'),
- redirects.start_date,
- TO_CHAR (redirects.start_date, 'yyyy-mm-dd hh24:mi:ss')
-
- FROM redirects,
- customer
- WHERE redirects.recid = ?
- AND redirects.customer_id = customer.recid
- ";
-
-#Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $recid);
-
- if ( scalar(@$rows_ref) ) {
-
- my %row;
- my @columns = qw( recid redirect_type expiration contact_id reason description cust_id cust_name formatted_expiration start_date formatted_start_date);
-
- my $row_ref=$rows_ref->[0];
-
- @row{@columns} = @$row_ref;
- return \%row;
-
- } else {
-
- return {};
-
- }
-
-} # End of getRedirectById
-
-#----------------------------------------------
-
-sub getContactMethodsByRedirectId {
-
- my $self = shift;
- my $redirid = shift;
-
- my $sql_statement = "
- SELECT contact_method_id
- FROM redirect_method_targets
- WHERE redirect_id = ?
- ";
-
-# Fetch the data
-my $rows_ref = $self->dbexec($sql_statement, $redirid);
-
-my @methods = map($_->[0], @$rows_ref);
-
-return \@methods;
-
-
-}
-
-#----------------------------------------------
-
-sub getContactGroupsByRedirectId {
-
- my $self = shift;
- my $redirid = shift;
-
- my $sql_statement = "
- SELECT contact_group_id
- FROM redirect_group_targets
- WHERE redirect_id = ?
- ";
-
-# Fetch the data
-my $rows_ref = $self->dbexec($sql_statement, $redirid);
-
-my @groups = map($_->[0], @$rows_ref);
-
-return \@groups;
-
-
-}
-
-#----------------------------------------------
-
-sub getRedirectMatchTypes {
-
- my $self = shift;
-
- my $sql_statement = "
- SELECT name
- FROM redirect_match_types
- ";
-
-# Fetch the data
-my $rows_ref = $self->dbexec($sql_statement);
-
-my @types = map($_->[0], @$rows_ref);
-
-return \@types;
-
-
-}
-
-#----------------------------------------------
-sub getRedirectDetailsById {
-#Fetch the detailed criteria for the specified redirect
-
- my ($self, $redir_id) = @_;
-
- if ($self->dbIsOkay) {
-
- my $sql_statement = "
- SELECT match_param,
- match_value,
- inverted
- FROM redirect_criteria
- WHERE redirect_criteria.redirect_id = ?
- ORDER BY match_param";
-
- #Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $redir_id);
-
- my ($row_ref, $row_id);
- my %table;
-
- if ( scalar(@$rows_ref) ) {
-
- my @columns = qw( match_param match_value inverted );
-
-
- my $row_id = 0;
- foreach $row_ref (@$rows_ref) {
-
- my %row;
- $row_id++;
- @row{@columns} = @$row_ref;
- $table{$row_id} = \%row;
-
- }
-
- return \%table;
-
- } else {
-
- return {};
-
- }
- } else {
-
- # We can't reach the database -- use the local store
-
- my %hash;
- dbmopen(%hash,$REDIRECT_FILE,undef) || print STDERR "Unable to open $REDIRECT_FILE: $! ";
- my $r=$hash{$redir_id};
- dbmclose(%hash) || print STDERR "Unable to close $REDIRECT_FILE: $! ";
-
- if ($r) {
- my ($rec)=thaw($r);
- return $rec->{'criteria'}
- } else {
- return undef
- }
- }
-
-} # End of getRedirectDetailsById
-
-#----------------------------------------------
-sub getCurrentRedirectsByCustomer {
-
-#Fetch all non-expired redirects for this company from DB
-
- my ($self, $customer_id) = @_;
-
- if ($self->dbIsOkay()) {
- my $sql_statement = "
- SELECT recid,
- redirect_type,
- expiration,
- contact_id,
- reason,
- description,
- start_date
- FROM redirects
- WHERE redirects.customer_id = ?
- AND expiration >= sysdate
- AND start_date <= sysdate";
-
- #Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $customer_id);
-
- if ( scalar(@$rows_ref) ) {
-
- my (%table, $row_ref);
- my @columns = qw( recid redirect_type expiration contact_id reason description start_date);
-
- foreach $row_ref (@$rows_ref) {
-
- my %row;
- @row{@columns} = @$row_ref;
- $table{$row{'recid'}} = \%row;
-
- }
-
- return \%table;
-
- } else {
- return {};
- }
- } else {
-
- # We can't reach the database -- use the local store
-
- my %hash;
- dbmopen(%hash,$CUSTOMER_REDIRECT_FILE,undef) || print STDERR "Unable to open $CUSTOMER_REDIRECT_FILE: $! ";
- my $r=$hash{$customer_id};
- dbmclose(%hash) || print STDERR "Unable to close $CUSTOMER_REDIRECT_FILE: $! ";
-
- if (!$r) {
- return {}
- }
-
- my @redirects=thaw($r);
-
- my %hash2;
- dbmopen(%hash2,$REDIRECT_FILE,undef) || print STDERR "Unable to open $REDIRECT_FILE: $! ";
- my %rethash = map {
- my $r=$hash2{$_};
- my ($rec)=thaw($r);
- $_ => $rec;
- } @redirects;
-
- return \%rethash;
-
- }
-
-} # End of getCurrentRedirectsByCustomer
-#----------------------------------------------
-sub getRedirectsByCustomer {
-
-#Fetch all redirects for this company from DB
-
- my ($self, $customer_id) = @_;
-
- my $sql_statement = "
- SELECT recid,
- redirect_type,
- expiration,
- contact_id,
- reason,
- description,
- TO_CHAR (expiration, 'yyyy-mm-dd hh24:mi:ss'),
- expiration - SYSDATE,
- start_date,
- TO_CHAR (start_date, 'yyyy-mm-dd hh24:mi:ss'),
- SYSDATE - start_date
- FROM redirects
- WHERE redirects.customer_id = ?";
-
-#Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $customer_id);
-
- if ( scalar(@$rows_ref) ) {
-
- my (%table, $row_ref);
- my @columns = qw( recid redirect_type expiration contact_id reason description formatted_expiration expired_days start_date formatted_start_date active_days);
-
- foreach $row_ref (@$rows_ref) {
-
- my %row;
- @row{@columns} = @$row_ref;
- $table{$row{'recid'}} = \%row;
-
- }
-
- return \%table;
-
- } else {
-
- return {};
-
- }
-
-} # End of getRedirectsByCustomer
-
-
-#----------------------------------------------
-sub getRedirectDests {
-
- # Fetch all destinations for this redirect
-
- my ($self, $redirect_id) = @_;
-
- if ($self->dbIsOkay) {
- my $sql_statement = "
- SELECT contact.customer_id || '_' || contact_methods.recid || '_' || contact_methods.method_name
- FROM
- redirect_method_targets,
- contact_methods,
- contact
- WHERE redirect_method_targets.redirect_id = $redirect_id
- AND redirect_method_targets.contact_method_id = contact_methods.recid
- AND contact_methods.contact_id = contact.recid
-
- UNION
-
- SELECT contact_groups.customer_id || '_' || contact_groups.recid || '_' || contact_groups.contact_group_name
- FROM
- redirect_group_targets,
- contact_groups
- WHERE redirect_group_targets.redirect_id = $redirect_id
- AND redirect_group_targets.contact_group_id = contact_groups.recid";
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- my @dests = map($_->[0], @$rows_ref);
-
- return @dests;
- } else {
- # We can't reach the database -- use the local store
-
- my @dests;
- my %hash;
- dbmopen(%hash,$REDIRECT_FILE,undef) || print STDERR "Unable to open $REDIRECT_FILE: $! ";
- my $r=$hash{$redirect_id};
- dbmclose(%hash) || print STDERR "Unable to close $REDIRECT_FILE: $! ";
-
- if ($r) {
- my ($rec)=thaw($r);
- my $g=$rec->{'groups'};
- foreach (keys(%$g)) {
- my $str=$rec->{'customer_id'};
- $str .= "_" . $_;
- $str .= "_" . $g->{$_};
- push(@dests, $str);
- }
- my $m=$rec->{'methods'};
- foreach (keys(%$m)) {
- my $str=$rec->{'customer_id'};
- $str .= "_" . $_;
- $str .= "_" . $m->{$_};
- push(@dests, $str);
- }
-
- return @dests;
- }
- }
-
-
-} # End of getRedirectDests
-
-#----------------------------------------------
-sub getRedirectEmails {
-
- # Fetch all ad-hoc email destinations for this redirect
-
- my ($self, $redirect_id) = @_;
-
- if ($self->dbIsOkay) {
- my $sql_statement = "
- SELECT email_address
- FROM redirect_email_targets
- WHERE redirect_id = $redirect_id";
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- my @dests = map($_->[0], @$rows_ref);
-
- return @dests;
- } else {
-
- # We can't reach the database -- use the local store
-
- my %hash;
- dbmopen(%hash,$REDIRECT_FILE,undef) || print STDERR "Unable to open $REDIRECT_FILE: $! ";
- my $r=$hash{$redirect_id};
- dbmclose(%hash) || print STDERR "Unable to close $REDIRECT_FILE: $! ";
-
- if ($r) {
- my ($rec)=thaw($r);
- $rec=$rec->{'emails'};
- return @$rec if $rec;
- }
- }
- return ();
-
-} # End of getRedirectEmails
-
-#----------------------------------------------
-sub getFormatForContactMethodId {
- my ($self, $recid) = @_;
-
- if ($self->dbIsOkay) {
-
- my $sql_statement = "
- SELECT n.recid, n.customer_id, n.description, n.subject_format,
- n.body_format, n.max_subject_length, n.max_body_length
- FROM notification_formats n, contact_methods m
- WHERE m.notification_format_id = n.recid
- AND m.recid = ?";
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $recid);
-
- if ( scalar(@$rows_ref) ) {
-
- my @columns = qw(recid customer_id description subject_format body_format max_subject_length max_body_length);
- my %values;
- @values{@columns} = @{$rows_ref->[0]};
- return \%values;
-
- }
- }
-
- return $self->getFormatFromDBM("i$recid");
-}
-
-#----------------------------------------------
-sub getFormatForContactGroupId {
- my ($self, $recid) = @_;
-
- if ($self->dbIsOkay) {
-
- my $sql_statement = "
- SELECT n.recid, n.customer_id, n.description, n.subject_format,
- n.body_format, n.max_subject_length, n.max_body_length
- FROM notification_formats n, contact_groups g
- WHERE g.notification_format_id = n.recid
- AND g.recid = ?";
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $recid);
-
- if ( scalar(@$rows_ref) ) {
-
- my @columns = qw(recid customer_id description subject_format body_format max_subject_length max_body_length);
- my %values;
- @values{@columns} = @{$rows_ref->[0]};
- return \%values;
-
- }
- }
-
- return $self->getFormatFromDBM("g$recid");
-}
-
-#----------------------------------------------
-sub getFormatFromDBM {
- my ($self, $recid) = @_;
-
- # Value not found with the database -- try the dbm
- # Get the format id
-
- my %hash;
- dbmopen(%hash,$CONTACT_FORMAT_FILE,undef) || warn "Unable to open $CONTACT_FORMAT_FILE: $! ";
- my $id = $hash{$recid};
-
- return undef unless $id;
- dbmclose(%hash)|| warn "Unable to close $CONTACT_FORMAT_FILE: $! ";
-
- # Get the format itself
-
- my %hash2;
- dbmopen(%hash2,$FORMAT_FILE,undef) || warn "Unable to open $FORMAT_FILE: $! ";
- my $value = $hash2{$id};
-
-
- return undef unless $value;
- dbmclose(%hash2) || warn "Unable to close $FORMAT_FILE: $! ";
-
- # Parse the format and return it as a hash
-
- my ($fmt) = thaw($value);
- return $fmt
-}
-
-#----------------------------------------------
-sub getSatellites {
-
- # Fetch all TelAlert servers listed in DB
- my ($self) = @_;
-
- #--- For now, the scope in terms of company, not contact
- my $sql_statement = sprintf<<EOSQL;
-SELECT
- recid,
- description
-FROM
- sat_cluster
-EOSQL
-
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- # Build a hash
- my %satellites;
- map($satellites{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%satellites;
-
-} # End of getSatellites
-
-
-#----------------------------------------------
-sub getSatellitesByCustomer {
-
- # Fetch all TelAlert servers listed in DB
- my ($self, $custid) = @_;
-
- #--- For now, the scope in terms of company, not contact
- my $sql_statement = sprintf<<EOSQL;
-SELECT
- recid,
- description
-FROM
- sat_cluster
-WHERE
- customer_id = ?
-EOSQL
-
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $custid);
-
- # Build a hash
- my %satellites;
- map($satellites{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%satellites;
-
-} # End of getSatellitesByCustomer
-
-
-
-
-
-#----------------------------------------------
-sub getScoutsByCustomer {
-
- # Fetch all TelAlert servers listed in DB
- my ($self, $custid) = @_;
-
- #--- For now, the scope in terms of company, not contact
- my $sql_statement = sprintf<<EOSQL;
-SELECT
- recid,
- description
-FROM
- sat_cluster sc,
- ll_netsaint ll
-WHERE
- customer_id = ?
-AND ll.netsaint_id = sc.recid
-EOSQL
-
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $custid);
-
- # Build a hash
- my %scouts;
- map($scouts{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%scouts;
-
-} # End of getScoutsByCustomer
-
-
-
-
-#----------------------------------------------
-sub getUrlsByCustomer {
-
- # Fetch all TelAlert servers listed in DB
- my ($self, $custid) = @_;
-
- #--- For now, the scope in terms of company, not contact
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT s.url_probe_id, s.description, s.url
- FROM url_probe_role r, url_probe_step s
- WHERE r.url_probe_id = s.url_probe_id
- AND r.customer_id = ?
-EOSQL
-
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $custid);
-
- # Return the results
- return $rows_ref;
-
-} # End of getUrlsByCustomer
-
-
-
-#----------------------------------------------
-sub getServers {
-
- # Fetch all TelAlert servers listed in DB
- my ($self) = @_;
-
- #--- For now, the scope in terms of company, not contact
- my $sql_statement = sprintf<<EOSQL;
-SELECT recid, telalert_name
-FROM telalerts
-ORDER BY telalert_name
-EOSQL
-
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- # Build a hash
- my %servers;
- map($servers{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%servers;
-
-} # End of getServers
-
-
-#----------------------------------------------
-sub getServerNames {
-
- # Fetch all TelAlert servers listed in DB
- my ($self) = @_;
-
- #--- For now, the scope in terms of company, not contact
- my $sql_statement = sprintf<<EOSQL;
-SELECT telalert_name
-FROM telalerts
-ORDER BY telalert_name
-EOSQL
-
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- # Build array
- my @servers;
- map(push(@servers, $_->[0]), @$rows_ref);
-
- return @servers;
-
-}
-
-#----------------------------------------------
-sub getTelAlertServerIDByName {
-
- my ($self,$name) = @_;
-
- if ($self->dbIsOkay) {
- my $sql_statement = "
- SELECT recid
- FROM telalerts
- WHERE telalert_name = ?";
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $name);
-
- if (scalar(@$rows_ref)) {
-
- my $serverid = $rows_ref->[0]->[0];
- return $serverid; # $@ contains DB error
-
- } else {
- return undef
- }
- } else {
- # We can't reach the database -- use the local store
-
- my %hash;
- dbmopen(%hash,$TELALERTS_FILE,undef) || print STDERR "Unable to open $TELALERTS_FILE: $! ";
- my $r=$hash{$name};
-
- dbmclose(%hash) || print STDERR "Unable to close $TELALERTS_FILE: $! ";
-
- return $r
- }
-
-} # End of getTelAlertServerIDByName
-
-
-
-#----------------------------------------------
-sub getTelAlertServerID {
-
- my ($self) = @_;
-
- #Return cached ID if it exists
- if (defined($self->serverid())) {
-
- return($self->serverid());
-
- } else {
-
- # Determine the TelAlert server's IP address
- my $ip = $self->getMyIP;
-
- # Get the recid for this server's ip address
- my $serverid = $self->getTelAlertServerIDByName($ip);
- $self->serverid($serverid);
- return($serverid);
- }
-} # End of getTelAlertServerID
-
-
-
-#----------------------------------------------
-sub getCustomers {
-
- my ($self) = @_;
-
- # Get all customer recids
- my $sql_statement = sprintf<<EOSQL;
-SELECT recid,description
-FROM customer
-ORDER BY recid
-EOSQL
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- # Build a hash
- my %names;
- map($names{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%names;
-
-
-} # End of getCustomers
-
-
-
-#----------------------------------------------
-sub getServiceProbes {
-
- my ($self) = @_;
-
- # Get all customer recids
- my $sql_statement = sprintf<<EOSQL;
-SELECT recid,description
-FROM customer
-ORDER BY recid
-EOSQL
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- # Build a hash
- my %names;
- map($names{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%names;
-
-
-} # End of getServiceProbes
-
-
-
-#----------------------------------------------
-sub getServiceProbesByHost {
-
- my($self, $hostid) = @_;
-
- # Get all customer recids
- my $sql_statement = sprintf<<EOSQL;
-SELECT svc.recid,svc.description
-FROM probes host, probes svc
-WHERE svc.parent_probes_id = host.recid
-AND host.recid = ?
-EOSQL
-
- # Fetch the data
- my $rows_ref = $self->dbexec($sql_statement, $hostid);
-
- # Build a hash
- my %names;
- map($names{$_->[0]} = $_->[1], @$rows_ref);
-
- return \%names;
-
-
-} # End of getServiceProbesByHost
-
-
-
-#----------------------------------------------
-sub getDescByServiceid {
-
- # Get the service description for a particular service probe
-
- my ($self, $svcid) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT description
- FROM probes
- WHERE recid = ?
- AND probe_type = ?
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $svcid, 'ServiceProbe');
-
- # Return the hostname
- if (scalar(@$rows_ref)) {
- return $rows_ref->[0]->[0];
- } else {
- return undef;
- }
-
-
-} # End of getDescByServiceid
-
-
-
-#----------------------------------------------
-sub getDescByCustomerid {
-
- # Get the description for a particular customer
-
- my ($self, $svcid) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT description
- FROM customer
- WHERE recid = ?
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $svcid);
-
- # Return the hostname
- if (scalar(@$rows_ref)) {
- return $rows_ref->[0]->[0];
- } else {
- return undef;
- }
-
-
-} # End of getDescByCustomerid
-
-
-
-#----------------------------------------------
-sub getDescBySatelliteid {
-
- # Get the description for a particular satellite
-
- my ($self, $svcid) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT description
- FROM sat_cluster
- WHERE recid = ?
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $svcid);
-
- # Return the hostname
- if (scalar(@$rows_ref)) {
- return $rows_ref->[0]->[0];
- } else {
- return undef;
- }
-
-
-} # End of getDescBySatelliteid
-
-
-#----------------------------------------------
-sub getContactEmailForDestination {
-
- # Get the email belonging to the destination's contact
-
- my ($self, $dest_name, $cust_id) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT contact.email_address
- FROM contact_methods, contact
- WHERE contact.recid = contact_methods.contact_id
- AND contact_methods.method_name = ?
- AND contact.customer_id = ?
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $dest_name, $cust_id);
-
- # Return the email address
- if (scalar(@$rows_ref)) {
- return $rows_ref->[0]->[0];
- } else {
- return undef;
- }
-
-
-} # End of getContactEmailForDestination
-
-#----------------------------------------------
-sub getTicketCaseNumWithDescription {
-
- # Get the email belonging to the destination's contact
-
- my ($self, $desc) = @_;
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT MAX(case_num)
- FROM hd_problem
- WHERE short_desc = ?
- AND trunc(date_mod) + 1 >= trunc(sysdate)
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement, $desc);
-
- # Return the case number
- if (scalar(@$rows_ref)) {
- return $rows_ref->[0]->[0];
- } else {
- return undef;
- }
-
-
-} # End of getTicketCaseNumWithDescription
-
-
-#----------------------------------------------
-
-sub updateTicketProblemWithCaseNum {
-
- my ($self, $casenum, $problem) = @_;
- my $p='';
-
- my $sql_statement = sprintf<<EOSQL;
- SELECT problem
- FROM hd_problem
- WHERE case_num = '$casenum'
-EOSQL
-
- # Get the data
- my $rows_ref = $self->dbexec($sql_statement);
-
- # Return the case number
- if (scalar(@$rows_ref)) {
- $p=$rows_ref->[0]->[0];
- };
-
- $p .= "$problem\n";
- $p =~ s/'/''/g;
- $p =~ s/'''/''/g;
-
- $sql_statement = "
- UPDATE innovate.hd_problem
- SET
- problem = '$p [' || TO_CHAR(SYSDATE,'MM/DD/YYYY HH:MI:SS AM') || ']\n',
- status = 'Pending'
- WHERE
- case_num = '$casenum'";
-
- $self->dbexec($sql_statement);
-
- $self->commit();
-
- return length($@);
-
-}
-
-#----------------------------------------------
-sub putStates {
-
- # Save details of a new alert into the DB
- my ($self, @args) = @_;
- my @fields = qw(tel_args message ticket_id destination_name
- host_probe_id host_state service_probe_id service_state
- customer_id netsaint_id probe_type event_timestamp);
- my ($next_recid, %args);
-
- @args{@fields} = @args;
-
- # Get a good recid for the CURRENT_ALERTS table
- my $sql_statement = "
- SELECT CURRENT_ALERTS_RECID_SEQ.NEXTVAL
- FROM dual";
- my $rows_ref = $self->dbexec($sql_statement);
- $next_recid = $rows_ref->[0]->[0];
-
- # Construct the other fields
- my $serverid = $self->getTelAlertServerID();
-
- # Populate the current_alerts table
- $sql_statement = "
- INSERT INTO current_alerts
- (recid, date_submitted, last_server_change, date_completed,
- original_server, current_server, tel_args, message, ticket_id,
- destination_name, escalation_level, host_probe_id, host_state,
- service_probe_id, service_state, customer_id, netsaint_id,
- probe_type, last_update_date, event_timestamp)
- VALUES (?,
- sysdate,
- sysdate,
- NULL, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?,
- sysdate, TO_DATE(?, 'YYYY-MM-DD HH24:MI:SS')
- )";
-
- my @array=($sql_statement,
- $next_recid,
- $serverid, $serverid, $args{'tel_args'}, $args{'message'},
- $args{'ticket_id'}, $args{'destination_name'}, 0,
- $args{'host_probe_id'}, $args{'host_state'},
- $args{'service_probe_id'}, $args{'service_state'},
- $args{'customer_id'}, $args{'netsaint_id'},
- $args{'probe_type'}, $args{'event_timestamp'});
-
- $self->dbexec(@array);
-
- $self->commit();
-
-} # End of putStates
-
-#----------------------------------------------
-sub clearAlert {
-
- # Set a complete date on an alert in the database
- my ($self, $ticketid) = @_;
-
-
- # Update the current_alerts table
- my $sql_statement = "
- UPDATE current_alerts
- SET date_completed=sysdate,
- last_update_date=sysdate
- WHERE ticket_id = ?
- ";
-
- my ($dataref,$errcode,$errstring,$sql,@bindvars)=
- $self->dbexec($sql_statement, $ticketid);
- return ($dataref,$errcode,$errstring,$sql,@bindvars) if $errcode;
-
- my ($commit_code,$commit_err)=$self->commit();
- return ($dataref,$commit_code,$commit_err,$sql,@bindvars) if $commit_code;
-
- return ($dataref,$errcode,$errstring,$sql,@bindvars);
-
-} # End of clearAlert
-
-
-
-#----------------------------------------------
-sub desc {
- my($self, $tablename) = @_;
-
- my $sql = "SELECT LOWER(t.column_name),t.data_type,
- t.data_precision,t.nullable
- FROM all_tab_columns t, all_synonyms s
- WHERE UPPER(t.table_name) = UPPER(?)
- AND t.table_name = s.table_name
- AND t.owner = s.table_owner
- AND s.owner = 'PUBLIC'
- ORDER BY t.column_id";
-
-# my $sql = "SELECT LOWER(t.column_name),t.data_type,
-# t.data_precision,t.nullable
-# FROM all_tab_columns t
-# WHERE UPPER(t.table_name) = UPPER(?)
-# ORDER BY t.column_id";
-
-# my $output = $self->dbexec($sql, $tablename);
- my $output = $self->dbexec($sql, $tablename);
-
- return $output;
-}
-
-
-
-
-
-#----------------------------------------------
-sub getTable {
- # Load an entire DB table into a Perl data structure
- my($self, $tablename, $keyfield, $notunique) = @_;
-
- # Return table from cache if it exists there
- if ($self->tablecache) {
- return $TABLE{"$tablename.$keyfield"} if ($TABLE{"$tablename.$keyfield"});
- }
-
-
- # Get table description
- my $tabledesc = $self->desc($tablename);
-
- # Apply any formats
- my (@fspecs, @fields);
- my $row;
- foreach $row (@$tabledesc) {
- my($colname, $type, $size, $nullable) = @$row;
- push(@fields, $colname);
- if ($type eq 'DATE') {
- push(@fspecs, sprintf("TO_CHAR(%s, '%s')", $colname, $self->dateformat));
- } else {
- push(@fspecs, $colname);
- }
- }
-
- my $fields = join(",", @fspecs);
-
- # Now load the table into a hash
- my $sql = "SELECT $fields FROM $tablename";
-
- my $output = $self->dbexec($sql);
-
- my $record;
- my %table;
- foreach $record (@$output) {
- my %field;
- @field{@fields} = @$record;
- if ($notunique) {
- push(@{$table{$field{$keyfield}}}, \%field);
- } else {
- $table{$field{$keyfield}} = \%field;
- }
- }
-
-
- $TABLE{"$tablename.$keyfield"} = \%table if ($self->tablecache);
- return \%table;
-
-} # End of getTable
-
-#----------------------------------------------
-
-sub getCursorForStatement {
- my ($self, $sql_statement) = @_;
-
- # Make sure we have an open DB handle
- $self->connect() unless ($self->connected());
- return undef unless ($self->connected());
-
- # Prepare the statement handle
- my $statement_handle = $self->dbh->prepare($sql_statement);
- if (!$statement_handle) {print STDERR "$sql_statement\n"; $@ = $DBI::errstr ; return undef }
-
- # Execute the query
- my $rc = $statement_handle->execute();
- if (!$rc) {$@ = $DBI::errstr ; return undef }
-
- return $statement_handle;
-
-}
-#----------------------------------------------
-
-sub getTableCursor {
- my ($self, $tableName) = @_;
- my $sql_statement="select * from $tableName";
-
- return $self->getCursorForStatement($sql_statement);
-}
-
-
-#----------------------------------------------
-sub clearTableCache {
-
- my($self, $tablename, $keyfield) = @_;
-
- if (defined($tablename) && defined($keyfield)) {
-
- # Clear out the specified cache entry
- delete($TABLE{"$tablename.$keyfield"});
-
- } elsif (defined($tablename)) {
-
- # Clear out all cache entries for this table
- my $key;
- foreach $key (keys %TABLE) {
- if ($key =~ /^$tablename\./) {
- delete($TABLE{$key});
- }
- }
-
- } else {
-
- # Clear the table cache
- %TABLE = ();
-
- }
-}
-
-sub bumpEscalation {
- my ($self, $ticket_id) = @_;
-
- my $sql = "SELECT ESCALATION_LEVEL " .
- "FROM CURRENT_ALERTS " .
- "WHERE TICKET_ID = ?";
-
- my ($rows_ref,$errcode,$errstring,$sql_statement,@bindvars) =
- $self->dbexec($sql, $ticket_id);
- if ($errcode) {
- return($rows_ref,$errcode,$errstring,$sql_statement,@bindvars);
- }
-
- my %escalate_to = ('NULL' => '1', 'NOT NULL' => 'ESCALATION_LEVEL + 1');
- foreach my $row (@$rows_ref) {
- my $isnull = (defined($row->[0]) ? 'NOT NULL' : 'NULL');
-
- $sql = "UPDATE CURRENT_ALERTS " .
- "SET ESCALATION_LEVEL = $escalate_to{$isnull}, " .
- "last_update_date = sysdate" .
- "WHERE TICKET_ID = ? " .
- "AND ESCALATION_LEVEL IS $isnull";
-
- my ($rows_ref,$errcode,$errstring,$sql_statement,@bindvars) =
- $self->dbexec($sql, $ticket_id);
- if ($errcode) {
- return($rows_ref,$errcode,$errstring,$sql_statement,@bindvars);
- }
- }
-
- $self->commit();
- return($rows_ref,$errcode,$errstring,$sql_statement,@bindvars);
-}
-
-sub send_as_snmp_trap {
- my ($self,$output,@bindvars)= @_;
-
-# $sender_cluster_id, $dest_ip, $dest_port, $date_generated,
-# $command_name, $notif_type, $op_center, $os_name, $message, $probe_id,
-# $host_ip, $severity, $command_id, $probe_class, $host_name) = @bindvars;
-
- my $sql="
- INSERT INTO SNMP_ALERT
- ( RECID,
- SENDER_CLUSTER_ID, DEST_IP, DEST_PORT, DATE_GENERATED, DATE_SUBMITTED,
- COMMAND_NAME, NOTIF_TYPE, OP_CENTER, NOTIF_URL, OS_NAME, MESSAGE, PROBE_ID,
- HOST_IP, SEVERITY, COMMAND_ID, PROBE_CLASS, HOST_NAME, SUPPORT_CENTER )
- SELECT SNMP_ALERT_RECID_SEQ.NEXTVAL,
- ?, ?, ?, TO_DATE(?,'DY MON DD HH24:MI:SS YYYY'), SYSDATE,
- ?, ?, ?, ?, ?, ?, ?,
- ?, ?, ?, ?, ?, NULL from DUAL";
-
- my @array=$self->dbexecute($sql,@bindvars);
-
- $self->commit();
- return @array;
-}
-
-1;
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD b/monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD
deleted file mode 100644
index d8153ba..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD
+++ /dev/null
@@ -1,52 +0,0 @@
-# Macros
-%define cvs_package PerlModules/NP/Time-System
-
-# Package specific stuff
-Name: Time-System
-Version: 1.6.0
-Release: 1
-Packager: Dave Faraldo <dfaraldo(a)redhat.com>
-Summary: gettimeofday() and settimeofday() system calls
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-BuildArch: i386
-Requires: perl np-config
-Provides: Time::System
-Group: unsorted
-Copyright: (c) 2002-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Prefix: %{_our_prefix}
-Buildroot: %{_tmppath}/%cvs_package
-
-%description
-
-Time::System provides access to the gettimeofday() and settimeofday()
-system calls. In scalar context, B<gettimeofday()> returns seconds
-and microseconds as a single floating-point number; in array context,
-it returns them separately. Similarly, B<settimeofday()> may be
-called with a single floating-point number, or with seconds and
-microseconds passed as separate arguments.
-
-
-%prep
-%entirely_abstract_build_step
-
-
-%build
-%makefile_build
-
-
-%install
-rm -rf $RPM_BUILD_ROOT
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-%makefile_install
-%point_scripts_to_correct_perl
-%make_file_list
-
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-
-%clean
-%abstract_clean_script
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD.spec b/monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD.spec
deleted file mode 100644
index 1188483..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/BUILD.spec
+++ /dev/null
@@ -1,59 +0,0 @@
-Summary: Time-System Perl module
-Name: Time-System
-Source9999: version
-Version: %(echo `awk '{ print $1 }' %{SOURCE9999}`)
-Release: %(echo `awk '{ print $2 }' %{SOURCE9999}`)
-Requires: perl np-config
-Provides: Time::System
-Packager: Nicholas Hansen <nhansen(a)redhat.com>
-License: GPL or Artistic
-Group: Development/Libraries
-BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root
-BuildRequires: perl >= 2:5.8.0
-Requires: %(perl -MConfig -le 'if (defined $Config{useithreads}) { print "perl(:WITH_ITHREADS)" } else { print "perl(:WITHOUT_ITHREADS)" }')
-Requires: %(perl -MConfig -le 'if (defined $Config{usethreads}) { print "perl(:WITH_THREADS)" } else { print "perl(:WITHOUT_THREADS)" }')
-Requires: %(perl -MConfig -le 'if (defined $Config{uselargefiles}) { print "perl(:WITH_LARGEFILES)" } else { print "perl(:WITHOUT_LARGEFILES)" }')
-Source0: %{name}-%PACKAGE_VERSION.tar.gz
-
-%description
-
-Time::System provides access to the gettimeofday() and settimeofday()
-system calls. In scalar context, B<gettimeofday()> returns seconds
-and microseconds as a single floating-point number; in array context,
-it returns them separately. Similarly, B<settimeofday()> may be
-called with a single floating-point number, or with seconds and
-microseconds passed as separate arguments.
-
-
-%prep
-%setup -q
-
-%build
-CFLAGS="$RPM_OPT_FLAGS" perl Makefile.PL PREFIX=$RPM_BUILD_ROOT%{_prefix}
-make OPTIMIZE="$RPM_OPT_FLAGS"
-
-%install
-rm -rf $RPM_BUILD_ROOT
-eval `perl '-V:installarchlib'`
-mkdir -p $RPM_BUILD_ROOT$installarchlib
-%makeinstall
-rm -f `find $RPM_BUILD_ROOT -type f -name perllocal.pod -o -name .packlist`
-
-[ -x %{_prefix}/lib/rpm/brp-compress ] && %{_prefix}/lib/rpm/brp-compress
-
-find $RPM_BUILD_ROOT%{_prefix} -type f -print | \
- sed "s@^$RPM_BUILD_ROOT@@g" > %{name}-%{version}-%{release}-filelist
-if [ "$(cat %{name}-%{version}-%{release}-filelist)X" = "X" ] ; then
- echo "ERROR: EMPTY FILE LIST"
- exit 1
-fi
-
-%clean
-rm -rf $RPM_BUILD_ROOT
-
-%files -f %{name}-%{version}-%{release}-filelist
-%defattr(-,root,root,-)
-
-%changelog
-* Tue Mar 29 2005 Nicholas Hansen <nhansen(a)redhat.com> - 1-8
-- Specfile autogenerated.
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/Changes b/monitoring/PerlModules/NP/NOT-USED/Time-System/Changes
deleted file mode 100644
index 482df63..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/Changes
+++ /dev/null
@@ -1,6 +0,0 @@
-Revision history for Perl extension Time::System.
-
-0.01 Fri Sep 5 18:25:51 2003
- - original version; created by h2xs 1.21 with options
- -A -n Time::System
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/MANIFEST b/monitoring/PerlModules/NP/NOT-USED/Time-System/MANIFEST
deleted file mode 100644
index 89e7dcb..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/MANIFEST
+++ /dev/null
@@ -1,7 +0,0 @@
-Changes
-Makefile.PL
-MANIFEST
-README
-System.pm
-System.xs
-test.pl
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/Makefile.PL b/monitoring/PerlModules/NP/NOT-USED/Time-System/Makefile.PL
deleted file mode 100644
index d566247..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/Makefile.PL
+++ /dev/null
@@ -1,17 +0,0 @@
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- 'NAME' => 'Time::System',
- 'VERSION_FROM' => 'System.pm', # finds $VERSION
- 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'System.pm', # retrieve abstract from module
- AUTHOR => 'A. U. Thor <a.u.thor(a)a.galaxy.far.far.away>') : ()),
- 'LIBS' => [''], # e.g., '-lm'
- 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
- # Insert -I. if you add *.h files later:
- 'INC' => '', # e.g., '-I/usr/include/other'
- # Un-comment this if you add C files to link with later:
- # 'OBJECT' => '$(O_FILES)', # link all the C files too
-);
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/README b/monitoring/PerlModules/NP/NOT-USED/Time-System/README
deleted file mode 100644
index f4555bf..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/README
+++ /dev/null
@@ -1,35 +0,0 @@
-Time/System version 0.01
-========================
-
-The README is used to introduce the module and provide instructions on
-how to install the module, any machine dependencies it may have (for
-example C compilers and installed libraries) and any other information
-that should be provided before the module is installed.
-
-A README file is required for CPAN modules since CPAN extracts the
-README file from a module distribution so that people browsing the
-archive can use it get an idea of the modules uses. It is usually a
-good idea to provide version information here so that people can
-decide whether fixes for the module are worth downloading.
-
-INSTALLATION
-
-To install this module type the following:
-
- perl Makefile.PL
- make
- make test
- make install
-
-DEPENDENCIES
-
-This module requires these other modules and libraries:
-
- blah blah blah
-
-COPYRIGHT AND LICENCE
-
-Put the correct copyright and licence information here.
-
-Copyright (C) 2003 A. U. Thor blah blah blah
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/System.pm b/monitoring/PerlModules/NP/NOT-USED/Time-System/System.pm
deleted file mode 100644
index d0e4611..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/System.pm
+++ /dev/null
@@ -1,112 +0,0 @@
-package Time::System;
-
-use 5.00503;
-use strict;
-
-require Exporter;
-require DynaLoader;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-@ISA = qw(Exporter DynaLoader);
-
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-
-# This allows declaration use Time::System ':all';
-# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
-# will save memory.
-%EXPORT_TAGS = ( 'all' => [ qw(
-
-) ] );
-
-@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
-
-@EXPORT = qw(
- gettimeofday
- settimeofday
-);
-$VERSION = '0.01';
-
-bootstrap Time::System $VERSION;
-
-
-##################
-sub gettimeofday {
-##################
- my($sec, $usec) = _gettimeofday();
-
- return wantarray ? ($sec, $usec) : join('.', $sec, $usec);
-}
-
-
-##################
-sub settimeofday {
-##################
- my($sec, $usec) = @_;
-
- ($sec, $usec) = split(/\./, $sec, 2) unless ($usec);
-
- unless ($sec =~ /^\d+$/ and $usec =~ /^\d*$/) {
- $@ = "All args to settimeofday() must be numeric\n";
- return undef;
- }
-
- my($rv) = _settimeofday($sec, $usec);
-
- if ($rv == 0) {
- # Success
- return wantarray ? gettimeofday() : scalar(gettimeofday());
- } else {
- return undef;
- }
-
-}
-
-1;
-__END__
-=head1 NAME
-
-Time::System - Perl extension for getting and setting the system time
-
-=head1 SYNOPSIS
-
- use Time::System;
-
- my($sec, $usec) = gettimeofday();
- my $time_with_usec = gettimeofday();
-
- settimeofday($sec, $usec) or die "Couldn't set time: $@";
- settimeofday($time_with_usec) or die "Couldn't set time: $@";
-
-
-=head1 DESCRIPTION
-
-Time::System provides access to the gettimeofday() and settimeofday()
-system calls. In scalar context, B<gettimeofday()> returns seconds
-and microseconds as a single floating-point number; in array context,
-it returns them separately.
-
-Similarly, B<settimeofday()> may be called with a single
-floating-point number, or with seconds and microseconds passed as
-separate arguments. B<settimeofday()> returns a true value on
-success, and a false value with $@ set on error.
-
-=head1 EXPORTS
-
-gettimeofday
-settimeofday
-
-
-=head1 AUTHOR
-
-Dave Faraldo<lt>dfaraldo(a)redhat.com<gt>
-
-=head1 DATE
-
-Last modified: $Date: 2003-09-05 21:51:43 $
-
-=head1 SEE ALSO
-
-L<gettimeofday(2)>, L<settimeofday(2)>
-
-=cut
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/System.xs b/monitoring/PerlModules/NP/NOT-USED/Time-System/System.xs
deleted file mode 100644
index 31899cb..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/System.xs
+++ /dev/null
@@ -1,35 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#include <sys/time.h>
-#include <unistd.h>
-
-
-MODULE = Time::System PACKAGE = Time::System
-
-void
-_gettimeofday()
- PREINIT:
- struct timeval tv;
- PPCODE:
- gettimeofday(&tv, (struct timezone *)0);
- EXTEND(SP, 2);
- PUSHs(sv_2mortal(newSViv(tv.tv_sec)));
- PUSHs(sv_2mortal(newSViv(tv.tv_usec)));
-
-int
-_settimeofday(sec, usec)
- long sec
- long usec
- PREINIT:
- struct timeval tv;
- int rv;
- PPCODE:
- tv.tv_sec = sec;
- tv.tv_usec = usec;
- rv = settimeofday(&tv, (struct timezone *)0);
- EXTEND(SP, 1);
- PUSHs(sv_2mortal(newSViv(rv)));
-
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/test.pl b/monitoring/PerlModules/NP/NOT-USED/Time-System/test.pl
deleted file mode 100644
index acb3bf3..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/test.pl
+++ /dev/null
@@ -1,29 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..1\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Time::System;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
-
-my $time = time();
-my @stuff = Time::System::gettimeofday();
-if (scalar(@stuff) == 2) {print "ok 2\n"} else {print "not ok 2\n"}
-if ($time - $stuff[0] < 5) {print "ok 3\n"} else {print "not ok 3\n"}
-
-$time = time();
-my $stuff = Time::System::gettimeofday();
-
-if ($time - $stuff < 5) {print "ok 4\n"} else {print "not ok 4\n"}
diff --git a/monitoring/PerlModules/NP/NOT-USED/Time-System/version b/monitoring/PerlModules/NP/NOT-USED/Time-System/version
deleted file mode 100644
index 6221084..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/Time-System/version
+++ /dev/null
@@ -1 +0,0 @@
-1.6.0 7.rhel4
diff --git a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/BUILD b/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/BUILD
deleted file mode 100644
index 4c6cc56..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/BUILD
+++ /dev/null
@@ -1,48 +0,0 @@
-# Macros
-
-%define cvs_package PerlModules/NP/TroubleTicket
-
-# Package specific stuff
-Name: NOCpulse-TroubleTicket
-Version: 1.18.0
-Release: 1
-Packager: Karen Jacqmin-Adams <kja(a)redhat.com>
-Summary: Perl debug output package
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Requires: perl
-Provides: NOCpulse::TroubleTicket
-Group: unsorted
-Copyright: (c) 2002-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Prefix: %{_our_prefix}
-Buildroot: %{_tmppath}/%cvs_package
-
-
-%description
-
-API for opening a Command Center trouble ticket when a problem is detected.
-
-
-%prep
-%entirely_abstract_build_step
-
-
-%build
-%makefile_build
-
-
-%install
-rm -rf $RPM_BUILD_ROOT
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-%makefile_install
-%point_scripts_to_correct_perl
-%make_file_list
-
-%files -f %{name}-%{version}-%{release}-filelist
-%defattr(-,root,root,-)
-
-
-%clean
-%abstract_clean_script
diff --git a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/MANIFEST b/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/MANIFEST
deleted file mode 100644
index fbb7e09..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/MANIFEST
+++ /dev/null
@@ -1,5 +0,0 @@
-Makefile.PL
-MANIFEST
-README
-test.pl
-TroubleTicket.pm
diff --git a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/Makefile.PL b/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/Makefile.PL
deleted file mode 100644
index cd6d6c7..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/Makefile.PL
+++ /dev/null
@@ -1,11 +0,0 @@
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- 'NAME' => 'NOCpulse::TroubleTicket',
- 'VERSION_FROM' => 'TroubleTicket.pm', # finds $VERSION
- 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'TroubleTicket.pm', # retrieve abstract from module
- AUTHOR => 'Dave Faraldo <dfaraldo(a)redhat.com>') : ()),
-);
diff --git a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/README b/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/README
deleted file mode 100644
index d3800b2..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/README
+++ /dev/null
@@ -1,17 +0,0 @@
-NOCpulse/TroubleTicket
-======================
-
-API for opening a Command Center trouble ticket when a problem is detected.
-
-INSTALLATION
-
-To install this module type the following:
-
- perl Makefile.PL
- make
- make test
- make install
-
-COPYRIGHT AND LICENCE
-
-Copyright (c) 2000-2003 Red Hat, Inc. All rights reserved.
diff --git a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/TroubleTicket.pm b/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/TroubleTicket.pm
deleted file mode 100644
index b44dd1f..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/TroubleTicket.pm
+++ /dev/null
@@ -1,703 +0,0 @@
-
-######################################
-package NOCpulse::TroubleTicket;
-######################################
-
-use vars qw($VERSION);
-$VERSION = (split(/\s+/, q$Id: TroubleTicket.pm,v 1.19 2003-07-18 02:28:18 cvs Exp $, 4))[2];
-use strict;
-
-use DBI;
-use DBD::Oracle;
-use NOCpulse::Config;
-use NOCpulse::Debug;
-use LWP::UserAgent;
-use HTML::Parser;
-use URI;
-use URI::Escape;
-use Sys::Hostname;
-
-use Exporter;
-use vars qw (@ISA @EXPORT);
-@ISA=qw(Exporter); #add exporter to your @ISA
-@EXPORT=qw(LogTroubleTicket);
-
-
-###################
-#Global variables
-my $cfg = new NOCpulse::Config;
-
-my $USERNAME = $cfg->get('innovate', 'user');
-my $PASSWORD = $cfg->get('innovate', 'password');
-my $SUMMARYLEN = $cfg->get('innovate', 'summarylength');
-my $LOGINDIR = $cfg->get('innovate', 'logindir');
-
-my $URL = $cfg->get('innovate', 'url');
-my $BASE = $cfg->get('innovate', 'base_path');
-my $BASEURL = new URI("$URL$BASE");
-
-my $DBD = $cfg->get('cf_db', 'dbd');
-my $DBNAME = $cfg->get('cf_db', 'name');
-my $DBUNAME = $cfg->get('cf_db', 'notification_username');
-my $DBPASS = $cfg->get('cf_db', 'notification_password');
-
-#Fixed fields
-my $CATEGORY = "Other requests";
-my $PRIORITY = "Problem Report";
-
-#And in case Innovate tanks ...
-my $SENDMAIL = "/usr/lib/sendmail -t";
-my $LASTRESORT = $cfg->get('innovate', 'lastresort');
-my $MAINTAINER = $cfg->get('telalert', 'maintainer');
-
-my $BADCHARS = '^-_a-zA-Z0-9';
-
-my $HOSTNAME = hostname;
-my $MAXSUMMARY = 255;
-my $MAXPROBLEM = 3950; #leave some room for innovate to put its timestamp -- 4000 is the real limit
-
-my $UPDATE_TICKET_STATUS = 'Pending'; #Prevents innovate from pacing the NOC on updates
-
-#my $TA = new NOCpulse::TelAlert;
-my $TA;
-
-#HTML Parser stuff
-my @args = qw(tokens tokenpos token0 tagname attr attrseq text dtext is_cdata offset length event);
-my $argspec = join(",", @args);
-my @events = qw(text start end declaration comment process default);
-
-
-########################
- sub LogTroubleTicket {
-########################
- my ($cust,$summary,$details,$update,$update_details,$debug) = @_;
-
- my $tt = new NOCpulse::TroubleTicket;
- $tt->summary($summary);
- $tt->details($details);
- $tt->customer_id($cust);
- $tt->update($update);
- $tt->update_details($update_details);
- $tt->SetDebug($debug);
- my $id = $tt->submit;
- return $id
-}
-
-#########
-sub new {
-#########
- my $class = shift;
- my $self = {};
-
- my $debug = new NOCpulse::Debug;
- my $stream = $debug->addstream(FILE => \*STDERR,
- CONTEXT => 'literal',
- LEVEL => 0);
- $self->{'debug'} = $stream;
-
- bless $self, $class;
-}
-
-
-##############
-sub SetDebug {
-##############
- my $self = shift;
-
- $self->{'debug'}->level(shift);
-
-}
-
-
-############
-sub dprint {
-############
- my $self = shift;
-
- $self->{'debug'}->dprint(@_);
-
-}
-
-
-############
-sub submit {
-############
- my $self = shift;
-
-#First, log in
- $self->dprint(1, "Logging into ticketing system ...\n");
- if ($self->log_in()) {
- $self->dprint(1, "\tLogin to ticketing system successful (session ID is ",
- $self->session_key, ")\n");
- } else {
- $self->dprint(1, "\tLogin FAILED: $@\n");
- $self->lastditchsend($@);
- return undef;
- }
-
-#Then, create or update the ticket
- my ($ticketid, $last_ticket_id);
-
-# if ($self->update()) {
-# $last_ticket_id = $self->setCaseNumber;
-# $ticketid = $self->update_ticket;
-# }
- if (!$ticketid) {
- $ticketid = $self->submit_ticket($last_ticket_id)
- }
-
- if ($ticketid) {
- $self->dprint(1, "\tTicket Submission successful: $ticketid\n");
- } else {
- $self->dprint(1, "\tTicket Submission FAILED: $@\n");
- $self->lastditchsend($@);
- return undef;
- }
-
- return $ticketid;
-}
-
-
-############
-sub log_in {
-############
- my $self = shift;
-
- $self->ua(NOCpulse::TroubleTicket::UserAgent->new());
-
- my $ua = $self->ua;
- my $logindir = uri_escape($LOGINDIR, $BADCHARS);
-
-#Login request
- my $req = new HTTP::Request(POST => $BASEURL);
- $req->content_type('application/x-www-form-urlencoded');
- $req->content("AIMACTION=vmain&" .
- "Login=Login&" .
- "login.VALUE=${USERNAME}&" .
- "password.VALUE=${PASSWORD}&" .
- "logindir=$logindir&" .
- "row2form_rec.VALUE=findmyrec_sub_login&" .
- "sql_control=sql_lookup_a_user&" .
- "skey=NOKEY");
-
- $self->dprint(2, "\tLogin URL: ", $req->url(), "\n");
- $self->dprint(2, "\tLogin content: ", $req->content(), "\n");
-
- my $res = $ua->request($req);
-
- if ($res->is_success()) {
-#Create closure with $self to pass to HTML::Parser
- my $extractor = sub {
- my %p;
- @p{@args} = @_;
- if ( $p{'tagname'} eq 'a' &&
- $p{'attr'}->{'href'} =~ /AIMACTION=Submit/) {
- my $uri = new URI($p{'attr'}->{'href'});
- my $query = $uri->query();
- my %args = split(/[&=]/, $query);
- if (defined($args{'skey'})) {
- $self->session_key($args{'skey'});
- }
- }
- };
-
-#Extract session key
- my $parser = HTML::Parser->new( api_version => 3,
- start_h => [$extractor, $argspec],
- );
-
- $parser->unbroken_text(1);
-
- $parser->parse($res->content());
-
- } else {
-
- $@ = "Login fails: " . $res->status_line();
- return undef;
-
- }
-
- if ($self->session_key()) {
-
- return $self->session_key();
-
- } else {
-
- $@ = "Login failed: no session key";
- return undef;
-
- }
-
-
-}
-
-
-###################
-sub submit_ticket {
-###################
- my ($self, $last_ticket_id) = @_;
-
- #Last ticket id is for the case when a ticket is full and we need to open an additional
- #ticket to track additional information. This is caused by an Innovate limitation.
-
- my $skey = $self->session_key();
- my $username = uri_escape($USERNAME, $BADCHARS);
- my $category = uri_escape($CATEGORY, $BADCHARS);
- my $priority = uri_escape($PRIORITY, $BADCHARS);
-
- my $summary = uri_escape($self->summary(), $BADCHARS);
- if (length($summary) > $MAXSUMMARY) {
- $summary=substr($summary,0,$MAXSUMMARY);
- }
- my $customer_id = $self->customer_id();
- $customer_id = 1 unless $customer_id;
-
- my $details = $self->details();
- if ($last_ticket_id) {
- $details .= "\n\n(See also ticket # $last_ticket_id)";
- }
- my ($script, $line) = &calling_script();
- $details .= "\n\nREPORTED BY: $HOSTNAME: $script @ line $line";
- $details = uri_escape($details, $BADCHARS);
- if (length($details) > $MAXPROBLEM) {
- $summary=substr($details,0,$MAXPROBLEM);
- }
-
-#Get date
- my($mday, $mon, $year) = (localtime())[3, 4, 5];
- $mon++; $mon = 1 if ($mon == 13);
- $year += 1900;
- my $date = sprintf("%02d/%02d/%s", $mon, $mday, $year);
-
-#Build request
- my $pcontent = "assigned_to.VALUE=nobody&" .
- "date_mod.VALUE=${date}&" .
- "date_open.VALUE=${date}&" .
- "infotype.VALUE=Ticket&" .
- "ip_remote_user=${username}&" .
- "submitted_by.VALUE=${username}&" .
- "category.VALUE=${category}&" .
- "priority_type.VALUE=${priority}&" .
- "short_desc.VALUE=${summary}&" .
- "problem.VALUE=${details}&" .
- "customer_id.VALUE=${customer_id}&" .
- "AIMACTION=Submit+Ticket&" .
- "status=Open&" .
- "skey=${skey}";
-
-
- my $req = new HTTP::Request(POST => $BASEURL);
- $req->content($pcontent);
- $req->content_type('application/x-www-form-urlencoded');
- $req->header("referer" => "${BASEURL}?" .
- "AIMACTION=Submit&" .
- "skey=${skey}&" .
- "ip_remote_user=${username}&" .
- "row2form_rec.VALUE=findmyrec_sub_login&" .
- "sql_control=sql_lookup_a_user");
-
- $self->dprint(2, "\tSubmission URL: $BASEURL\n");
- $self->dprint(2, "\tSubmission content: ", $req->content(), "\n");
-
-
-#Submit ticket
- my $ua = $self->ua();
- my $res = $ua->request($req);
-
-
- my $content;
-#Make sure the ticket submission was successful
- if ($res->is_success()) {
- $content = $res->content();
- my $extractor = sub {
- my %p;
- @p{@args} = @_;
- if ( $p{'text'} =~ /^HD\d+/) {
- $self->ticket_id($p{'text'});
- }
- };
-
-#Parse content to extract ticket ID
- my $parser = HTML::Parser->new( api_version => 3,
- text_h => [$extractor, $argspec],
- );
- $parser->unbroken_text(1);
-
- $parser->parse($content);
-
-
- } else {
-
- $@ = "Submit transaction failed: " . $res->status_line();
- return undef;
-
- }
-
- if ($self->ticket_id()) {
- return $self->ticket_id();
- } else {
- $self->dprint(3,$content);
- $@ = "Submit fails: couldn't find a ticket ID";
- return undef;
- }
-
-
-}
-
-#################
-sub dprint_hash {
-#################
-
- my $self = shift;
- my $level = shift;
- my %p=@_;
-
- foreach(keys(%p)) {
- my $temp=$p{$_};
- my $thingy=ref($temp);
- if ($thingy) {
- if ($thingy =~ /HASH/) {
- my %t=%$temp;
- $self->dprint($level,"\t$_ is a $thingy [");
- foreach(keys(%t)) {
- my $it=$t{$_};
- $self->dprint($level, "\n\t\t$_=>$it");
- }
- $self->dprint($level, "]\n");
- } else {
- my @t=@$temp;
- $self->dprint($level, "\t$_ is a $thingy (@t)\n");
- }
- } else {
- $self->dprint($level, "\t$_ = $temp\n");
- }
- }
- $self->dprint(3, "\t\teoh\n\n");
-
-}
-
-
-###################
-sub load_ticket {
-###################
- my $self = shift;
-
- $self->dprint(2, "Loading ticket.....\n");
-
- $self->dprint(2, "Logging in ...\n");
- $self->log_in();
-
- my $skey = $self->session_key();
- my $case_num = $self->case_num();
- my $username = uri_escape($USERNAME, $BADCHARS);
-
-#Build request
- my $pcontent = "AIMACTION=row2form&" .
- "skey=${skey}".
- "ip_remote_user=${username}&" .
- "row2form_rec.VALUE=case_num^\$==${case_num}^\$";
-
- my $req = new HTTP::Request(POST => $BASEURL);
-
- $req->content($pcontent);
- $req->content_type('application/x-www-form-urlencoded');
- $req->header("referer" => "${BASEURL}?" .
- "AIMACTION=Submit&" .
- "skey=${skey}&" .
- "ip_remote_user=${username}&" .
- "row2form_rec.VALUE=findmyrec_sub_login&" .
- "sql_control=sql_lookup_a_user");
-
- $self->dprint(2, "\tSubmission URL: $BASEURL\n");
- $self->dprint(2, "\tSubmission Content: $pcontent\n");
-
-#Submit form
- my $ua = $self->ua();
- $self->dprint(2,"Submitting request\n");
- my $res = $ua->request($req);
-
- my $content;
- if ($res->is_success()) {
- $self->dprint(2, "\tSUCCESS!\n");
- $content = $res->content();
- ##$self->dprint(3, "$content\n");
- } else {
- $@ = "Submit transaction failed: " . $res->status_line();
- $self->dprint(2,$@);
- return undef;
- }
-
- my %newHash;
- my $last_select=undef;
- my $current_state=0;
-
- my $start_extractor = sub {
- my($token0, $attr)=@_;
-
- if ($token0 eq 'input') {
- my $name=$attr->{'name'};
- my $value=$attr->{'value'};
- $newHash{$name}=$value;
- ##$self->dprint(3,"Saving attr $name as $value for future use\n");
- }
- elsif ($token0 eq 'select') {
- $last_select=$attr->{'name'};
- ##$self->dprint(3,"Setting current state to 1\n");
- $current_state=1;
- }
- elsif (($current_state == 1) && ($token0=~/option/i)) {
- ##$self->dprint(3,"Setting current state to 2\n");
- $current_state=2;
- }
- } ;
-
- my $text_extractor = sub {
- if ($current_state == 2) {
- my $value=shift;
- $value=~s/\n//g;
- ##$self->dprint(3,"Grabbing value $last_select from option as $value\n");
- $newHash{$last_select}=$value if$last_select;
- $current_state=0;
- $last_select=undef;
- }
- } ;
-
- my $default_extractor = sub {
- ##$self->dprint(3,"Default extractor called\n");
- my %p;
- @p{@args} = @_;
- $self->dprint_hash(3,%p);
- } ;
-
- #Parse content to extract ticket info
-
- my $parser = HTML::Parser->new ( api_version => 3,
- start_h => [$start_extractor, 'token0, attr'],
- text_h => [$text_extractor, 'dtext'],
- );
- $parser->unbroken_text(1);
-
- $parser->parse($content);
-
- $self->dprint(3,"We built this hash....\n");
- $self->dprint_hash(3,%newHash);
-
- return %newHash
-}
-
-##################
-sub update_ticket {
-##################
- my $self=shift;
-
- $self->dprint(2, "update_ticket.....\n");
-
- my %ticketValues=$self->load_ticket();
- return undef unless %ticketValues;
-
-#Build request
-
- my $descr = $self->update_details;
- $descr = $self->details unless $descr;
- my ($script, $line) = &calling_script();
- $descr .= " ($HOSTNAME: $script @ line $line)";
-
- if ($TA->updateTicketProblemWithCaseNum($self->case_num,$descr))
- {
- $@ = "Update ticket failed";
- $self->dprint(2,"$@\n");
- return undef;
- }
- $self->dprint(2,"Update ticket successful\n");
- $self->dprint(2,"$@\n");
- return $self->case_num;
-}
-
-###################
-sub setCaseNumber {
-###################
- # We'll cheat for this one and go directly against the Oracle database instead of through
- # the Innovate web interface. It'll save us a bunch of time.
-
- # Find an already created ticket that matches this descriptio
-
- my $self=shift;
- my $ticketId;
-
- # Open a connection to the DB
- my $PrintError = 0;
- my $RaiseError = 0;
- my $AutoCommit = 0;
-
- my $dbh = DBI->connect("DBI:$DBD:$DBNAME", $DBUNAME, $DBPASS, { RaiseError => $RaiseError, AutoCommit => $AutoCommit });
-
- if (!$dbh) {
- $@ = $DBI::errstr ; return undef }
-
- # Prepare the statement handle
- my $sql_statement = sprintf<<EOSQL;
- SELECT MAX(case_num)
- FROM hd_problem
- WHERE short_desc = ?
- AND trunc(date_mod) + 1 >= trunc(sysdate)
-EOSQL
-
- my $statement_handle = $dbh->prepare($sql_statement);
- if (!$statement_handle) {$@ = $DBI::errstr . ': ' . $sql_statement; return undef }
-
- # Execute the query
- my $rc = $statement_handle->execute($self->summary);
- if (!$rc) {$@ = $DBI::errstr . ': ' . $sql_statement; return undef }
-
- # Fetch the data, if any
- my $dataref;
- if ($statement_handle->{NUM_OF_FIELDS}) {
- $dataref = $statement_handle->fetchall_arrayref;
- if ($statement_handle->err) {$@ = $DBI::errstr . ': ' . $sql_statement; return undef }
- }
-
- # Return the case number
- if (scalar(@$dataref)) {
- $ticketId = $dataref->[0]->[0];
- }
-
- # Close the statement handle
- $statement_handle->finish;
- if ($DBI::err) {$@ = $DBI::errstr . ': ' . $sql_statement }
-
- $dbh->disconnect;
-
- $self->case_num($ticketId);
-
- return $ticketId;
-}
-
-###################
-sub lastditchsend {
-###################
- my $self = shift;
- my $err = shift;
- my $summary = $self->summary();
- my $details = $self->details();
- my $customer_id = $self->customer_id();
- my $update_details = $self->update_details();
-
- # Ticket creation failed. Compose a mail message to
- # $LASTRESORT and defer to sendmail.
- my $msg = <<EOM;
-To: $LASTRESORT
-From: $MAINTAINER
-Subject: Ticket creation failed!
-
-*** $0 failed to create ticket:
-$err
-
-*** Ticket was:
-Customer Id: $customer_id
-Short Description: $summary
-Update Details: $update_details
-Problem Description:
-$details
-
-*** As reported by $HOSTNAME
-
-EOM
-
- open(MAIL, "|$SENDMAIL $LASTRESORT");
- print MAIL $msg;
- close(MAIL);
-
-}
-
-######################
-sub calling_script {
-######################
-
- # This subroutine prints the outer most script
- # that called this routine from the call stack.
-
- my @layer;
-
- # Walk up the call stack to see how deep it is, ...
- my $i = 1; # (Skips bottom, i.e. this sub)
- while (1) {
- my (@stuff) = caller($i);
- last unless (@stuff);
- @layer=@stuff;
- $i++;
- }
-
- # ... then return it.
-
- my ($filename, $line) = @layer[1,2];
-
- return ($filename, $line);
-
-}
-
-#####################################################
-#Accessor functions (stolen from LWP::MemberMixin)
-#########################################################
-sub summary { shift->_elem('summary', @_);}
-sub details { shift->_elem('details', @_);}
-sub ua { shift->_elem('ua', @_);}
-sub session_key { shift->_elem('session_key', @_);}
-sub ticket_id { shift->_elem('ticket_id', @_);}
-#########################################################
-sub case_num { shift->_elem('case_num', @_);}
-sub customer_id { shift->_elem('customer_id', @_);}
-sub update { shift->_elem('update', @_);}
-sub update_details { shift->_elem('update_details', @_);}
-#########################################################
-
-
-###########
-sub _elem {
-###########
-#Taken from the LWP::MemberMixin module
- my($self, $elem, $val) = @_;
- my $old = $self->{$elem};
- $self->{$elem} = $val if defined $val;
- return $old;
-}
-
-
-##############################################################################
-#PACKAGE NOCpulse::TroubleTicket::UserAgent #
-##############################################################################
-
-package NOCpulse::TroubleTicket::UserAgent;
-
-use strict;
-use vars qw (@ISA);
-use LWP::UserAgent;
-
-@ISA=qw(LWP::UserAgent);
-
-
-#########
-sub new {
-#########
- my $class = shift;
- my $self = $class->SUPER::new(@_);
-
- bless $self, $class;
-}
-
-
-#Overloaded function to allow [POST -> GET] HTTP redirects
-#################
-sub redirect_ok {
-#################
- my ($ua, $req) = @_;
-
- $req->method('GET');
- return 1;
-
-}
-
-
-1;
-
-
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test.pl b/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test.pl
deleted file mode 100644
index 2655c2e..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test.pl
+++ /dev/null
@@ -1,17 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use Test;
-BEGIN { plan tests => 1 };
-use NOCpulse::TroubleTicket;
-ok(1); # If we made it this far, we're ok.
-
-#########################
-
-# Insert your test code below, the Test module is use()ed here so read
-# its man page ( perldoc Test ) for help writing this test script.
-
diff --git a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test/test-TroubleTicket.pl b/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test/test-TroubleTicket.pl
deleted file mode 100755
index 8e4129e..0000000
--- a/monitoring/PerlModules/NP/NOT-USED/TroubleTicket/test/test-TroubleTicket.pl
+++ /dev/null
@@ -1,14 +0,0 @@
-#!/usr/bin/perl
-
-use NOCpulse::TroubleTicket;
-
-my $tt = LogTroubleTicket(30,'short 2','long',0,'update',3);
-print "ticket id $tt\n";
-$tt = LogTroubleTicket(30,'short 2','long',1,'update',3);
-print "ticket id $tt\n";
-$tt = LogTroubleTicket(30,'short 2','long',1,'update');
-print "ticket id $tt\n";
-$tt = LogTroubleTicket(30,'short 2','long',1);
-print "ticket id $tt\n";
-$tt = LogTroubleTicket(30,'short 2','long');
-print "ticket id $tt\n";
11 years, 4 months
monitoring/scdb monitoring/tsdb
by Michael Mraka
monitoring/scdb/fetch_state_changes | 57 ------------------------------------
monitoring/tsdb/fetch_time_series | 57 ------------------------------------
2 files changed, 114 deletions(-)
New commits:
commit 3abdcc0a2b6e2e8f7cf2692d474a30616d594475
Author: Michael Mraka <michael.mraka(a)redhat.com>
Date: Tue Jan 31 15:21:15 2012 +0100
removing non-working debugging scripts
there's no NOCpulse::BDB for a long time
diff --git a/monitoring/scdb/fetch_state_changes b/monitoring/scdb/fetch_state_changes
deleted file mode 100755
index ac92ca6..0000000
--- a/monitoring/scdb/fetch_state_changes
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/usr/bin/perl
-
-# DEBUGGING TOOL -- see part or all of a TSDB data file
-
-use NOCpulse::BDB;
-use NOCpulse::SCDB;
-use Getopt::Long;
-
-$ENV{'BDBROOT'} = '/nocpulse/scdb/bdb';
-
-my($help, $start, $end);
-&GetOptions(
- 'start=i' => \$start,
- 'end=i' => \$end,
- 'help+' => \$help,
-);
-$start ||= 0;
-$end ||= time;
-
-die &usage if ($help);
-die "\nERROR: At least one OID must be specified\n" . &usage unless (@ARGV);
-
-my $bdb = NOCpulse::BDB->new();
-
-foreach my $oid (@ARGV) {
- print "OID $oid:\n";
- my $filename = NOCpulse::SCDB::oid2filename($oid);
-
- my $ts = $bdb->fetch($filename, $start, $end, 0);
-
- while (scalar @{$ts}) {
-
- my $t = shift @{$ts};
- my $v = shift @{$ts};
-
- printf "\t%s (%s) => %s\n", scalar(localtime($t)), $t, $v;
- }
-}
-
-
-##############################################################################
-############################### Subroutines ################################
-##############################################################################
-
-###########
-sub usage {
-###########
-
- return qq{
- Usage: $0 [<opts>] <OID> [<OID>...]
- Options:
- --start=<start> - start at <start> (seconds since epoch)
- --end=<end> - end at <end> (seconds since epoch)
- --help - show this message
- \n};
-
-}
diff --git a/monitoring/tsdb/fetch_time_series b/monitoring/tsdb/fetch_time_series
deleted file mode 100755
index 1d5e0a3..0000000
--- a/monitoring/tsdb/fetch_time_series
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/usr/bin/perl
-
-# DEBUGGING TOOL -- see part or all of a SDDB data file
-
-use NOCpulse::BDB;
-use NOCpulse::TSDB;
-use Getopt::Long;
-
-$ENV{'BDBROOT'} = '/nocpulse/tsdb/bdb';
-
-my($help, $start, $end);
-&GetOptions(
- 'start=i' => \$start,
- 'end=i' => \$end,
- 'help+' => \$help,
-);
-$start ||= 0;
-$end ||= time;
-
-die &usage if ($help);
-die "\nERROR: At least one OID must be specified\n" . &usage unless (@ARGV);
-
-my $bdb = NOCpulse::BDB->new();
-
-foreach my $oid (@ARGV) {
- print "OID $oid:\n";
- my $filename = NOCpulse::TSDB::oid2filename($oid);
-
- my $ts = $bdb->fetch($filename, $start, $end, 0);
-
- while (scalar @{$ts}) {
-
- my $t = shift @{$ts};
- my $v = shift @{$ts};
-
- printf "\t%s (%s) => %s\n", scalar(localtime($t)), $t, $v;
- }
-}
-
-
-##############################################################################
-############################### Subroutines ################################
-##############################################################################
-
-###########
-sub usage {
-###########
-
- return qq{
- Usage: $0 [<opts>] <OID> [<OID>...]
- Options:
- --start=<start> - start at <start> (seconds since epoch)
- --end=<end> - end at <end> (seconds since epoch)
- --help - show this message
- \n};
-
-}
11 years, 4 months
monitoring/NOT-USED
by Jan Pazdziora
monitoring/NOT-USED/README | 6
monitoring/NOT-USED/scdb_accessor_perl/BUILD | 46 -
monitoring/NOT-USED/scdb_accessor_perl/BUILD.spec | 116 ---
monitoring/NOT-USED/scdb_accessor_perl/NOCpulse/SCDB/Accessor.pm | 350 ---------
monitoring/NOT-USED/scdb_accessor_perl/README | 112 --
monitoring/NOT-USED/scdb_accessor_perl/version | 1
monitoring/NOT-USED/tsdb_accessor_perl/BUILD | 47 -
monitoring/NOT-USED/tsdb_accessor_perl/BUILD.spec | 117 ---
monitoring/NOT-USED/tsdb_accessor_perl/NOCpulse/TSDB/Accessor.pm | 375 ----------
monitoring/NOT-USED/tsdb_accessor_perl/README | 111 --
monitoring/NOT-USED/tsdb_accessor_perl/version | 1
11 files changed, 1282 deletions(-)
New commits:
commit 61aafb8691e2165d2e29e72a978d7ea2e61529e0
Author: Jan Pazdziora <jpazdziora(a)redhat.com>
Date: Tue Jan 31 15:30:30 2012 +0100
Purging old NOT-USED stuff.
diff --git a/monitoring/NOT-USED/README b/monitoring/NOT-USED/README
deleted file mode 100644
index 492ef5f..0000000
--- a/monitoring/NOT-USED/README
+++ /dev/null
@@ -1,6 +0,0 @@
-These packages are not used now. But the code can be usefull one day.
-Since we are owner of this code and it can not be get from anywhere else
-pleas keep it here and do not delete it.
-
---
-msuchy
diff --git a/monitoring/NOT-USED/scdb_accessor_perl/BUILD b/monitoring/NOT-USED/scdb_accessor_perl/BUILD
deleted file mode 100644
index 751c38f..0000000
--- a/monitoring/NOT-USED/scdb_accessor_perl/BUILD
+++ /dev/null
@@ -1,46 +0,0 @@
-# Macros
-
-%define cvs_package scdb_accessor_perl
-
-
-# Package specific stuff
-Name: %cvs_package
-Version: 1.3.0
-Release: 1
-Packager: Karen Jacqmin-Adams <kja(a)redhat.com>
-Summary: NOCpulse SCDB perl client
-Source: %name-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Group: unsorted
-Copyright: (c) 2001-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Buildroot: %{_tmppath}/%cvs_package
-
-%description
-
-perl library for accessing the SCDB
-
-%prep
-%entirely_abstract_build_step
-
-
-%build
-echo "Nothing to build"
-
-%install
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-%find_perl_installsitelib
-perl_lib=$installsitelib/NOCpulse/SCDB
-
-mkdir -p $RPM_BUILD_ROOT$perl_lib
-cp NOCpulse/SCDB/Accessor.pm $RPM_BUILD_ROOT$perl_lib
-
-%point_scripts_to_correct_perl
-%make_file_list
-
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-%clean
-%abstract_clean_script
diff --git a/monitoring/NOT-USED/scdb_accessor_perl/BUILD.spec b/monitoring/NOT-USED/scdb_accessor_perl/BUILD.spec
deleted file mode 100644
index 7f6edf0..0000000
--- a/monitoring/NOT-USED/scdb_accessor_perl/BUILD.spec
+++ /dev/null
@@ -1,116 +0,0 @@
-
-# CVS hacks
-%define cvs_package_prefix old-nocpulse/
-
-# What Perl to use?
-%define perl_prefix /usr
-%define perl %perl_prefix/bin/perl
-%define perlpkg perl-rhnmon
-
-# Macro for cpan documentation
-%define doc_prefix %perl_prefix/share/doc/%name
-%define man_prefix %perl_prefix/man
-
-
-# Macro(s) slavishly copied from autoconf's config.status.
-%define _our_prefix /usr
-%define _our_exec_prefix %{_our_prefix}
-%define _our_bindir %{_our_exec_prefix}/bin
-%define _our_sbindir %{_our_exec_prefix}/sbin
-%define _our_libexecdir %{_our_exec_prefix}/libexec
-%define _our_datadir %{_our_prefix}/share
-%define _our_sysconfdir %{_our_prefix}/etc
-%define _our_sharedstatedir %{_our_prefix}/com
-%define _our_localstatedir %{_our_prefix}/var
-%define _our_lib lib
-%define _our_libdir %{_our_exec_prefix}/%{_lib}
-%define _our_includedir %{_our_prefix}/include
-%define _our_oldincludedir /usr/include
-%define _our_infodir %{_our_prefix}/info
-%define _our_mandir %{_our_prefix}/man
-
-
-# Prep for build. This is entirely abstract - you should not need to change it.
-%define entirely_abstract_build_step rm -rf $RPM_BUILD_ROOT; rm -rf $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION; cvs checkout $RPM_TAG_PARAM %cvs_package_prefix%cvs_package; [ -n %cvs_package_prefix ] && mkdir -p %cvs_package && rmdir %cvs_package && ln -s %cvs_package_prefix%cvs_package %cvs_package ; [ %cvs_package = $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION ] || mv %cvs_package $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION; find $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION -type d -name CVS | xargs rm -rf; tar -cvzf $RPM_SOURCE_DIR/$RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION.tar.gz $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-
-
-%define perl_makefile CFLAGS="$RPM_OPT_FLAGS" %perl Makefile.PL verbose PREFIX=$RPM_BUILD_ROOT%{prefix}; make OPTIMIZE="$RPM_OPT_FLAGS"
-
-
-
-%define makefile_build cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION; %perl_makefile
-
-
-# For CPAN modules with a copyright or license that is not GPL or Artistic
-%define cpan_doc_install mkdir -p $RPM_BUILD_ROOT%doc_prefix; [ -e README ] && cp README $RPM_BUILD_ROOT%doc_prefix; [ -e COPYING ] && cp COPYING $RPM_BUILD_ROOT%doc_prefix; [ -e COPYRIGHT ] && cp COPYRIGHT $RPM_BUILD_ROOT%doc_prefix
-
-
-%define our_makeinstall make prefix=%{?buildroot:%{buildroot}}%{_our_prefix} exec_prefix=%{?buildroot:%{buildroot}}%{_our_exec_prefix} bindir=%{?buildroot:%{buildroot}}%{_our_bindir} sbindir=%{?buildroot:%{buildroot}}%{_our_sbindir} sysconfdir=%{?buildroot:%{buildroot}}%{_our_sysconfdir} datadir=%{?buildroot:%{buildroot}}%{_our_datadir} includedir=%{?buildroot:%{buildroot}}%{_our_includedir} libdir=%{?buildroot:%{buildroot}}%{_our_libdir} libexecdir=%{?buildroot:%{buildroot}}%{_our_libexecdir} localstatedir=%{?buildroot:%{buildroot}}%{_our_localstatedir} sharedstatedir=%{?buildroot:%{buildroot}}%{_our_sharedstatedir} mandir=%{?buildroot:%{buildroot}}%{_our_mandir} infodir=%{?buildroot:%{buildroot}}%{_our_infodir} install
-
-
-
-%define makefile_install eval `%perl '-V:installarchlib'`; mkdir -p $RPM_BUILD_ROOT$installarchlib; %our_makeinstall; rm -f `find $RPM_BUILD_ROOT -type f -name perllocal.pod -o -name .packlist`; [ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress
-
-
-# For the really ugly cases, e.g. PerlModules/CPAN/libwww-perl-5.48
-%define alt_makefile_install mkdir -p $RPM_BUILD_ROOT/%{_our_prefix}/lib; make install PREFIX=$RPM_BUILD_ROOT; mv $RPM_BUILD_ROOT/lib $RPM_BUILD_ROOT%{_our_prefix}/lib/perl5
-
-
-
-%define find_perl_installsitelib eval `%perl '-V:installsitelib'`; echo installsitelib is $installsitelib; if [ "$installsitelibX" = "X" ] ; then echo "ERROR: installsitelib is undefined"; exit 1; fi
-
-
-
-%define point_scripts_to_correct_perl find $RPM_BUILD_ROOT -type f -print | xargs perl -pi -e 's,^#\\\!/usr/bin/perl,#\\\!%perl, if ($ARGV ne $lf); $lf = $ARGV;'
-
-
-%define make_file_list cd $RPM_BUILD_DIR; find $RPM_BUILD_ROOT -type f -print | sed "s@^$RPM_BUILD_ROOT@@g" > $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION/%{name}-%{version}-%{release}-filelist; if [ "$(cat $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION/%{name}-%{version}-%{release}-filelist)X" = "X" ] ; then echo "ERROR: EMPTY FILE LIST"; exit 1; fi
-
-
-%define abstract_clean_script rm -rf $RPM_BUILD_ROOT; cd $RPM_BUILD_DIR; rm -rf $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION; [ -n %cvs_package_prefix ] && [ -e %cvs_package_prefix ] && rm -rf %cvs_package_prefix; [ -e %cvs_package ] && rm -rf %cvs_package; [ -e %{name}-%{version}-%{release}-filelist ] && rm %{name}-%{version}-%{release}-filelist
-# Macros
-
-%define cvs_package scdb_accessor_perl
-
-
-# Package specific stuff
-Name: %cvs_package
-Source9999: version
-Version: %(echo `awk '{ print $1 }' %{SOURCE9999}`)
-Release: %(echo `awk '{ print $2 }' %{SOURCE9999}`)
-Summary: NOCpulse SCDB perl client
-Source: %name-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Group: unsorted
-License: GPLv2
-Vendor: Red Hat, Inc.
-Buildroot: %{_tmppath}/%cvs_package
-
-%description
-
-perl library for accessing the SCDB
-
-%prep
-%setup
-
-
-%build
-echo "Nothing to build"
-
-%install
-
-%find_perl_installsitelib
-perl_lib=$installsitelib/NOCpulse/SCDB
-
-mkdir -p $RPM_BUILD_ROOT$perl_lib
-cp NOCpulse/SCDB/Accessor.pm $RPM_BUILD_ROOT$perl_lib
-
-%point_scripts_to_correct_perl
-%make_file_list
-
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-%clean
-%abstract_clean_script
diff --git a/monitoring/NOT-USED/scdb_accessor_perl/NOCpulse/SCDB/Accessor.pm b/monitoring/NOT-USED/scdb_accessor_perl/NOCpulse/SCDB/Accessor.pm
deleted file mode 100644
index 559af6c..0000000
--- a/monitoring/NOT-USED/scdb_accessor_perl/NOCpulse/SCDB/Accessor.pm
+++ /dev/null
@@ -1,350 +0,0 @@
-
-package NOCpulse::SCDB::Accessor;
-
-use strict;
-use LWP::UserAgent;
-use URI::Escape;
-
-my $BADCHARS = '^-_a-zA-Z0-9';
-
-sub new
-{
- my $class = shift;
- my %args = @_;
-
- my $self = {};
- bless $self, $class;
-
- if( defined $args{'url'} )
- {
- $self->{url} = $args{'url'};
- }
- else
- {
- $self->{host} = $args{'host'} || 'scdb.nocpulse.com';
- $self->{port} = $args{'port'} || 7979;
- }
- $self->{verbose} = $args{'verbose'} || 0;
- $self->{ua} = LWP::UserAgent->new;
-
- return $self;
-}
-
-sub insert
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $v = $args{'desc'};
- $v =~ s/[^-_a-zA-Z0-9]/"%" . sprintf("%02X",ord($&))/ge;
-
- my $content = "fn=insert&oid=".$args{'oid'}. "&t=".$args{'t'}."&state=".$args{'state'}."&desc=".$v;
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-sub upload
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $data = $args{'data'};
-
- my $content = "fn=upload&data=".uri_escape($data, $BADCHARS);
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-
-sub batch_insert
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $text_data = "";
- my $datum;
- foreach $datum (@{$args{'data'}})
- {
- my $v = $datum->[2]." ".$datum->[3];
- #$v =~ s/[%\n\cM]/"%" . sprintf("%02X",ord($&))/ge;
- $text_data .= $datum->[0]." ".$datum->[1]." $v\n";
- }
-
- my $content = "fn=batch_insert&data=$text_data";
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-
-sub copy
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = uri_escape("fn=copy".
- "&from_oid=".$args{'from_oid'}.
- "&to_oid=".$args{'to_oid'}.
- "&start=".$args{'start'}.
- "&end=".$args{'end'}, $BADCHARS);
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-sub delete
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = "fn=delete".
- "&oid=".$args{'oid'}.
- "&t=".$args{'t'};
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-sub last
-{
- my $self = shift;
- my %args = @_;
-
- my $results = $args{'results'}; # a hash ref
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = "fn=last&oid=".$args{'oid'};
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
-
- # shouldn't be splitting !!
- # also, we should be unescaping !!
- my ($oid_again, $t, $state, @vals) = split /\s+/, $response->content;
-
- $results->{'time'} = $t;
- $results->{'state'} = $state;
- $results->{'description'} = join(" ", @vals);
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-
-}
-
-sub fetch
-{
- my $self = shift;
- my %args = @_;
-
- my $results = $args{'results'}; # a hash ref
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = "fn=fetch&oid=".$args{'oid'}."&start=".$args{'start'}."&end=".$args{'end'};
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
-
- if( $args{'raw'} == 1 )
- {
- ${$results} = $response->content();
- }
- else
- {
- $results->{times} = [];
- $results->{states} = [];
- $results->{descriptions} = [];
-
- my @lines = split "\n", $response->content();
- my $line;
- foreach $line (@lines)
- {
- next if ( $line =~ /^BEGIN/ );
- last if ( $line =~ /^END/ );
-
- my $i = index $line, " ";
- my $j = index $line, " ", ($i + 1);
-
- if( ( $i != -1 ) and ( $j != -1 ) )
- {
- my $t = substr $line, 0, $i;
- my $state = substr $line, ($i + 1), ($j - $i);
- my $desc = substr $line, ($j + 1);
-
- push @{$results->{times}}, $t;
- push @{$results->{states}}, $state;
- push @{$results->{descriptions}}, $desc;
-
- # we should be unescaping the description !!
-
- }
- }
- }
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-1;
-
diff --git a/monitoring/NOT-USED/scdb_accessor_perl/README b/monitoring/NOT-USED/scdb_accessor_perl/README
deleted file mode 100644
index 0ac201f..0000000
--- a/monitoring/NOT-USED/scdb_accessor_perl/README
+++ /dev/null
@@ -1,112 +0,0 @@
-Object Identifiers (<OID>s)
----------------------------
-
- A SCDB <OID> uniquely identifies a file in the database. There
- are two recognized <OID> formats:
-
- Regular probes: <probeid>
- URL/Transaction probes: <probeid>-<clusterid>
-
-
-
-Datatypes
----------
-
- +-----------------+--------------------------------------------------------+
- | TYPE | DESCRIPTION |
- +-----------------+--------------------------------------------------------+
- | <TIMESTAMP> | A date in Unix epoch format. |
- +-----------------+--------------------------------------------------------+
- | <STATE> | A valid probe state. |
- +-----------------+--------------------------------------------------------+
- | <DESCRIPTION> | A string describing the state of a probe. |
- +-----------------+--------------------------------------------------------+
- | <VALUE> | "<STATE> <DESCRIPTION>" |
- +-----------------+--------------------------------------------------------+
- | <PACKET> | A data packet of the form: |
- | | |
- | | BEGIN <OID> |
- | | <TIMESTAMP> <VALUE> |
- | | [<TIMESTAMP> <VALUE> ...] |
- | | END |
- +-----------------+--------------------------------------------------------+
- | <PACKETLIST> | A newline-separated list of <PACKET> data. |
- +-----------------+--------------------------------------------------------+
- | <DATAPOINT> | A string of the form: |
- | | |
- | | <OID> <TIMESTAMP> <VALUE> |
- +-----------------+--------------------------------------------------------+
- | <DATALIST> | A newline-separated list of <DATAPOINT> data. |
- +-----------------+--------------------------------------------------------+
- | <PARAMS> | URL-encoded parameters to a function. |
- +-----------------+--------------------------------------------------------+
- | <STATUS> | Return status of the form: |
- | | |
- | | <OID> <TIMESTAMP> ok - insert successful |
- | | <OID> <TIMESTAMP> retry - transient failure |
- | | <OID> <TIMESTAMP> fatal - permanent failure |
- +-----------------+--------------------------------------------------------+
- | <STATUSLIST> | A newline-separated list of <STATUS> data. |
- +-----------------+--------------------------------------------------------+
-
-
-
-SCDB API
---------
-
- URL: http://scdb.nocpulse.com:7979/db?fn=<FN>&<PARAMS>
-
- Available funcitons (<FN>) and their <PARAMS>:
-
- insert - insert a single datapoint for a single probe.
- oid=<OID>
- t=<TIMESTAMP>
- desc=<DESCRIPTION>
- state=<STATE>
-
- RETURNS: ok
-
- upload - insert multiple datapoints for one or more probes.
- data=<PACKET>[<PACKET>...]
-
- RETURNS: ok
-
- batch_insert - insert multiple datapoints for multiple probes.
- data=<DATAPOINT>\n[<DATAPOINT>\n...]
-
- RETURNS: <STATUSLIST>
-
- fetch - fetch SCDB datapoints for a single probe.
- start=<TIMESTAMP>
- end=<TIMESTAMP>
- oid=<OID>
-
- RETURNS: <PACKET>
-
- batch_fetch - fetch SCDB datapoints for one or more probes.
- start=<TIMESTAMP>
- end=<TIMESTAMP>
- oid=<OID>[&oid=<OID>...]
-
- RETURNS: <PACKETLIST>
-
- last - returns the last SCDB datapoint for a single probe.
- oid=<OID>
-
- RETURNS: <DATAPOINT>
-
- batch_last - returns the last SCDB datapoint for one or more probes.
- oid=<OID>[&oid=<OID>...]
-
- RETURNS: <DATAPOINTLIST>
-
- delete - delete a datafile.
- oid=<OID>
-
- RETURNS: <STATUS>
-
- size - returns the size of a data file.
- oid=<OID>
-
- RETURNS: <OID> <size>
-
diff --git a/monitoring/NOT-USED/scdb_accessor_perl/version b/monitoring/NOT-USED/scdb_accessor_perl/version
deleted file mode 100644
index e3ad5eb..0000000
--- a/monitoring/NOT-USED/scdb_accessor_perl/version
+++ /dev/null
@@ -1 +0,0 @@
-1.3.0 4
diff --git a/monitoring/NOT-USED/tsdb_accessor_perl/BUILD b/monitoring/NOT-USED/tsdb_accessor_perl/BUILD
deleted file mode 100644
index 10b3075..0000000
--- a/monitoring/NOT-USED/tsdb_accessor_perl/BUILD
+++ /dev/null
@@ -1,47 +0,0 @@
-# Macros
-%define cvs_package tsdb_accessor_perl
-
-# Package specific stuff
-Name: %cvs_package
-Version: 1.4.0
-Release: 1
-Packager: Karen Jacqmin-Adams <kja(a)redhat.com>
-Summary: Command Center TSDB perl client
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Group: unsorted
-Copyright: (c) 2001-2003 Red Hat, Inc. All rights reserved.
-Vendor: Red Hat, Inc.
-Buildroot: %{_tmppath}/%cvs_package
-
-%description
-
-perl library for accessing the TSDB
-
-
-%prep
-%entirely_abstract_build_step
-
-
-%build
-echo "Nothing to build"
-
-
-%install
-cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-%find_perl_installsitelib
-perl_lib=$installsitelib/NOCpulse/TSDB
-
-mkdir -p $RPM_BUILD_ROOT/$perl_lib
-cp NOCpulse/TSDB/Accessor.pm $RPM_BUILD_ROOT/$perl_lib
-
-%point_scripts_to_correct_perl
-%make_file_list
-
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-
-%clean
-%abstract_clean_script
diff --git a/monitoring/NOT-USED/tsdb_accessor_perl/BUILD.spec b/monitoring/NOT-USED/tsdb_accessor_perl/BUILD.spec
deleted file mode 100644
index f5ba6e4..0000000
--- a/monitoring/NOT-USED/tsdb_accessor_perl/BUILD.spec
+++ /dev/null
@@ -1,117 +0,0 @@
-
-# CVS hacks
-%define cvs_package_prefix old-nocpulse/
-
-# What Perl to use?
-%define perl_prefix /usr
-%define perl %perl_prefix/bin/perl
-%define perlpkg perl-rhnmon
-
-# Macro for cpan documentation
-%define doc_prefix %perl_prefix/share/doc/%name
-%define man_prefix %perl_prefix/man
-
-
-# Macro(s) slavishly copied from autoconf's config.status.
-%define _our_prefix /usr
-%define _our_exec_prefix %{_our_prefix}
-%define _our_bindir %{_our_exec_prefix}/bin
-%define _our_sbindir %{_our_exec_prefix}/sbin
-%define _our_libexecdir %{_our_exec_prefix}/libexec
-%define _our_datadir %{_our_prefix}/share
-%define _our_sysconfdir %{_our_prefix}/etc
-%define _our_sharedstatedir %{_our_prefix}/com
-%define _our_localstatedir %{_our_prefix}/var
-%define _our_lib lib
-%define _our_libdir %{_our_exec_prefix}/%{_lib}
-%define _our_includedir %{_our_prefix}/include
-%define _our_oldincludedir /usr/include
-%define _our_infodir %{_our_prefix}/info
-%define _our_mandir %{_our_prefix}/man
-
-
-# Prep for build. This is entirely abstract - you should not need to change it.
-%define entirely_abstract_build_step rm -rf $RPM_BUILD_ROOT; rm -rf $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION; cvs checkout $RPM_TAG_PARAM %cvs_package_prefix%cvs_package; [ -n %cvs_package_prefix ] && mkdir -p %cvs_package && rmdir %cvs_package && ln -s %cvs_package_prefix%cvs_package %cvs_package ; [ %cvs_package = $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION ] || mv %cvs_package $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION; find $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION -type d -name CVS | xargs rm -rf; tar -cvzf $RPM_SOURCE_DIR/$RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION.tar.gz $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION
-
-
-
-%define perl_makefile CFLAGS="$RPM_OPT_FLAGS" %perl Makefile.PL verbose PREFIX=$RPM_BUILD_ROOT%{prefix}; make OPTIMIZE="$RPM_OPT_FLAGS"
-
-
-
-%define makefile_build cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION; %perl_makefile
-
-
-# For CPAN modules with a copyright or license that is not GPL or Artistic
-%define cpan_doc_install mkdir -p $RPM_BUILD_ROOT%doc_prefix; [ -e README ] && cp README $RPM_BUILD_ROOT%doc_prefix; [ -e COPYING ] && cp COPYING $RPM_BUILD_ROOT%doc_prefix; [ -e COPYRIGHT ] && cp COPYRIGHT $RPM_BUILD_ROOT%doc_prefix
-
-
-%define our_makeinstall make prefix=%{?buildroot:%{buildroot}}%{_our_prefix} exec_prefix=%{?buildroot:%{buildroot}}%{_our_exec_prefix} bindir=%{?buildroot:%{buildroot}}%{_our_bindir} sbindir=%{?buildroot:%{buildroot}}%{_our_sbindir} sysconfdir=%{?buildroot:%{buildroot}}%{_our_sysconfdir} datadir=%{?buildroot:%{buildroot}}%{_our_datadir} includedir=%{?buildroot:%{buildroot}}%{_our_includedir} libdir=%{?buildroot:%{buildroot}}%{_our_libdir} libexecdir=%{?buildroot:%{buildroot}}%{_our_libexecdir} localstatedir=%{?buildroot:%{buildroot}}%{_our_localstatedir} sharedstatedir=%{?buildroot:%{buildroot}}%{_our_sharedstatedir} mandir=%{?buildroot:%{buildroot}}%{_our_mandir} infodir=%{?buildroot:%{buildroot}}%{_our_infodir} install
-
-
-
-%define makefile_install eval `%perl '-V:installarchlib'`; mkdir -p $RPM_BUILD_ROOT$installarchlib; %our_makeinstall; rm -f `find $RPM_BUILD_ROOT -type f -name perllocal.pod -o -name .packlist`; [ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress
-
-
-# For the really ugly cases, e.g. PerlModules/CPAN/libwww-perl-5.48
-%define alt_makefile_install mkdir -p $RPM_BUILD_ROOT/%{_our_prefix}/lib; make install PREFIX=$RPM_BUILD_ROOT; mv $RPM_BUILD_ROOT/lib $RPM_BUILD_ROOT%{_our_prefix}/lib/perl5
-
-
-
-%define find_perl_installsitelib eval `%perl '-V:installsitelib'`; echo installsitelib is $installsitelib; if [ "$installsitelibX" = "X" ] ; then echo "ERROR: installsitelib is undefined"; exit 1; fi
-
-
-
-%define point_scripts_to_correct_perl find $RPM_BUILD_ROOT -type f -print | xargs perl -pi -e 's,^#\\\!/usr/bin/perl,#\\\!%perl, if ($ARGV ne $lf); $lf = $ARGV;'
-
-
-%define make_file_list cd $RPM_BUILD_DIR; find $RPM_BUILD_ROOT -type f -print | sed "s@^$RPM_BUILD_ROOT@@g" > $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION/%{name}-%{version}-%{release}-filelist; if [ "$(cat $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION/%{name}-%{version}-%{release}-filelist)X" = "X" ] ; then echo "ERROR: EMPTY FILE LIST"; exit 1; fi
-
-
-%define abstract_clean_script rm -rf $RPM_BUILD_ROOT; cd $RPM_BUILD_DIR; rm -rf $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION; [ -n %cvs_package_prefix ] && [ -e %cvs_package_prefix ] && rm -rf %cvs_package_prefix; [ -e %cvs_package ] && rm -rf %cvs_package; [ -e %{name}-%{version}-%{release}-filelist ] && rm %{name}-%{version}-%{release}-filelist
-# Macros
-%define cvs_package tsdb_accessor_perl
-
-# Package specific stuff
-Name: %cvs_package
-Source9999: version
-Version: %(echo `awk '{ print $1 }' %{SOURCE9999}`)
-Release: %(echo `awk '{ print $2 }' %{SOURCE9999}`)
-Summary: Command Center TSDB perl client
-Source: %{name}-%PACKAGE_VERSION.tar.gz
-BuildArch: noarch
-Group: unsorted
-License: GPLv2
-Vendor: Red Hat, Inc.
-Buildroot: %{_tmppath}/%cvs_package
-
-%description
-
-perl library for accessing the TSDB
-
-
-%prep
-%setup
-
-
-%build
-echo "Nothing to build"
-
-
-%install
-
-%find_perl_installsitelib
-perl_lib=$installsitelib/NOCpulse/TSDB
-
-mkdir -p $RPM_BUILD_ROOT/$perl_lib
-cp NOCpulse/TSDB/Accessor.pm $RPM_BUILD_ROOT/$perl_lib
-
-%point_scripts_to_correct_perl
-%make_file_list
-
-
-%files -f %{name}-%{version}-%{release}-filelist
-
-
-%clean
-%abstract_clean_script
diff --git a/monitoring/NOT-USED/tsdb_accessor_perl/NOCpulse/TSDB/Accessor.pm b/monitoring/NOT-USED/tsdb_accessor_perl/NOCpulse/TSDB/Accessor.pm
deleted file mode 100644
index 448494a..0000000
--- a/monitoring/NOT-USED/tsdb_accessor_perl/NOCpulse/TSDB/Accessor.pm
+++ /dev/null
@@ -1,375 +0,0 @@
-
-package NOCpulse::TSDB::Accessor;
-
-use strict;
-use LWP::UserAgent;
-use URI::Escape;
-
-my $BADCHARS = '^-_a-zA-Z0-9';
-
-sub new
-{
- my $class = shift;
- my %args = @_;
-
- my $self = {};
- bless $self, $class;
-
- if( defined $args{'url'} )
- {
- $self->{url} = $args{'url'};
- }
- else
- {
- $self->{host} = $args{'host'} || 'tsdb.nocpulse.net';
- $self->{port} = $args{'port'} || 80;
- }
- $self->{verbose} = $args{'verbose'} || 0;
- $self->{ua} = LWP::UserAgent->new;
-
- return $self;
-}
-
-sub insert
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = "fn=insert&oid=".$args{'oid'}. "&t=".$args{'t'}."&v=".$args{'v'};
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-sub size
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = "fn=size&oid=".$args{'oid'};
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- my ($oid, $size) = split(" ", $response->content());
- ${$args{'result'}} = $size;
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-
-}
-
-sub upload
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $data = $args{'data'};
-
- my $content = "fn=upload&data=".uri_escape($data, $BADCHARS);
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-
-sub batch_insert
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $text_data = "";
- my $datum;
- foreach $datum (@{$args{'data'}})
- {
- $text_data .= $datum->[0]." ".$datum->[1]." ".$datum->[2]."\n";
- }
-
- my $content = "fn=batch_insert&data=$text_data";
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-sub copy
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = uri_escape("fn=copy".
- "&from_oid=".$args{'from_oid'}.
- "&to_oid=".$args{'to_oid'}.
- "&start=".$args{'start'}.
- "&end=".$args{'end'}, $BADCHARS);
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-sub delete
-{
- my $self = shift;
- my %args = @_;
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = "fn=delete".
- "&oid=".$args{'oid'}.
- "&t=".$args{'t'};
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-sub fetch
-{
- my $self = shift;
- my %args = @_;
-
- my $results = $args{'results'}; # a hash ref
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = "fn=fetch&oid=".$args{'oid'}.
- "&start=".$args{'start'}."&end=".$args{'end'};
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
-
- if( $args{'raw'} == 1 )
- {
- ${$results} = $response->content;
- }
- else
- {
- $results->{times} = [];
- $results->{values} = [];
- my @lines = split "\n", $response->content();
-
- shift @lines;
-
- my $line;
- foreach $line (@lines)
- {
- last if $line eq 'END';
-
- my ($t, $v) = split /\s+/, $line;
- push @{$results->{times}}, $t;
- push @{$results->{values}}, $v;
- }
- }
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-sub batch_fetch
-{
- my $self = shift;
- my %args = @_;
-
- my $results = $args{'results'}; # a hash ref
-
- $results->{times} = [];
- $results->{values} = [];
-
- my $request;
-
- if( defined $self->{'url'} )
- {
- $request = HTTP::Request->new('POST', $self->{'url'} . "/db");
- }
- else
- {
- $request = HTTP::Request->new('POST', "http://".$self->{host}.":".$self->{port}."/db");
- }
-
- my $content = "fn=batchfetch&".
- (join("&",( map {"oid=".$_} @{$args{'oids'}})));
-
- $request->content($content);
-
- my $response = $self->{ua}->request($request);
-
- if ($response->is_success)
- {
- print $response->content if ( $self->{verbose} );
-
- # PARSE !!!!
- my @lines = split "\n", $response->content();
- my $line;
- foreach $line (@lines)
- {
- my ($t, $v) = split /\s+/, $line;
- push @{$results->{times}}, $t;
- push @{$results->{values}}, $v;
- }
- }
- else
- {
- $! = $response->status_line;
- return 0;
- }
-
- return 1;
-}
-
-1;
-
diff --git a/monitoring/NOT-USED/tsdb_accessor_perl/README b/monitoring/NOT-USED/tsdb_accessor_perl/README
deleted file mode 100644
index 3545a83..0000000
--- a/monitoring/NOT-USED/tsdb_accessor_perl/README
+++ /dev/null
@@ -1,111 +0,0 @@
-Object Identifiers (<OID>s)
----------------------------
-
- A TSDB <OID> uniquely identifies a file in the database. There
- are two recognized <OID> formats:
-
- Regular probes: <custid>-<probeid>-<metric>
- URL/Transaction probes: LongLegs-<clusterid>-<probeid>-<metric>
-
-
-
-Datatypes
----------
-
- +-----------------+--------------------------------------------------------+
- | TYPE | DESCRIPTION |
- +-----------------+--------------------------------------------------------+
- | <TIMESTAMP> | A date in Unix epoch format. |
- +-----------------+--------------------------------------------------------+
- | <VALUE> | A floating-point numeric value. |
- +-----------------+--------------------------------------------------------+
- | <DATAPOINT> | A string of the form: |
- | | |
- | | <OID> <TIMESTAMP> <VALUE> |
- +-----------------+--------------------------------------------------------+
- | <DATALIST> | A newline-separated list of <DATAPOINT> data. |
- | | (Note: on fetch requests, a <DATALIST> line may |
- | | contain an <OID> instead of a <DATAPOINT> if no |
- | | data is available for the identified metric.) |
- | | |
- +-----------------+--------------------------------------------------------+
- | <PACKET> | A data packet of the form: |
- | | |
- | | BEGIN <OID> |
- | | <TIMESTAMP> <VALUE> |
- | | [<TIMESTAMP> <VALUE> ...] |
- | | END |
- +-----------------+--------------------------------------------------------+
- | <PACKETLIST> | A newline-separated list of <PACKET> data. |
- +-----------------+--------------------------------------------------------+
- | <PARAMS> | URL-encoded parameters to a function. |
- +-----------------+--------------------------------------------------------+
- | <STATUS> | Return status of the form: |
- | | |
- | | <OID> <TIMESTAMP> ok - insert successful |
- | | <OID> <TIMESTAMP> retry - transient failure |
- | | <OID> <TIMESTAMP> fatal - permanent failure |
- +-----------------+--------------------------------------------------------+
- | <STATUSLIST> | A newline-separated list of <STATUS> data. |
- +-----------------+--------------------------------------------------------+
-
-
-
-TSDB API
---------
-
- URL: http://tsdb.nocpulse.com/db?fn=<FN>&<PARAMS>
-
- Available funcitons (<FN>) and their <PARAMS>:
-
- insert - insert a single datapoint for a single metric.
- oid=<OID>
- t=<TIMESTAMP>
- v=<VALUE>
-
- RETURNS: <STATUS>
-
- upload - insert multiple datapoints for one or more metrics.
- data=<PACKET>[<PACKET>...]
-
- RETURNS: ok
-
- batch_insert - insert multiple datapoints for multiple metrics.
- data=<DATAPOINT>\n[<DATAPOINT>\n...]
-
- RETURNS: <STATUSLIST>
-
- fetch - fetch TSDB datapoints for a single metric.
- start=<TIMESTAMP>
- end=<TIMESTAMP>
- oid=<OID>
-
- RETURNS: <PACKET>
-
- batch_fetch - fetch TSDB datapoints for one or more metrics.
- start=<TIMESTAMP>
- end=<TIMESTAMP>
- oid=<OID>[&oid=<OID>...]
-
- RETURNS: <PACKETLIST>
-
- last - returns the last TSDB datapoint for a single metric.
- oid=<OID>
-
- RETURNS: <DATAPOINT>
-
- batch_last - returns the last TSDB datapoint for one or more metrics.
- oid=<OID>[&oid=<OID>...]
-
- RETURNS: <DATAPOINTLIST>
-
- delete - delete a datafile.
- oid=<OID>
-
- RETURNS: <STATUS>
-
- size - returns the size of a data file.
- oid=<OID>
-
- RETURNS: <OID> <size>
-
diff --git a/monitoring/NOT-USED/tsdb_accessor_perl/version b/monitoring/NOT-USED/tsdb_accessor_perl/version
deleted file mode 100644
index 6d14a59..0000000
--- a/monitoring/NOT-USED/tsdb_accessor_perl/version
+++ /dev/null
@@ -1 +0,0 @@
-1.4.0 7
11 years, 4 months