# -*- perl -*-

# Copyright (c) 2002 by Jeff Weisberg
# Author: Jeff Weisberg <argus @ tcp4me.com>
# Date: 2002-Apr-02 17:11 (EST)
# Function: Monitor Element class
#
# $Id: MonEl.pm,v 1.188 2012/10/27 03:12:18 jaw Exp $

package MonEl;
@ISA = qw(Configable);

use Stats;
use Override;
use Web;
use Argus::Encode;
use Argus::MonEl::Expand;
use Argus::MonEl::Noise;
use Argus::MonEl::Trans;
use Argus::Web::Overview;
use POSIX;

use strict qw(refs vars);
use vars qw(@ISA $doc @all %byname %isdown %severity_sort);

@all = ();
%byname = ();
%isdown = ();

my $OLD_AGE = 3600 * 24 * 30;	# for janitorial cleanup
my $MID_AGE = 3600 * 24;

%severity_sort = ( clear => 0, warning => 1, minor => 2, major => 3, critical => 4 );


$doc = {
    package => __PACKAGE__,
    file    => __FILE__,
    isa     => [qw(DARP::MonEl Configable) ],
    methods => {},
    conf => {
	quotp => 1,
	bodyp => 1,
    },
    fields  =>  {
	i_am_top => {},
	transient=> {
	    descr => 'object is temporary',
	    attrs => ['config'], # XXX
	},
	name     => {
	    descr=> 'relative name of this object',
	},
	type     => {
	    descr => 'type of object',
	},
	uname    => {
	    # will be same as name, except for services
	    descr => 'a name for this object. if specified, must be unique within the enclosing group.',
	    attrs => ['config'],
	    # eg. Group "Foo" {
	    #		Service HTTP
	    #		Service HTTP {
	    #			port: 8080
	    #  			uname: HTTP-2
	    #		}
	},
	friendlyname => {
	    descr => 'a friendlier name for this object',
	},
	unique   => {
	    descr => 'full unique name of this object',
	},
	parents  => {
	    descr => 'list of objects parents',
	},
	children => {
	    descr => 'list of objects children',
	},
	cronjobs => {
	    descr => 'list of cronjobs',
	},
	override => {
	    descr => 'override data',
	},
	anc_in_ov => {
	    descr => 'an ancestor is in override',
	},
	alarm    => {
	    descr => 'is the siren currently ringing',
	    attrs => ['bool'],
	},

	definedinfile => {
	    descr => 'file the object was defined in',
	},
	definedonline => {
	    descr => 'line number the object was defined on',
	},
	definedattime => {
	    descr => 'time the object was defined',
	},
	ovstatussummary => {
	    descr => 'totals of children status',
	},
	interesting => {
	    descr => 'am I interesting',
	},
	sort => {
	    descr => 'sort the entries on web page',
	    default => 'yes', # except for Top
	    attrs => ['config', 'bool'],
	},
	autogenerated => {
	    descr => 'was this object generated automagically',
	    # to be used by config file editing utilities
	    # or built-in web-based configurator (RSN)
	    default => 'no',
	    attrs => ['config', 'bool', 'nyi'],
	},
	overridable => {
	    descr => 'can this object be overridden', # but see also acl_override
	    attrs => ['config', 'bool', 'inherit'],
	    versn => '3.5', # previously, not inherited
	    default => 'yes',
	    html  => 'override',
	},
	# note, info, comment, details all do exactly the same thing
	note => {
	    descr => 'informational text displayed on webpage',
	    attrs => ['config', 'inherit'],
	    versn => '3.3', # previously, not inherited
	    html  => 'webpretty',
	},
	info => {
	    descr => 'informational text displayed on webpage',
	    attrs => ['config', 'inherit'],
	    versn => '3.5', # previously, not inherited
	    html  => 'webpretty',
	},
	comment => {
	    descr => 'informational text displayed on webpage',
	    attrs => ['config', 'inherit'],
	    versn => '3.5', # previously, not inherited
	    html  => 'webpretty',
	},
	details => {
	    # expected to be a <A HREF="link">label</A>
	    descr => 'informational text displayed on webpage - usually a link to more details',
	    attrs => ['config', 'inherit'],
	    versn => '3.3', # previously, not inherited
	    html  => 'webpretty',
	},
	debug => {
	    descr => 'send all sorts of gibberish to syslog (et al)',
	    # default => 'no',
	    attrs => ['config', 'bool'],
	    html  => 'troubleshooting',
	},
	flags => {
	    descr => 'various config data, summarized and displayed on webpage',
	    attrs => ['internal'],
	},
	passive => {
	    descr => 'object is passive - sets nostatus=yes, siren=no, sendnotify=no',
	    attrs => ['config', 'inherit', 'bool'],
	    default => 'no',
	},
	depends => {
	    descr => 'list of dependency objects',
	    exmpl => 'Top:Foo:SMTP  Top:Bar:HTTP  Top:Bar:IMAP',
	    attrs => ['config', 'inherit'],
	    versn => '3.5', # previously, not inherited
	},
	depend::culprit => {
	    descr => 'name of dependency object preventing us from transitioning to down',
	},
        depend::onme => {
	    descr => 'list of objects for which I am the dependency culprit',
	},

	# transition
	siren => {
	    descr => 'should alarm ring',
	    attrs => ['config', 'inherit', 'bool'],
	    default => 'yes',
	},
	nostatus => {
	    descr => 'should the status be ignored',
	    attrs => ['config', 'inherit', 'bool'],
	    default => 'no',
	},
	# Change the gravitational constant of the universe!
	#   -- Q, Star Trek TNG
	gravity => {
	    descr => 'governs group state transitions: down => group is down if any child is down, up => group is up if any child is up',
	    attrs => ['config'],
	    default => 'down',
	    vals  => ['up', 'down', 'vote'],
	    # down => object is down if any child is down, (even though some are up)
	    # up   => object is up if any child is up, (even though some are down)
	    #
	    # eg. set gravity=up if you want to notified only if ALL nameservers are down...
	},
	countstop => {
	    descr => 'do not recurse and count children in count mode (the numbers on Top webpage)',
	    attrs => ['config', 'bool'],
	    default => 'no',
	},

	status => {
	    descr => 'current real status (up or down)',
	    vals  => ['up', 'down'], # degraded, attention, bouncing
	},
	ovstatus => {
	    descr => 'current status (up, down, or override)',
	    vals  => ['up', 'down', 'override'],
	},
	prevstatus   => {
	    descr => 'previous value of status',
	},
	prevovstatus => {
	    descr => 'previous value of ovstatus',
	},

	transtime => {
	    descr => 'time of last transition',
	},
	sirentime => {
	    descr => 'hush siren timestamp',
	},
	severity => {
	    descr => 'severity level of down state',
	    attrs => ['config', 'inherit'],
	    # ISO 10164-4
	    vals  => ['clear', 'warning', 'minor', 'major', 'critical'],
	    default => 'critical',
	    versn => '3.3',
	},
	currseverity => {
	    descr => 'current severity level',
	},
	prevseverity => {
	    descr => 'previous severity level',
	},

	# notification

	# message_fmt + message{up,dn} => %M
      notify::message_fmt => {
	  descr => 'format for notification messages',
	  attrs => ['config', 'inherit'],
          # %i => idno
          # %t => time
          # %m => message{up/dn}
	  default => '%i %t - %m',
	  versn => '3.3',
      },
      notify::message_fmtup => {
	  descr => 'format for up notification messages',
	  attrs => ['config', 'inherit'],
	  versn => '3.4',
      },
      notify::message_fmtdn => {
	  descr => 'format for down notification messages',
	  attrs => ['config', 'inherit'],
	  versn => '3.4',
      },
      notify::messageup => {
	  descr => 'message to transmit for UP notifications',
	  attrs => ['config', 'inherit'],
	  versn => '3.5', # previously, not inherited
	  html  => 'notif',
      },
      notify::messagedn => {
	  descr => 'message to transmit for DOWN notifications',
	  # "Server Room is too Hot" may be better than "1.2.3.4:.1.2.4.6.8.35.17.24.7.1 is down"
	  # NB: messages can be emtpy, in which case nothing will be sent
	  attrs => ['config', 'inherit'],
	  versn => '3.5', # previously, not inherited
	  html  => 'notif',
      },

      notify::message_lotsdn => {
	  descr => 'message to transmit for lots DOWN summary notifications',
	  attrs => ['config', 'top'],
	  html  => 'notif',
	  versn => '3.2',
      },
      notify::message_lotsup => {
	  descr => 'message to transmit for lots UP summary notifications',
	  attrs => ['config', 'top'],
	  html  => 'notif',
	  versn => '3.2',
      },
      notify::nolotsmsgs => {
	  descr => 'list all msgs, dont summarize into Lots DOWN/UP',
	  attrs => ['config', 'top', 'bool'],
	  default => 'yes',
	  html  => 'notif',
	  versn => '3.5', # was 'no'
      },
      notify::shortmessages => {
	  descr => 'deprecated, use message_style: short',
	  attrs => ['config', 'bool', 'deprecated'],
	  versn => '3.6',
	  default => 'no',
	  html  => 'notif',
      },
      notify::message_style => {
	  descr => 'what style of message to send by default',
	  attrs => ['config', 'inherit'],
	  vals  => ['long', 'short', 'friendly'],
	  versn => '3.6',
	  default => 'friendly',
	  html  => 'notif',
      },

      # also, notify.$severity
      notify::notify => {
	  descr => 'list of addresses to notify',
	  exmpl => 'mail:user@example.com qpage:sysop aim:joeysmith vxml:2155551234',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
      },
      'notify::schedule notify' => {
 	  descr => 'schedule of who to notify when',
 	  attrs => ['config', 'inherit', 'sched'],
 	  versn => '3.7',
 	  html  => 'notif',
      },
      notify::notifyalso => {
	  descr => 'list of addresses to notify in addition to notify, notifyup, notifydn',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
	  versn => '3.2.1',
      },
      notify::notifyaudit => {
	  descr => 'list of addresses to notify with audit trail messages',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
	  versn => '3.3',
      },

      notify::notifyup => {
	  descr => 'list of addresses to notify when up',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
	  versn => '3.2',
      },
      notify::notifydn => {
	  descr => 'list of addresses to notify when down',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
	  versn => '3.2',
      },
      'notify::schedule notifyup' => {
 	  descr => 'schedule of who to notify when, when up',
 	  attrs => ['config', 'inherit', 'sched'],
 	  versn => '3.7',
 	  html  => 'notif',
      },
      'notify::schedule notifydn' => {
 	  descr => 'schedule of who to notify when, when down',
 	  attrs => ['config', 'inherit', 'sched'],
 	  versn => '3.7',
 	  html  => 'notif',
      },
      notify::mail_from => {
	  descr => 'address to use as From: on notification email',
	  attrs => ['config', 'inherit'],
	  versn => '3.1.3',
	  exmpl => 'joebob@example.com',
	  default => 'Argus',
	  html  => 'notif',
      },
      notify::renotify => {
	  descr => 'notification re-send time period in seconds',
	  attrs => ['config', 'inherit', 'timespec'],
	  default => 300,
	  versn => '3.5',
	  html  => 'notif',
      },
      notify::unack_timeout => {
	  descr => 'automatically ack notification if it is up and this much time has passed',
	  attrs => ['config', 'inherit', 'timespec'],
	  default => 3600,
	  versn => '3.6',
	  html  => 'notif',
      },
      notify::autoack => {
	  descr => 'automatically ack notifications',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'no',
	  html  => 'notif',
      },
      notify::ackonup => {
	  descr => 'automatically ack notifications when it comes up',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'no',
	  versn => '3.2',
      },
      notify::ack_on_better => {
	  descr => 'automatically ack notifications when severity level improves',
	  attrs => ['config', 'inherit', 'bool'],
	  versn => '3.6',
	  html  => 'notif',
      },
      notify::ack_on_worse => {
	  descr => 'automatically ack notifications when severity level worsens',
	  attrs => ['config', 'inherit', 'bool'],
	  versn => '3.6',
	  html  => 'notif',
      },

      notify::escalate => {
	  descr => 'list of times (in minutes or as a timespec) and addresses for notification escalation',
	  attrs => ['config', 'inherit'],
	  exmpl => '30 qpage:manager qpage:noc;  60 qpage:ceo',
	  versn => '3.5',
	  html  => 'notif',
      },
      notify::sendnotify => {
	  descr => 'should notifications be sent for this object',
	  attrs => ['config', 'inherit', 'bool'],
	  # default varies by object, Services=>yes, Group=>no
	  versn => '3.5',
	  html  => 'notif',
      },
      notify::sendnotify2 => {
	  descr => 'deprecated, use sendnotify and/or sendnotify!',
	  attrs => ['config', 'bool', 'deprecated'],
	  versn => '3.5',
	  html  => 'notif',
      },
      'notify::schedule sendnotify' => {
 	  descr => 'schedule of when to send/not send notifications',
 	  attrs => ['config', 'inherit', 'sched', 'bool'],
 	  versn => '3.7',
 	  html  => 'notif',
      },
      notify::priority => {
	  # not used by internal notification methods, but is available
	  # for user defined methods to use as they see fit
	  descr => 'priority level of notifications',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
      },
      notify::timezone => {
	  descr => 'timezone to use in notification message times',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
      },

      notify::list => {
	  descr => 'list of all outstanding notifications',
      },

	# web page
      web::transtime => {
	  descr => 'last time the object changed',
      },
      web::bldtime   => {
	  descr => 'time the web page was last generated',
      },
      web::bldtimetop=> {
	  descr => 'time the web page (top version) was last generated',
      },

      web::header_branding => {
	  descr => 'local branding header',
          exmpl => '[span class=example]YoYoDyne Operations Center[/span]',
	  attrs => ['config', 'inherit'],
	  versn => '3.7',
	  html  => 'webpretty',
      },
      web::header => {
	  descr => 'stuff to put at the top of the webpage',
	  attrs => ['config', 'inherit'],
	  versn => '3.5', # previously, not inherited
	  html  => 'webpretty',
      },
      web::footer => {
	  descr => 'stuff to put at the bottom of the webpage',
	  attrs => ['config', 'inherit'],
	  versn => '3.5', # previously, not inherited
	  html  => 'webpretty',
      },
      web::header_all => {
	  descr => 'deprecated, use header',
	  attrs => ['config', 'inherit', 'deprecated'],
	  versn => '3.7',
	  html  => 'webpretty',
      },

      web::footer_all => {
	  descr => 'deprecated, use footer',
	  attrs => ['config', 'inherit', 'deprecated'],
	  versn => '3.7',
	  html  => 'webpretty',
      },
      web::footer_argus => {
	  descr => 'argus version footer',
	  attrs => ['config', 'inherit'],
	  versn => '3.1.3',
	  default => "<A HREF=\"$::ARGUS_URL\">Argus</A>: $::VERSION",
	  html  => 'webpretty',
      },
      web::showstats => {
	  descr => 'show stats on the web page',
	  attrs => ['config', 'bool', 'inherit'],
	  default => 'yes',
	  html  => 'webpretty',
	  versn => '3.5', # previously, not inherited
      },
      web::shownotiflist => {
	  descr => 'show the list of notifications on the web page',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'yes',
	  versn => '3.2',
	  html  => 'webpretty',
      },
      web::hidden => {
	  attrs => ['config', 'bool'],
	  versn => '3.2',
      },
      web::alwaysbase => {
	  attrs => ['config', 'bool', 'inherit'],
	  versn => '3.2',
      },
      web::buttons_top_html => {
	  descr => 'html to place at the top of the web page buttons',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
      },
      web::buttons_bottom_html => {
	  descr => 'html to place at the bottom of the web page buttons',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
      },

      web::javascript => {
	  descr => 'web page javascript urls (space separated)',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
	  versn => '3.5',
      },
      web::style_sheet => {
	  descr => 'web page style sheet urls (space separated)',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
	  versn => '3.3',
      },
      web::bkgimage => {
	  descr => 'web page background image url',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::refresh => {
	  descr => 'web page auto-refresh period',
	  attrs => ['config', 'inherit', 'timespec'],
	  versn => '3.5',
	  default => 60,
	  html  => 'webpretty',
      },
      web::icon => {
	  descr => 'url of 16x16 icon shown in some browsers',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::icon_up => {
	  descr => 'url of 16x16 icon shown in some browsers - when object is up',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::icon_down => {
	  descr => 'url of 16x16 icon shown in some browsers - when object is down',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::nospkr_icon => {
	  descr => 'url of hushed siren icon',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::sirensong => {
	  descr => 'url of wav file for browser to play when object is down',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },

      web::cachestale => {
	  # I don't want *any* cake
	  #   -- Monty Python, Meaning of Life
	  versn => '3.5',
	  descr => 'maximum age of cached web page before displaying a warning, in seconds',
	  attrs => ['config', 'inherit', 'timespec'],
	  versn => '3.5',
	  default => 120,
      },

	label_left => {
	    descr => 'label to use on the left side of the webpage',
	    attrs => ['config'],
	},
	label_right => {
	    descr => 'label to use on the right side of the webpage',
	    attrs => ['config'],
	},
	label_right_maybe => {},
	label_left_maybe  => {},
	label => {
	    descr => 'label to use on right and/or left side of the webpage',
	    attrs => ['config'],
	},
	label_overview => {
	    descr => 'label to use on the overview webpage',
	    attrs => ['config'],
	},

	# AAA if more vxml params are added, these may be moved and renamed.
	# these are passed to vxml tts. ssml may be used if the tts engine suppports it.
	vxml_short_name => {
	    descr => 'short name for this object to be used in VXML TTS, may contain SSML',
	    exmpl => 'gee double you seven three',
	    attrs => ['config'],
	    versn => '3.5',
	},
	vxml_long_name => {
	    descr => 'long name for this object to be used in VXML TTS, may contain SSML',
	    exmpl => 'new york city router gee double you seven three',
	    attrs => ['config'],
	    versn => '3.5',
	},
	vxml_descr => {
	    descr => 'informational text to be used in VXML TTS, may contain SSML',
	    attrs => ['config'],
	    versn => '3.5',
	},

	#### ACLs
	acl_mode => {
	    descr => 'deprecated, acl mode is now automatic',
	    attrs => ['config', 'deprecated'],
	    vals  => ['simple', 'extended'],
	    default => 'simple',
	    versn => '3.5',
	    html  => 'acl',
	},

	# acl_mode = simple:
	acl_user => {
	    descr => 'simple mode access control list - read-only web page access',
	    attrs => ['config', 'acl'],
	    default => 'user staff root',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_staff => {
	    descr => 'simple mode access control list - some read/write web page access',
	    attrs => ['config', 'acl'],
	    default => 'staff root',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_root => {
	    descr => 'simple mode access control list - full web page access',
	    attrs => ['config', 'acl'],
	    default => 'root',
	    versn => '3.1',
	    html  => 'acl',
	},

	# acl_mode = extended:
	acl_page => {
	    descr => 'extended mode access control list - for web page access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_user',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_about => {
	    descr => 'extended mode access control list - for debugging page access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_root',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_getconf => {
	    descr => 'extended mode access control list - display config page access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_root',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_flush => {
	    descr => 'extended mode access control list - flush page access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_root',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_override => {
	    descr => 'extended mode access control list - set/clear override access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_staff',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_annotate => {
	    descr => 'extended mode access control list - add/remove annotation access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_staff',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_logfile => {
	    descr => 'extended mode access control list - logfile access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_staff',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_ntfylist => {
	    descr => 'extended mode access control list - notification list access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_staff',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_ntfyack => {
	    descr => 'extended mode access control list - ack notifications access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_staff',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_ntfyackall => {
	    descr => 'extended mode access control list - ack all notifications access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_root',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_ntfydetail => {
	    descr => 'extended mode access control list - notification details page access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_staff',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_checknow => {
	    descr => 'extended mode access control list - check now access',
	    attrs => ['config', 'acl'],
	    ifacl => 'acl_root',
	    versn => '3.5',
	    html  => 'acl',
	},

	# stats
	logsize => {
	    descr => 'maximum number of log entries to keep',
	    default => 200,
	    attrs => ['config', 'inherit'],
	},
	nostats => {
	    descr => 'do not record any statistics',
	    attrs => ['config', 'bool', 'inherit'],
	    versn => '3.5', # previously, not inherited
	    default => 'no',
	},

      stats::log => {
	  descr => 'object event log - array of [Time, status, ovstatus, tag, msg]',
      },
      stats::lasttime => {
	  descr => 'time stats were last updated',
      },
      stats::status   => {
	  descr => 'status at time of last stats update',
      },
      stats::daily    => {
	  descr => 'daily statistics',
      },
      stats::monthly  => {
	  descr => 'monthly statistics',
      },
      stats::yearly   => {
	  descr => 'yearly statistics',
      },

	graph => {
	    descr => 'generate graphs? if turned on, data will be saved, and images produced',
	    attrs => ['config', 'bool', 'inherit'],
	    default => 'no',
	    versn => '3.2',
	    html  => 'graphing',
	},

      image::gr_what => {
	  descr => 'what should be graphed? result: the result of a test, elapsed: the elapsed time of a test, status: the status of a test (up or down)',
	  attrs => ['config', 'inherit'],
	  vals  => ['result', 'elapsed', 'status'],
	  default => 'result',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gr_colors => {
	  descr => 'colors used on group-level graphs - list of RRGGBB RRGGBB ...',
	  attrs => ['config', 'inherit'],
	  exmpl => 'FF2222  4456CC  CCFF44',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gr_range => {
	  descr => 'range of values for the y-axis on graphs ([min]-[max]). default is to automatically determine.',
	  attrs => ['config', 'inherit'],
	  exmpl => '0-1500',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gr_xrange_samples => {
	  descr => 'range for x-axis (in seconds) on samples graphs',
	  attrs => ['config', 'inherit', 'timespec'],
	  exmpl => '36h',
	  versn => '3.5',
	  html  => 'graphing',
      },
      image::gr_xrange_hours => {
	  descr => 'range for x-axis (in seconds) on hours graphs',
	  attrs => ['config', 'inherit', 'timespec'],
	  exmpl => '2w',
	  versn => '3.5',
	  html  => 'graphing',
      },
      image::gr_xrange_days => {
	  descr => 'range for x-axis (in seconds) on days graphs',
	  attrs => ['config', 'inherit', 'timespec'],
	  exmpl => '90d',
	  versn => '3.5',
	  html  => 'graphing',
      },
      image::gr_line_thickness => {
	  descr => 'thickness of lines on large graphs (requires GD >= 2.07)',
	  attrs => ['config', 'inherit'],
	  exmpl => '3',
	  default => 2,
	  versn => '3.5',
	  html  => 'graphing',
      },
      image::gr_drop_shadow => {
          descr => 'add a drop shadow on graphs',
	  attrs => ['config', 'inherit', 'bool'],
          default => 'yes',
          versn => '3.7',
	  html  => 'graphing',
      },
      image::gr_smooth => {
          descr => 'connect the dots with smooth curves instead of straight lines',
	  attrs => ['config', 'inherit'],
          default => 1,
          versn => '3.7',
	  html  => 'graphing',
      },

      image::xlabel => {
	  descr => 'text label to use on x-axis of graphs',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::ylabel => {
	  descr => 'textlabel to use on y-axis of graphs',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
	  html  => 'graphing',
	  exmpl => 'bytes',
      },
      image::title => {
	  descr => 'text title to put at the top of graph',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
	  html  => 'graphing',
	  exmpl => 'Bandwidth Usage',
      },
      image::logscale => { # NYI
	  descr => 'make the y-axis logarithmic on graphs',
	  attrs => ['config', 'bool', 'nyi'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::drawgrid => {
	  descr => 'draw a grid on the graphs',
	  attrs => ['config', 'inherit', 'bool'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gridontop => {
	  descr => 'draw grid over the graph (instead of under)',
	  attrs => ['config', 'inherit', 'bool'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gr_binary => {
	  descr => 'label the graph y axis in powers of 2 (instead of powers of 10)',
	  attrs => ['config', 'inherit', 'bool'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::barstyle => {
	  descr => 'style of summary range bars on hours and days graphs: minimum/maximum, standard deviation, or none',
	  attrs => ['config', 'inherit'],
	  vals  => ['minmax', 'stddev', 'none'],
	  default => 'minmax',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gr_bar_color => {
	  descr => 'color of bars',
	  attrs => ['config', 'inherit'],
	  default => 'AAAAFF',
	  versn => '3.7',
	  html  => 'graphing',
      },
      image::gr_bar_nstddev => {
	  descr => 'standard deviation bars are drawn n * sigma from mean',
	  attrs => ['config', 'inherit'],
	  versn => '3.7',
	  html  => 'graphing',
      },
      image::labelstyle => {
	  descr => 'style for dataset labels on group-level graphs: colored text or colored boxes',
	  attrs => ['config', 'inherit'],
	  vals  => ['text', 'box'],
	  default => 'box',
	  versn => '3.4',
	  html  => 'graphing',
      },
      image::whichgraphs => {
	  descr => 'deprecated, use gr_show_{samples,hours,days}',
	  attrs => ['config', 'deprecated'],
	  versn => '3.5',
	  html  => 'graphing',
      },
      image::gr_show_samples => {
	  descr => 'should the samples graph be displayed',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'yes',
	  versn => '3.5',
	  html  => 'graphing',
      },
      image::gr_show_hours => {
	  descr => 'should the hours graph be displayed',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'yes',
	  versn => '3.5',
	  html  => 'graphing',
      },
      image::gr_show_days => {
	  descr => 'should the days graph be displayed',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'yes',
	  versn => '3.5',
	  html  => 'graphing',
      },
      image::transparent => {
	  descr => 'should the background of graphs be transparent',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'yes',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::drawborder => {
	  descr => 'draw a border around the edge of the graph image',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'yes',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gr_show_hwab => {
          descr => 'should holt-winters forecast be included on the graph?',
          attrs => ['config', 'inherit', 'bool'],
          default => 'yes',
          versn => '3.7',
          html  => 'hwab',
      },
      image::gr_hwab_color => {
          descr => 'color of hwab graph',
          attrs => ['config', 'inherit'],
          default => 'DDDDFF',
          versn => '3.7',
          html  => 'hwab',
      },
      image::gr_hwab_range_ignore => {
          descr => 'do not consider holt-winters data in determining the graphing range',
          attrs => ['config', 'inherit', 'bool'],
          default => 'yes',
          versn => '3.7',
          html  => 'hwab',
      },
      # other graph params can be found in Service

	archive_fmt => {
	    # see also: archive_prog
	    descr => 'format of data sent to archive program (archive_prog)',
	    attrs => ['config', 'inherit'],
	    versn => '3.5',
	    html => 'interfacing',
	},

################################################################
# misc
################################################################
        watch::watching => {},	# for ticket system interface
        watch::watched  => {},

    },
};

# add in severity based notification params
for my $sev (qw(critical major minor warning)){
    for my $p (qw(renotify autoack escalate ack_on_better ack_on_worse)){
	# none of these are applicable for 'up/clear'
	my %d = %{ $doc->{fields}{"notify::$p"} };
	$d{versn} = '3.6';
	$d{descr} .= " when down/$sev";
	delete $d{default};
	$doc->{fields}{"notify::$p.$sev"} = \%d;
    }
}
delete $doc->{fields}{'notify::ack_on_worse.critical'};

for my $sev (qw(critical major minor warning clear)){
    for my $p (qw(siren web::icon notify::notify notify::sendnotify), 
    		'notify::schedule notify', 'notify::schedule sendnotify'){
	my %d = %{ $doc->{fields}{$p} };
	$d{versn} = '3.6' if $d{versn} < 3.6;
	$d{descr} .= ($sev eq 'clear') ? " when up/$sev" : " when down/$sev";
	delete $d{default};
	$doc->{fields}{"$p.$sev"} = \%d;
    }
}

sub find {
    my $name = shift;

    return $::Top if $name eq 'Top';
    return $byname{ $name };
}

# what is my name?
sub unique {
    my $me = shift;
    my( $x, $n, $nn );

    return $me->{unique} if $me->{unique};

    if( $me->{parents} && $me->{parents}[0] ){
	$n = $me->{parents}[0]->unique();
	$n .= ':';
    }
    $nn = $me->{uname} || $me->{name};
    $nn =~ s/\s+/_/g;
    $nn =~ tr/\000-\037//d;
    $n .= $nn;
    $me->{unique} = $n;
    $n;
}

# what is my file?
sub filename {
    my $me = shift;
    my $n = $me->unique();

    return encode( $n );
}

# what is my path?
sub pathname {
    my $me = shift;
    my $prefix = shift;
    my $suffix = shift;

    my $f = $me->filename();
    my $d = ::hashed_directory($f);
    $f = "$prefix$f" if $prefix;
    $f = "$f$suffix" if $suffix;

    return "$d/$f";
}

# what is my URL?
sub url {
    my $me = shift;
    my @param = @_;
    my $n = $me->filename();

    return "__BASEURL__?object=$n" . join(';', '', @param);
}

# What is the air-speed velocity of an unladen swallow?
sub air_speed_velocity {
    my $swallow = shift;
}

sub current_value {
    my $me = shift;
    my $g  = shift;
    my $p  = shift;

    my $v = $p ? $me->{$g}{$p} : $me->{$g};

    # schedule or value?
    return $v unless ref $v;
    return $v->result_now();
}

sub init {
    my $me = shift;
    my $cf = shift;
    my( $u, $k, $v );
    $me->init_from_config( $cf, $doc, '' );      	# this may change uname
    $me->init_from_config( $cf, $doc, 'web' );
    $me->init_from_config( $cf, $doc, 'notify' );
    $me->init_from_config( $cf, $doc, 'image' )   if $me->{graph};

    $me->{uname} ||= $me->{name};
    $u = $me->unique();
    if( $byname{$u} ){
	$cf->nonfatal( "Duplicate object '$u'" ) if $cf;
	return undef;
    }

    $byname{$u} = $me;
    push @all, $me;

    $me->{children}  ||= []; # prevent warning
    $me->{label_left}  = $me->{label_left}  || $me->{label} || $me->{label_left_maybe};
    $me->{label_right} = $me->{label_right} || $me->{label} || $me->{label_right_maybe};

    $me->{status} = $me->{ovstatus} = 'up';
    $me->{currseverity} = 'clear';
    $me->{alarm}  = 0;
    $me->{transtime} = $^T;
    $me->{sirentime} = $^T;
    $me->{friendlyname} ||= $me->{uname};

    # if messages are not specified, pick defaults based on style preference
    my $msgstyle = $me->{notify}{message_style};
    unless( defined $me->{notify}{messageup} ){
	if( $msgstyle eq 'long' ){
	    $me->{notify}{messageup} = '%o{unique} is %s';
	}elsif( $msgstyle eq 'short' ){
	    $me->{notify}{messageup} = '%o{uname} is %s';
	}else{
	    $me->{notify}{messageup} = $me->friendly_messageup() || '%o{friendlyname} is %s';
	}
    }
    unless( defined $me->{notify}{messagedn} ){
	if( $msgstyle eq 'long' ){
	    $me->{notify}{messagedn} = '%o{unique} is %s/%y';
	}elsif( $msgstyle eq 'short' ){
	    $me->{notify}{messagedn} = '%o{uname} is %s';
	}else{
	    $me->{notify}{messagedn} = $me->friendly_messagedn() || '%o{friendlyname} is %s/%y';
	}
    }

    $me->{image}{title} = $me->{label_right}
    	unless defined $me->{image}{title};

    if( $me->{passive} ){
	$me->{flags} .= " *passive*";
	$me->{siren}    = 0;
	$me->{nostatus} = 1;
	$me->{notify}{sendnotify} = 0;
	$me->{notify}{"sendnotify.$_"} = 0 for qw(critical major minor warning clear);
	# QQQ - set an override ?
    }

    $me->{flags} .= " status-ignored" if $me->{nostatus};
    $me->{flags} .= " gravity-up"     if $me->{gravity} eq 'up';
    $me->{flags} .= " siren-quiet"    unless $me->{siren};
    $me->{flags} .= " nostats"        if $me->{nostats};

    $me->{vxml_short_name} ||= $me->{uname};
    $me->{vxml_long_name}  ||= $me->unique();

    # compat files
    for my $d (qw(gdata stats)){
	my $newf = "$::datadir/$d/" . $me->pathname();
	my $oldf = "$::datadir/$d/" . $me->filename();
	rename $oldf, $newf if -f $oldf && !-f $newf;
    }

    $me->check_typos( $cf ) if $cf;
    Doc::check( $me )       if $::opt_T;
    $me->stats_load();

    if( $me->can('init_hook') ){
	$me->init_hook($cf);
    }

    $isdown{$u} = 1 if $me->{ovstatus} eq 'down';

    $me->cfcleanup();

    1;
}


# overridden in subclasses
sub friendly_messageup {}
sub friendly_messagedn {}
sub aliaslookup{
    my $me = shift;
    return $me;
}

END {
    deconfigure();
}

sub deconfigure {
    my @a = @all;

    foreach my $x (@a){
	$x->stats_update_and_maybe_roll();
	$x->stats_save();
	# $x->recycle();
    }
    Conf::deconfigure();
}


sub recycle {
    my $me = shift;
    my $cascade = shift;

    # remove myself from my parents and children
    foreach my $c (@{$me->{children}}){
	$c->{parents} = [ grep { $_ ne $me }
			  @{$c->{parents}} ];
	if( $cascade ){
	    $c->stats_update_and_maybe_roll();
	    $c->stats_save();
	    $c->recycle(1);
	}
    }
    foreach my $p (@{$me->{parents}}){
	$p->{children} = [ grep { $_ ne $me }
			   @{$p->{children}} ];
	$p->{web}{transtime} = $^T;	# force web page rebuild
    }

    $me->{children} = $me->{parents} = undef;
    $me->{notify}{list} = undef;
    delete $byname{ $me->unique() };
    delete $isdown{ $me->unique() };
    @all = grep { $_ ne $me } @all;
}

sub resolve_alii {
    my $me = shift;
    my $cf = shift;

    $me->aliaslookup($cf);

    foreach my $c ( @{$me->{children}} ){
	$c->resolve_alii($cf);
    }
}

# The children of the porters: the children of Shallum, the children
# of Ater, the children of Talmon, the children of Akkub, the children
# of Hatita, the children of Shobai, in all an hundred thirty and
# nine.
#     -- Ezra 2:42
sub sort_children {
    my $me = shift;

    if( $me->{sort} ){
	@{$me->{children}} =
	    map { $_->[0] }
	    sort { $a->[1] cmp $b->[1] }
	    map { [ $_, $_->sort_key() ] }
	    @{$me->{children}};

    }

    foreach my $c ( @{$me->{children}} ){
	$c->sort_children();
    }
}

sub sort_key {
    my $me = shift;

    my $name = $me->{label_left} || $me->{name};

    $name =~ s/(\d+)/sprintf('%08d', $1)/ge;
    $name;
}

sub monitored_here {
    my $me = shift;

    return 1;
}

# need to make sure we recalc statuses as objects may have changed on disk
sub jiggle {
    my $me = shift;

    foreach my $c ( @{$me->{children}} ){
	$c->jiggle();
    }
}

sub jiggle_lightly {
    my $me = shift;
    my $jone;

    foreach my $c ( @{$me->{children}} ){
	my $cc = $c->aliaslookup();
	next unless $cc; 	# skip broken alias

	if( $cc->{children} && @{$cc->{children}} ){
	    $cc->jiggle_lightly();
	    $jone = 1;
	}
	elsif( ! $jone ){
	    $cc->jiggle();
	    $jone = 1;
	}
	else{
	    jiggle_skip();
	}
    }
}
# this exists for profiling
sub jiggle_skip {}

sub check_depends {
    my $me = shift;

    # check dependencies
    foreach my $dn (split /\s+/, $me->{depends}){
	my $dp = $byname{$dn};
	next unless $dp;
	if( $dp->{ovstatus} ne 'up' ){
	    $me->{depend}{culprit} = $dn;
	    # QQQ - no clue. what to do, what to do.
	    # ovstatus should be changed, in case something depends on me
	    # and to reduce user confusion (?)
	    $me->{ovstatus}      = 'depends';
	    $me->{currseverity}  = 'warning';	# QQQ
	    $me->{alarm}         = 0;
	    $dp->{depend}{onme} .= ' ' . $me->unique();
	    return 1;
	}
    }

    undef;
}

sub resolve_depends {
    my $me = shift;
    my $cf = shift;
    my( $dt, @ndl );


    # check depend list. make sure targets are valid.
    if( $me->{depends} && !ref $me->{depends} ){
	foreach my $d (split /\s+/, $me->{depends}){
	    my $x = $byname{$d};

	    if( $x == $me ){
		$me->warning("Cannot depend on self (ignored)");
		next;
	    }
	    if( $x ){
		# ok
	    }else{
		$me->warning("Cannot resolve dependency: $d");
	    }
	    # we keep it, even if invalid...
	    push @ndl, $d;
	}

	if( @ndl ){
	    # and we keep it in a string (not [obj, ...]) :
	    #  - keep recycle easier
	    #  - so we can depend on dynamically created/temporary objs
	    #  - etc?
	    $me->{depends} = join ' ', @ndl;
	}else{
	    delete $me->{depends};
	}
    }


    # We are interested in others when they are interested in us.
    #   -- Publius Syrus, maxim 16
    # determine if they are interested in us

    if( $me->{parents} && @{$me->{parents}}){
	my $mom = $me->{parents}[0];
	my $ip;

	if( defined($mom->{interesting}) ){
	    # He smiled a kind of sickly smile and curled up on the floor
	    # And the subsequent proceedings interested him no more.
	    #   -- Francis Bret Harte, The Society upon the Stanislaus
	    $ip = 0;
	}else{
	    # Thank you,' said Alice, `it's very interesting.
	    #   -- Alice in Wonderland
	    $ip = 1 if $me->{gravity} eq 'up';
	    $ip = 1 if $me->{countstop};
	    $ip = 1 if $me->{type} eq 'Service';
	    $ip = 0 if $me->{nostatus};
	    $ip = 0 if $me->{transient};
	    $ip = 0 if $me->{web}{hidden};
	}
	$me->{interesting} = $ip;
    }else{
	# Top is not particularly interesting
	$me->{interesting} = undef;
    }


    # recurse
    foreach my $c (@{$me->{children}}){
	$c->resolve_depends($cf);
    }

}

my %TYPEMAP = (
	       group   => 'Group',
	       host    => 'Host',
	       service => 'Service',
	       method  => 'NotMe',
	       cron    => 'UserCron',
	       error   => 'Error',
	       alias   => 'Alias',
               snmpoid => 'Argus::SNMP::Conf',
	       );

sub create_object {
    my $cf    = shift;
    my $param = shift;
    my( $mom, $name, $type, $jiggle, %conf, %sched );

    foreach my $k (keys %$param){
	my $v = $param->{$k};

	if( $k eq 'parent' ){
	    my $p = $MonEl::byname{$v};
	    $cf->error( 'parent not found' ) unless $p;
	    $mom = $p;
	    next;
	}

	if( $k eq 'name'  ){ $name   = $v; next }
	if( $k eq 'type'  ){ $type   = $v; next }
	if( $k eq 'jiggle'){ $jiggle = $v; next }

	next if $k =~ /^(arguscgi|argusctl|func|quiet|seqno)$/;

	if( $k =~ /^(notypos|definedinfile|definedonline|definedattime)$/ ){
	    $conf{$k} = $v;
	    next;
	}

	if( $k =~ /^config::(.+)/ ){
            my $kk = $1;
            if( $k =~ /schedule (.+)/ ){
                $sched{$1} = $v;
                next;
            }
            $conf{config}{$kk} = $v;
	}
    }

    my $t = $TYPEMAP{lc($type)};
    $cf->error( 'unspecified object type' ) unless $type;
    $cf->error( 'invalid object type' ) unless $t;
    $cf->error( 'no name' ) unless $name;

    my $me = $t->new( %conf );
    $me->{parents} = [ $mom ] if $mom;
    $me->cfinit($cf, $name, $type);

    for my $sk (keys %sched){
        my $s = Argus::Schedule->unserialize($cf, $me, $sk, $sched{$sk});
    }

    return $cf->error( $cf->{error} || 'create failed' )
	unless $me->config($cf);

    push @{$mom->{children}}, $me if $mom;
    $mom->{web}{transtime} = $^T  if $mom;	# force web page rebuild

    $me->resolve_depends($cf);

    $me->{anc_in_ov} = 1 if $mom && ($mom->{override} || $mom->{anc_in_ov});

    if( !defined($jiggle) || $jiggle ){
        $me->jiggle();
    }

    $::Top = $me if $name eq 'Top';
    $byname{Top}->{definedattime} = $^T;
    $me;
}

sub check_now {
    my $me = shift;

    foreach my $c ( @{$me->{children}} ){
	$c->check_now();
    }
}

sub summary {
    my $me = shift;

    return $me->{ovstatussummary};
}

sub summary_old {
    my $me = shift;

    my($csv, %cs);
    for my $c (@{$me->{children}}){
	my $cc = $c->aliaslookup();

	if( $cc->{countstop} ){
	    $cs{ $cc->{ovstatus} } ++;
	    next;
	}

	if( ! $cc->{children} || ! @{$cc->{children}} ){
	    $cs{ $cc->{ovstatus} } ++;
	    next;
	}

	if( $cc->{override} ){
	    $cs{override} += @{$cc->{children}};
	    next;
	}

	# what severity are down items?
	$csv = $cc->{currseverity} if $cc->{ovstatus} eq 'down' &&
	    $MonEl::severity_sort{$cc->{currseverity}} > $MonEl::severity_sort{$csv};

	foreach my $gc ( @{$cc->{children}} ){
	    my $gcc = $gc->aliaslookup();
	    $cs{ $gcc->{ovstatus} } ++;
	}
    }

    $cs{severity} = $csv;
    \%cs;
}

################################################################
# class methods
################################################################

# some cleaning down the tables with wet sponges
#   -- Homer, Odyssey
sub janitor {

    my %keep = map { ($_->filename() => 1) } @all;

    # clean up orphaned html, stats + graph files
    foreach my $d ( [ "$::datadir/html",   $MID_AGE ],
		    [ "$::datadir/stats",  $OLD_AGE ],
		    [ "$::datadir/gdata",  $OLD_AGE ],
		    [ "$::datadir/gcache", $MID_AGE ] ){

	clean_dir(@$d, \%keep);
    }
}

sub clean_dir {
    my $dir  = shift;
    my $age  = shift;
    my $keep = shift;

    opendir(MD, $dir);
    my @files = readdir(MD);
    closedir MD;

    foreach my $f (@files){
	my $fd = "$dir/$f";
	next if $f =~ /^\./;
	if( -d $fd ){
	    clean_dir($fd, $age, $keep);
	    next;
	}
	my $fb = $f;
	$fb =~ s/\.(base|top)$//;
	next if $keep->{$fb};
	next if $^T - (stat($fd))[9] < $age;
	unlink $fd;
    }
}

################################################################

sub cmd_list {
    my $ctl = shift;
    my( $x );

    $ctl->ok();

    foreach $x (@all){
	$ctl->write( $x->unique() . "\n" );
    }
    $ctl->final();
}

sub cmd_children {
    my $ctl = shift;
    my $param = shift;
    my( $x, $c );

    $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	foreach $c ( @{$x->{children}} ){
	    $ctl->write( $c->unique() . "\n" );
	}
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub more_about_whom {
    my $me  = shift;
    my $ctl = shift;
    my @who = @_;

    WHO: foreach my $b (@who){
	my $x = $me;
	my @b = split /::/, $b;
	foreach my $p (@b){
	    next WHO unless $x->{$p};
	    $x = $x->{$p};
	}

	foreach my $k (sort keys %$x) {
	    my $v = $x->{$k};
	    next unless defined $v;
	    next if $b eq 'snmp' && $k =~ /community|snmppass|snmpprivpass/ && ::topconf('_hide_comm');

	    if( ref($v) ){
                if( UNIVERSAL::can($v, 'about') ){
                    $v = $v->about();
                }else{
                    $v = '#<REF>';
                }
	    }else{
		$v = encode( $v );
	    }
	    $ctl->write( "${b}::$k:\t$v\n" );
	}
    }
}

sub cmd_about {
    my $ctl = shift;
    my $param = shift;
    my( $b, $x, $k, $v );

    $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	if( $x->{i_am_top} && (!::topconf('_no_addtnl') || $param->{argusctl}) ){
	    # maybe dump some additional debugging info
	    $ctl->write( "__version_perl:\t" .
			 ( $^V ? join('.', unpack('c*', $^V)) : $] ) . "\n");
	    $ctl->write( "__version_argus:\t$::VERSION\n" );
	    $ctl->write( "__uptime:\t" . elapsed($^T - $::starttime) . " / " .
			 elapsed($^T - $::mainstart) . "\n" );
	    $ctl->write( "__osinfo:\t$::OSINFO\n" );
	    # ...
	}

	foreach $b ('', 'override', 'stats', 'web', 'notify', 'image', 'depend', 'bios', 'ovstatussummary'){
	    next unless !$b || $x->{$b};
	    foreach $k (sort ($b ? (keys %{$x->{$b}}) : (keys %$x))){
		$v = $b ? $x->{$b}{$k} : $x->{$k};
		next unless defined $v;
		if( ref($v) ){
		    $v = "#<REF>";
		}else{
		    # QQQ - or some other encoding scheme?
		    $v = encode( $v );
		}
		$ctl->write( $b ? "${b}::$k:\t$v\n" : "$k:\t$v\n" );
	    }
	}
	$x->about_more($ctl) if $x->can('about_more');
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_annotate {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	if( $param->{text} ){
	    $ctl->ok_n();
	    $x->{annotation} = $param->{text};
	    # splitting onto 2 lines looks nicer
	    $x->loggit( msg => "annotation: $param->{text}",
			tag => 'ANNOTATION',
			slp => 1 );
	    $x->loggit( msg => "annotation added by $param->{user} ",
			tag => 'ANNOTATION',
			slp => 1 );
	    $x->{web}{transtime} = $^T;
	}elsif( $x->{annotation} ){
	    # clear annotation
	    $ctl->ok_n();
	    delete $x->{annotation};
	    $x->{web}{transtime} = $^T;
	    $x->loggit( msg => "annotation cleared by $param->{user}",
			tag => 'ANNOTATION',
			slp => 1 );
	}else{
	    $ctl->bummer(404, 'No annotation');
	}
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

# spit out config data - in pretty config file format
sub cmd_getconf {
    my $ctl = shift;
    my $param = shift;
    my( $c );

    my $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	$c = $x->gen_conf(0);
	$c =~ s/^\s*(community|snmppass|snmpprivpass):.*\n//gm if ::topconf('_hide_comm');
	$c =~ s/^/-/gm;
	$ctl->write( $c );
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

# spit out config data - in 'key: value' form
sub cmd_getconfdata {
    my $ctl = shift;
    my $param = shift;
    my( $c );

    if( $param->{object} =~ /^snmpoid (.*)/ ){
        my $name = $1;
        my $snmp = Argus::SNMP::get_oid_conf($name);
        return $ctl->bummer(404, 'Object Not Found') unless $snmp;

	$ctl->ok();
        $ctl->write("type: snmpoid\nname: $name\n");
        for my $k (keys %$snmp){
            next if $k =~ /^_/;
            my $v = encode( $snmp->{$k} );
            $ctl->write("config::$k:\t$v\n");
        }
        $ctl->final();
        return;
    }

    my $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	$ctl->write("type:\t$x->{type}\n");
	$ctl->write("name:\t$x->{name}\n");
	$ctl->write("parent:\t". $x->{parents}[0]->unique() ."\n")
	    if $x->{parents} && $x->{parents}[0];

	foreach my $k (sort keys %{$x->{config}}){
	    my $v = $x->{config}{$k};
            $v = $v->get_config_data() if ref($v);	# schedules
	    next unless defined $v;
	    $v = encode($v);
	    $ctl->write("config::$k:\t$v\n");
	}

	if( $param->{andmore} ){
	    $ctl->write("::_uname:\t" . $x->unique() . "\n");
	    $ctl->write("definedattime:\t$x->{definedattime}\n");
	    if( $::HAVE_DARP && exists $ctl->{darpm} ){
		my $t = $ctl->{darpm}{slave}->{darpc}{tag};
		$ctl->write("::=status:\t" . $x->{darp}{statuses}{$t} . "\n");
		$ctl->write("::=severity:\t" . $x->{darp}{severities}{$t} . "\n");
	    }
	    # ...
	}

	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub getparam {
    my $me = shift;
    my $p  = shift;

    my @p = split /::/, $p;
    my $r = $me;
    foreach my $z (@p){
	if( $z =~ /^\d+$/ ){
	    die \ 'Param Not Found'
		unless ref($r) && defined( $r->[$z] );
	    $r = $r->[$z];
	}else{
	    die \ 'Param Not Found'
		unless ref($r) && exists( $r->{$z} );
	    $r = $r->{$z};
	}
    }
    return $r;
}

# NB: getparam and setparam are useful for debugging...
#     getparam is used by cgi to get various things...
sub cmd_getparam {
    my $ctl = shift;
    my $param = shift;
    my( $x, $p, $r );

    $x = $byname{ $param->{object} };

    if( $x ){
	$p = decode( $param->{param} );
	eval {
	    $r = getparam( $x, $p );
	};
	if( $@ ){
	    return $ctl->bummer(404, ${$@} );
        }
	$ctl->ok();
        $ctl->write( "param: $param->{param}\n" );
        $ctl->write( "object: $param->{object}\n" );
	$ctl->write( "value: " . encode($r) . "\n" );
        $ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

# setparam should be used with extreme caution, you can cause serious damage...
# perhaps it should be removed/disabled in non-development versions?
# hmmm, well for now, here is a gun, don't shoot your foot.
sub cmd_setparam {
    my $ctl = shift;
    my $param = shift;
    my( $x, $z, $fz, $r, $rfr, $p, $v, @p );

    $x = $byname{ $param->{object} };

    $v = decode( $param->{value} );
    if( $x ){
	$p = decode( $param->{param} );
	@p = split /::/, $p;
	$r = $x;
	$fz = pop @p;
	foreach $z (@p){
	    if( $z =~ /^\d+$/ ){
		return $ctl->bummer(404, 'Param Not Found')
		    # see comment above, Re: exists() in 5.00503
		    unless ref($r) && defined( $r->[$z] );
		$r = $r->[$z];
	    }else{
		return $ctl->bummer(404, 'Param Not Found')
		    unless ref($r) && exists( $r->{$z} );
		$r = $r->{$z};
	    }
	}
	return $ctl->bummer(404, 'Param Not Found')
	    unless ref($r);
	$r->{$fz} = $v;
	$ctl->ok_n();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub childrenparam {
    my $me  = shift;
    my $ctl = shift;
    my $p   = shift;
    my $all = shift;
    my( $r );

    eval {
	$r = $me->getparam($p);
	$ctl->write( $me->unique() . ": " . encode($r) . "\n" );
    };
    if( $@ ){
	$ctl->write( $me->unique() . ": #<${$@}>\n" ) if $all;
    }

    foreach my $c (@{$me->{children}}){
	$c->childrenparam($ctl, $p, $all);
    }
}

sub cmd_getchildrenparam {
    my $ctl = shift;
    my $param = shift;

    my $p = $param->{param};
    my $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	$x->childrenparam($ctl, $p, $param->{all});
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_getchildrenparamnr {
    my $ctl   = shift;
    my $param = shift;

    my $p = $param->{param};
    my $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	foreach my $c (@{$x->{children}}){
	    eval {
		my $r = $c->getparam($p);
		$ctl->write( $c->unique() . ": " . encode($r) . "\n" );
	    };
	}
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

# generate list of services for generating composite group graph
# see cmd_graphdata
sub graphlist {	# virtual function, overridden by S::
    my $me = shift;
    my( @c );

    return unless $me->{graph};

    foreach my $c (@{$me->{children}}){

	next if $c->{web}{hidden};
	my @x = $c->graphlist();

	foreach my $x (@x){
            my $pl = $c->{label_right} || $c->{label} || $c->{name};

            if( $x->{label} ){
                $x->{label} = "$pl:$x->{label}";
            }else{
                $x->{label} = $pl;
            }
	}
	push @c, @x;
    }

    return @c;
}

sub graph_height {
    my $g = shift;

    my $th = 10;
    my $tw = 0;
    foreach my $d (@$g){
	my $l = $d->{label};
	next unless $l;
	my $w = length($l) * 5 + 15;

	if( $tw + $w > 624 ){
	    $th += 10;
	    $tw = 0;
	}
	$tw += $w;
    }

    return if $th <= 64;

    $th + 128;
}

# spit out data used to generate graphs
sub cmd_graphdata {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    $x ||= Argus::Dashboard::Graph::find( $param->{object} );

    unless( $x ){
	$ctl->bummer(404, 'Object Not Found');
        return;
    }
    unless( $x->{graph} ){
        $ctl->bummer(404, 'Object Not Graphable');
        return;
    }

    $ctl->ok();
    my @g = $x->graphlist(); # [obj, file, label, tag]

    if( $param->{tag} ){
        @g = grep { $_->{tag} eq $param->{tag} } @g;
    }

    my $ht = graph_height(\@g);
    $ctl->write( "gr_height: $ht\n" ) if $ht;
    $ctl->write( "list: ".        join(' ', map {$_->{file}} @g) . "\n" );
    $ctl->write( "clabels: ".     join(' ', map {encode($_->{label})} @g) . "\n" );
    $ctl->write( "links: " .      join(' ', map {encode($_->{link})} @g) . "\n" );

    $ctl->write( "branding: ".    encode($x->{web}{header_branding}) . "\n");
    $ctl->write( "header: ".      encode("$x->{web}{header_all} $x->{web}{header}") . "\n");
    $ctl->write( "footer: ".      encode("<div class=footer>$x->{web}{footer} $x->{web}{footer_all}</div>" .
                                           "<div class=footerargus>$x->{web}{footer_argus}</div>") . "\n");
    $ctl->write( "refresh: ".     encode($x->{web}{refresh})  . "\n");
    $ctl->write( "bkgimg: ".      encode($x->{web}{bkgimage}) . "\n");
    $ctl->write( "style_sheet: ". encode($x->{web}{style_sheet}) . "\n");
    $ctl->write( "icon: ".        encode($x->{web}{icon}) . "\n");
    $ctl->write( "picasso: ".     encode(::topconf('picasso_prog')) . "\n")
      if ::topconf('picasso_prog');

    foreach my $k (keys %{$x->{image}} ){
        $ctl->write("$k:\t" . encode($x->{image}{$k}) ."\n" );
    }

    $ctl->final();

}

sub cmd_jiggle {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	$x->jiggle();
	$x->sort_children();
	$ctl->ok_n();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_sort {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	$x->sort_children();
	$ctl->ok_n();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_recycle {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	$x->loggit( msg => "Recycling Object",
		    tag => 'DELETE' ) unless $param->{quiet};
	if( $param->{cascade} || ! @{$x->{children}} ){
	    $x->stats_update_and_maybe_roll();
	    $x->stats_save();
	    my $mom = ($x->{parents} && $x->{parents}[0]) ? $x->{parents}[0] : undef;
	    $x->recycle($param->{cascade});

	    if( $mom && (!defined($param->{jiggle}) || $param->{jiggle}) ){
		$mom->jiggle();
	    }

	    $byname{Top}->{definedattime} = $^T;
	    $ctl->ok_n();
	}else{
	    $ctl->bummer(500, 'children present');
	}
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_add_object {
    my $ctl = shift;
    my $param = shift;

    my $obj;
    eval {
	my $cf = NullConf->new();

	$obj = create_object( $cf, $param );
	$obj->loggit( msg => "Created $param->{type} $obj->{name}",
		      tag => 'CREATE' ) unless $param->{quiet};
    };
    if( $@ ){
	my $msg = ref $@ ? $@->{error} : $@;
	$ctl->bummer(500, $msg);
    }else{
	$ctl->ok();
	$ctl->write('object: ' . $obj->unique() . "\n");
	$ctl->final();
    }
}

sub cmd_resolv_alii {
    my $ctl = shift;
    my $param = shift;

    my $obj;
    my $x = $byname{ $param->{object} };
    if( $x ){
	eval {
	    my $cf = NullConf->new();
	    $x->resolve_alii($cf);
	    $ctl->ok_n();
	};
	if($@){
	    my $msg = ref $@ ? $@->{error} : $@;
	    $ctl->bummer(500, $msg);
	}
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

################################################################

sub _svc_not_sched {

    my( %sc, @ns );

    # everything scheduled
    foreach my $t ( @BaseIO::bytime ){
	next unless $t;
	foreach my $x ( @{$t->{elem}} ){
	    next unless $x;
	    next if $x->{text} eq 'cron';
	    next unless $x->{obj}->can('unique');
	    $sc{ $x->{obj}->unique() } ++;
	}
    }
    foreach my $x (@all){
	next unless $x->isa('Service');
	next if exists $x->{compute};
	next if $x->{srvc}{state} && $x->{srvc}{state} ne 'done';	# running
	next if $sc{ $x->unique() };	# scheduled
        push @ns, $x;
    }

    return @ns;
}

{
    my $prev;
sub ::dbg_svc_not_sched {
    my $info = shift;

    return unless $::Top->{_debug_svnsch};
    my @ns = _svc_not_sched();
    return unless @ns;
    return if @ns == $prev;
    $prev = @ns;

    ::loggit("NOT SCHED [$info] @ns");
    exit; # XXX
}
}

# debugging...
sub cmd_svnotsched {
    my $ctl = shift;
    my $param = shift;

    $ctl->ok();
    my @ns = _svc_not_sched();
    my $n  = @ns;

    $ctl->write( $_->unique() . "\n" ) for @ns;
    $ctl->final();
}

sub cmd_summary {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	my $smy = $x->summary();
	$ctl->ok();
	$ctl->write( "status: $x->{ovstatus}\n" );
	foreach my $s ('up', 'down', 'override', 'total'){
	    $smy->{$s} ||= '0';
	    $ctl->write( "$s: $smy->{$s}\n" );
	}
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_check_now {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	$x->check_now();
	$ctl->ok_n();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_down_list {
    my $ctl = shift;
    my $param = shift;

    $ctl->ok();
    for my $o ( keys %isdown ){
	my $x = $byname{ $o };
	next if $param->{interesting} && ! $x->{interesting};
	$ctl->write("$o:\t$x->{ovstatus}\n");
    }
    $ctl->final();
}

################################################################

Control::command_install( 'list',     \&cmd_list,
			  "return all objects" );
Control::command_install( 'children', \&cmd_children,
			  "return all children of specified object", "object" );
Control::command_install( 'about',    \&cmd_about,
			  "return internal data fields of specified object", "object" );
Control::command_install( 'annotate', \&cmd_annotate,
			  "add an annotation to an object--this will show on the webpage",
			  "object user text" );
Control::command_install( 'getconf',  \&cmd_getconf,
			  "return the config data for an object", "object" );
Control::command_install( 'getconfigdata', \&cmd_getconfdata,
			  'return the config data for an object', "object" );
Control::command_install( 'getparam', \&cmd_getparam );
Control::command_install( 'setparam', \&cmd_setparam );
Control::command_install( 'getchildrenparam', \&cmd_getchildrenparam );
Control::command_install( 'getchildrenparamnr', \&cmd_getchildrenparamnr );
Control::command_install( 'add_object', \&cmd_add_object );
Control::command_install( 'recycle',  \&cmd_recycle );
Control::command_install( 'jiggle',   \&cmd_jiggle );
Control::command_install( 'sort',     \&cmd_sort );
Control::command_install( 'graphdata',\&cmd_graphdata,
			  'return graphing data', 'object');
Control::command_install( 'summary',  \&cmd_summary, 'how many up, how many down, ...', 'object');
Control::command_install( 'svnsch',   \&cmd_svnotsched );
Control::command_install( 'checknow', \&cmd_check_now, 'check now', 'object');
Control::command_install( 'resolv_alii', \&cmd_resolv_alii, 'object');
Control::command_install( 'downlist', \&cmd_down_list, 'interesting');


################################################################

Doc::register( $doc );

Cron->new( freq => 24*3600,
	   text => 'Monitor Element cleanup',
	   func => \&janitor,
	   );
1;
