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(' ',(a)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.'(a)'.$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";