import torrus 1.0.9

95 files changed, 33827 insertions, 0 deletions

diff --git a/torrus/perllib/Makefile.am b/torrus/perllib/Makefile.am
new file mode 100644
index 000000000..b1b691a63
--- /dev/null
+++ b/torrus/perllib/Makefile.am
@@ -0,0 +1,48 @@
+
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Makefile.am,v 1.1 2010-12-27 00:03:37 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+#
+
+
+install-data-local:
+	$(mkinstalldirs) $(DESTDIR)$(perllibdir)
+	find * -type d ! -name CVS -print >list.tmp
+	for d in `cat list.tmp`; do \
+	  $(mkinstalldirs) $(DESTDIR)$(perllibdir)/$$d; done
+	find * \( -name '*.pm' \) -type f -print >list.tmp
+	for f in `cat list.tmp`; do \
+	  $(INSTALL_DATA) $$f $(DESTDIR)$(perllibdir)/$$f; done
+	rm -f list.tmp
+
+
+uninstall-local:
+	find * -type d ! -name CVS -print >list.tmp
+	for d in `cat list.tmp`; do \
+	  rm -r $(DESTDIR)$(perllibdir)/$$d; done
+	rm -f list.tmp
+
+
+dist-hook:
+	find * -type d ! -name CVS -print >list.tmp
+	for d in `cat list.tmp`; do \
+	  mkdir $(distdir)/$$d; done
+	find * \( -name '*.pm' -o -name '*.txt' \) -type f -print >list.tmp
+	for f in `cat list.tmp`; do \
+	  cp $$f $(distdir)/$$f; done
+	rm -f list.tmp
diff --git a/torrus/perllib/Makefile.in b/torrus/perllib/Makefile.in
new file mode 100644
index 000000000..81714f45b
--- /dev/null
+++ b/torrus/perllib/Makefile.in
@@ -0,0 +1,366 @@
+# Makefile.in generated by automake 1.9.6 from Makefile.am.
+# @configure_input@
+
+# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
+# 2003, 2004, 2005  Free Software Foundation, Inc.
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Makefile.in,v 1.1 2010-12-27 00:03:37 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+#
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+pkgdatadir = $(datadir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+top_builddir = ..
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+INSTALL = @INSTALL@
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = $(program_transform_name)
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+build_triplet = @build@
+host_triplet = @host@
+subdir = perllib
+DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+am__aclocal_m4_deps = $(top_srcdir)/configure.ac
+am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
+	$(ACLOCAL_M4)
+mkinstalldirs = $(install_sh) -d
+CONFIG_CLEAN_FILES =
+SOURCES =
+DIST_SOURCES =
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+ACLOCAL = @ACLOCAL@
+AMTAR = @AMTAR@
+AUTOCONF = @AUTOCONF@
+AUTOHEADER = @AUTOHEADER@
+AUTOMAKE = @AUTOMAKE@
+AWK = @AWK@
+CYGPATH_W = @CYGPATH_W@
+DEFS = @DEFS@
+ECHO_C = @ECHO_C@
+ECHO_N = @ECHO_N@
+ECHO_T = @ECHO_T@
+FIND = @FIND@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+KILL = @KILL@
+LIBOBJS = @LIBOBJS@
+LIBS = @LIBS@
+LTLIBOBJS = @LTLIBOBJS@
+MAKEINFO = @MAKEINFO@
+PACKAGE = @PACKAGE@
+PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
+PACKAGE_NAME = @PACKAGE_NAME@
+PACKAGE_STRING = @PACKAGE_STRING@
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+PACKAGE_VERSION = @PACKAGE_VERSION@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+PERL = @PERL@
+PERLINC = @PERLINC@
+POD2MAN = @POD2MAN@
+POD2MAN_PRESENT_FALSE = @POD2MAN_PRESENT_FALSE@
+POD2MAN_PRESENT_TRUE = @POD2MAN_PRESENT_TRUE@
+POD2TEXT = @POD2TEXT@
+POD2TEXT_PRESENT_FALSE = @POD2TEXT_PRESENT_FALSE@
+POD2TEXT_PRESENT_TRUE = @POD2TEXT_PRESENT_TRUE@
+RM = @RM@
+SED = @SED@
+SET_MAKE = @SET_MAKE@
+SHELL = @SHELL@
+SLEEP = @SLEEP@
+STRIP = @STRIP@
+SU = @SU@
+VERSION = @VERSION@
+ac_ct_STRIP = @ac_ct_STRIP@
+am__leading_dot = @am__leading_dot@
+am__tar = @am__tar@
+am__untar = @am__untar@
+bindir = @bindir@
+build = @build@
+build_alias = @build_alias@
+build_cpu = @build_cpu@
+build_os = @build_os@
+build_vendor = @build_vendor@
+cachedir = @cachedir@
+cfgdefdir = @cfgdefdir@
+datadir = @datadir@
+dbhome = @dbhome@
+defrrddir = @defrrddir@
+distxmldir = @distxmldir@
+enable_pkgonly = @enable_pkgonly@
+enable_varperm = @enable_varperm@
+exec_prefix = @exec_prefix@
+exmpdir = @exmpdir@
+host = @host@
+host_alias = @host_alias@
+host_cpu = @host_cpu@
+host_os = @host_os@
+host_vendor = @host_vendor@
+includedir = @includedir@
+infodir = @infodir@
+install_sh = @install_sh@
+libdir = @libdir@
+libexecdir = @libexecdir@
+localstatedir = @localstatedir@
+logdir = @logdir@
+mandir = @mandir@
+mansec_misc = @mansec_misc@
+mansec_usercmd = @mansec_usercmd@
+mkdir_p = @mkdir_p@
+oldincludedir = @oldincludedir@
+perlithreads = @perlithreads@
+perllibdir = @perllibdir@
+perllibdirs = @perllibdirs@
+piddir = @piddir@
+pkgbindir = @pkgbindir@
+pkgdocdir = @pkgdocdir@
+pkghome = @pkghome@
+plugdevdisccfgdir = @plugdevdisccfgdir@
+pluginsdir = @pluginsdir@
+plugtorruscfgdir = @plugtorruscfgdir@
+plugwrapperdir = @plugwrapperdir@
+prefix = @prefix@
+program_transform_name = @program_transform_name@
+reportsdir = @reportsdir@
+sbindir = @sbindir@
+scriptsdir = @scriptsdir@
+seslockdir = @seslockdir@
+sesstordir = @sesstordir@
+sharedstatedir = @sharedstatedir@
+siteconfdir = @siteconfdir@
+sitedir = @sitedir@
+sitexmldir = @sitexmldir@
+supdir = @supdir@
+sysconfdir = @sysconfdir@
+target_alias = @target_alias@
+tmpldir = @tmpldir@
+tmpluserdir = @tmpluserdir@
+torrus_user = @torrus_user@
+var_group = @var_group@
+var_mode = @var_mode@
+var_user = @var_user@
+varprefix = @varprefix@
+webplaindir = @webplaindir@
+webscriptsdir = @webscriptsdir@
+wrapperdir = @wrapperdir@
+all: all-am
+
+.SUFFIXES:
+$(srcdir)/Makefile.in:  $(srcdir)/Makefile.am  $(am__configure_deps)
+	@for dep in $?; do \
+	  case '$(am__configure_deps)' in \
+	    *$$dep*) \
+	      cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \
+		&& exit 0; \
+	      exit 1;; \
+	  esac; \
+	done; \
+	echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu  perllib/Makefile'; \
+	cd $(top_srcdir) && \
+	  $(AUTOMAKE) --gnu  perllib/Makefile
+.PRECIOUS: Makefile
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+	@case '$?' in \
+	  *config.status*) \
+	    cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
+	  *) \
+	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
+	    cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
+	esac;
+
+$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+
+$(top_srcdir)/configure:  $(am__configure_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(ACLOCAL_M4):  $(am__aclocal_m4_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+uninstall-info-am:
+tags: TAGS
+TAGS:
+
+ctags: CTAGS
+CTAGS:
+
+
+distdir: $(DISTFILES)
+	@srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \
+	topsrcdirstrip=`echo "$(top_srcdir)" | sed 's|.|.|g'`; \
+	list='$(DISTFILES)'; for file in $$list; do \
+	  case $$file in \
+	    $(srcdir)/*) file=`echo "$$file" | sed "s|^$$srcdirstrip/||"`;; \
+	    $(top_srcdir)/*) file=`echo "$$file" | sed "s|^$$topsrcdirstrip/|$(top_builddir)/|"`;; \
+	  esac; \
+	  if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
+	  dir=`echo "$$file" | sed -e 's,/[^/]*$$,,'`; \
+	  if test "$$dir" != "$$file" && test "$$dir" != "."; then \
+	    dir="/$$dir"; \
+	    $(mkdir_p) "$(distdir)$$dir"; \
+	  else \
+	    dir=''; \
+	  fi; \
+	  if test -d $$d/$$file; then \
+	    if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
+	      cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \
+	    fi; \
+	    cp -pR $$d/$$file $(distdir)$$dir || exit 1; \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file \
+	    || exit 1; \
+	  fi; \
+	done
+	$(MAKE) $(AM_MAKEFLAGS) \
+	  top_distdir="$(top_distdir)" distdir="$(distdir)" \
+	  dist-hook
+check-am: all-am
+check: check-am
+all-am: Makefile
+installdirs:
+install: install-am
+install-exec: install-exec-am
+install-data: install-data-am
+uninstall: uninstall-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	  install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	  `test -z '$(STRIP)' || \
+	    echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
+
+maintainer-clean-generic:
+	@echo "This command is intended for maintainers to use"
+	@echo "it deletes files that may require special tools to rebuild."
+clean: clean-am
+
+clean-am: clean-generic mostlyclean-am
+
+distclean: distclean-am
+	-rm -f Makefile
+distclean-am: clean-am distclean-generic
+
+dvi: dvi-am
+
+dvi-am:
+
+html: html-am
+
+info: info-am
+
+info-am:
+
+install-data-am: install-data-local
+
+install-exec-am:
+
+install-info: install-info-am
+
+install-man:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-am
+	-rm -f Makefile
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-generic
+
+pdf: pdf-am
+
+pdf-am:
+
+ps: ps-am
+
+ps-am:
+
+uninstall-am: uninstall-info-am uninstall-local
+
+.PHONY: all all-am check check-am clean clean-generic dist-hook \
+	distclean distclean-generic distdir dvi dvi-am html html-am \
+	info info-am install install-am install-data install-data-am \
+	install-data-local install-exec install-exec-am install-info \
+	install-info-am install-man install-strip installcheck \
+	installcheck-am installdirs maintainer-clean \
+	maintainer-clean-generic mostlyclean mostlyclean-generic pdf \
+	pdf-am ps ps-am uninstall uninstall-am uninstall-info-am \
+	uninstall-local
+
+
+install-data-local:
+	$(mkinstalldirs) $(DESTDIR)$(perllibdir)
+	find * -type d ! -name CVS -print >list.tmp
+	for d in `cat list.tmp`; do \
+	  $(mkinstalldirs) $(DESTDIR)$(perllibdir)/$$d; done
+	find * \( -name '*.pm' \) -type f -print >list.tmp
+	for f in `cat list.tmp`; do \
+	  $(INSTALL_DATA) $$f $(DESTDIR)$(perllibdir)/$$f; done
+	rm -f list.tmp
+
+uninstall-local:
+	find * -type d ! -name CVS -print >list.tmp
+	for d in `cat list.tmp`; do \
+	  rm -r $(DESTDIR)$(perllibdir)/$$d; done
+	rm -f list.tmp
+
+dist-hook:
+	find * -type d ! -name CVS -print >list.tmp
+	for d in `cat list.tmp`; do \
+	  mkdir $(distdir)/$$d; done
+	find * \( -name '*.pm' -o -name '*.txt' \) -type f -print >list.tmp
+	for f in `cat list.tmp`; do \
+	  cp $$f $(distdir)/$$f; done
+	rm -f list.tmp
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/torrus/perllib/Torrus/ACL.pm b/torrus/perllib/Torrus/ACL.pm
new file mode 100644
index 000000000..53b9f618c
--- /dev/null
+++ b/torrus/perllib/Torrus/ACL.pm
@@ -0,0 +1,156 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ACL.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ACL;
+
+use Torrus::DB;
+use Torrus::Log;
+
+use strict;
+
+BEGIN
+{
+    eval( 'require ' . $Torrus::ACL::userAuthModule );
+    die( $@ ) if $@;
+}
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    eval( '$self->{"auth"} = new ' . $Torrus::ACL::userAuthModule );
+    die( $@ ) if $@;
+
+    my $writing = $options{'-WriteAccess'};
+
+    $self->{'db_users'} = new Torrus::DB('users', -WriteAccess => $writing );
+    defined( $self->{'db_users'} ) or return( undef );
+
+    $self->{'db_acl'} = new Torrus::DB('acl', -WriteAccess => $writing );
+    defined( $self->{'db_acl'} ) or return( undef );
+
+    $self->{'is_writing'} = $writing;
+
+    return $self;
+}
+
+
+sub DESTROY
+{
+    my $self = shift;
+
+    Debug('Destroying ACL object');
+
+    undef $self->{'db_users'};
+    undef $self->{'db_acl'};
+}
+
+
+sub hasPrivilege
+{
+    my $self = shift;
+    my $uid = shift;
+    my $object = shift;
+    my $privilege = shift;
+
+    foreach my $group ( $self->memberOf( $uid ) )
+    {
+        if( $self->{'db_acl'}->get( $group.':'.$object.':'.$privilege ) )
+        {
+            Debug('User ' . $uid . ' has privilege ' . $privilege .
+                  ' for ' . $object);
+            return 1;
+        }
+    }
+
+    if( $object ne '*' )
+    {
+        return $self->hasPrivilege( $uid, '*', $privilege );
+    }
+    
+    Debug('User ' . $uid . ' has NO privilege ' . $privilege .
+          ' for ' . $object);
+    return undef;
+}
+
+
+sub memberOf
+{
+    my $self = shift;
+    my $uid = shift;
+
+    my $glist = $self->{'db_users'}->get( 'gm:' . $uid );
+    return( defined( $glist ) ? split(',', $glist) : () );
+}
+
+
+sub authenticateUser
+{
+    my $self = shift;
+    my $uid = shift;
+    my $password = shift;
+
+    my @attrList = $self->{'auth'}->getUserAttrList();
+    my $attrValues = {};
+    foreach my $attr ( @attrList )
+    {
+        $attrValues->{$attr} = $self->userAttribute( $uid, $attr );
+    }
+
+    my $ret = $self->{'auth'}->authenticateUser( $uid, $password,
+                                                 $attrValues );
+    Debug('User authentication: uid=' . $uid . ', result=' .
+          ($ret ? 'true':'false'));
+    return $ret;
+}
+
+
+sub userAttribute
+{
+    my $self = shift;
+    my $uid = shift;
+    my $attr = shift;
+
+    return $self->{'db_users'}->get( 'ua:' . $uid . ':' . $attr );
+}
+
+
+sub groupAttribute
+{
+    my $self = shift;
+    my $group = shift;
+    my $attr = shift;
+
+    return $self->{'db_users'}->get( 'ga:' . $group . ':' . $attr );
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ACL/AuthLocalMD5.pm b/torrus/perllib/Torrus/ACL/AuthLocalMD5.pm
new file mode 100644
index 000000000..b1e6a1577
--- /dev/null
+++ b/torrus/perllib/Torrus/ACL/AuthLocalMD5.pm
@@ -0,0 +1,79 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: AuthLocalMD5.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ACL::AuthLocalMD5;
+
+use Torrus::Log;
+
+use Digest::MD5 qw(md5_hex);
+use strict;
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    bless $self, $class;
+    return $self;
+}
+
+
+sub getUserAttrList
+{
+    return qw(userPasswordMD5);
+}
+
+sub authenticateUser
+{
+    my $self = shift;
+    my $uid = shift;
+    my $password = shift;
+    my $attrValues = shift;
+
+    if( not $password or not $attrValues->{'userPasswordMD5'} )
+    {
+        return undef;
+    }
+    my $pw_md5 = md5_hex( $password );
+    return( $pw_md5 eq $attrValues->{'userPasswordMD5'} );
+}
+
+
+sub setPassword
+{
+    my $self = shift;
+    my $uid = shift;
+    my $password = shift;
+
+    my $attrValues = {};
+    $attrValues->{'userPasswordMD5'} = md5_hex( $password );
+    return $attrValues;
+}
+
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ACL/Edit.pm b/torrus/perllib/Torrus/ACL/Edit.pm
new file mode 100644
index 000000000..9966c9edd
--- /dev/null
+++ b/torrus/perllib/Torrus/ACL/Edit.pm
@@ -0,0 +1,627 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Edit.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ACL::Edit;
+
+use Torrus::ACL;
+use Torrus::Log;
+
+use strict;
+
+@Torrus::ACL::Edit::ISA = qw(Torrus::ACL);
+
+sub new
+{
+    my $proto = shift;
+    my %options = @_;
+    my $class = ref($proto) || $proto;
+    $options{'-WriteAccess'} = 1;
+    my $self  = $class->SUPER::new( %options );
+    bless $self, $class;
+    return $self;
+}
+
+
+sub addGroups
+{
+    my $self = shift;
+    my @groups = shift;
+
+    my $ok = 1;
+    foreach my $group ( @groups )
+    {
+        if( length( $group ) == 0 or $group =~ /\W/ )
+        {
+            Error('Invalid group name: ' . $group);
+            $ok = 0;
+        }
+        elsif( $self->groupExists( $group ) )
+        {
+            Error('Cannot add group ' . $group . ': the group already exists');
+            $ok = 0;
+        }
+        else
+        {
+            $self->{'db_users'}->addToList( 'G:', $group );
+            $self->setGroupModified( $group );
+            Info('Group added: ' . $group);
+        }
+    }
+    return $ok;
+}
+
+sub deleteGroups
+{
+    my $self = shift;
+    my @groups = shift;
+
+    my $ok = 1;
+    foreach my $group ( @groups )
+    {
+        if( $self->groupExists( $group ) )
+        {
+            my $members = $self->listGroupMembers( $group );
+            foreach my $uid ( @{$members} )
+            {
+                $self->{'db_users'}->delFromList( 'gm:' . $uid, $group );
+            }
+            $self->{'db_users'}->delFromList( 'G:', $group );
+
+            my $cursor = $self->{'db_acl'}->cursor( -Write => 1 );
+            while( my ($key, $val) = $self->{'db_acl'}->next( $cursor ) )
+            {
+                my( $dbgroup, $object, $privilege ) = split( ':', $key );
+                if( $dbgroup eq $group )
+                {
+                    $self->{'db_acl'}->c_del( $cursor );
+                }
+            }
+            undef $cursor;
+
+            Info('Group deleted: ' . $group);
+        }
+        else
+        {
+            Error('Cannot delete group ' . $group .
+                  ': the group does not exist');
+            $ok = 0;
+        }
+    }
+    return $ok;
+}
+
+sub groupExists
+{
+    my $self = shift;
+    my $group = shift;
+
+    return $self->{'db_users'}->searchList( 'G:', $group );
+}
+
+
+sub listGroups
+{
+    my $self = shift;
+
+    my $list = $self->{'db_users'}->get( 'G:' );
+
+    return split( ',', $list );
+}
+
+
+sub listGroupMembers
+{
+    my $self = shift;
+    my $group = shift;
+
+    my $members = [];
+
+    my $cursor = $self->{'db_users'}->cursor();
+    while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) )
+    {
+        my( $selector, $uid ) = split(':', $key);
+        if( $selector eq 'gm' )
+        {
+            if( defined($val) and length($val) > 0 and
+                grep {$group eq $_} split(',', $val) )
+            {
+                push( @{$members}, $uid );
+            }
+        }
+    }
+    undef $cursor;
+    return $members;
+}
+
+
+sub addUserToGroups
+{
+    my $self = shift;
+    my $uid = shift;
+    my @groups = @_;
+
+    my $ok = 1;
+    if( $self->userExists( $uid ) )
+    {
+        foreach my $group ( @groups )
+        {
+            if( $self->groupExists( $group ) )
+            {
+                if( not grep {$group eq $_} $self->memberOf( $uid ) )
+                {
+                    $self->{'db_users'}->addToList( 'gm:' . $uid, $group );
+                    $self->setGroupModified( $group );
+                    Info('Added ' . $uid . ' to group ' . $group);
+                }
+                else
+                {
+                    Error('Cannot add ' . $uid . ' to group ' . $group .
+                          ': user is already a member of this group');
+                    $ok = 0;
+                }
+            }
+            else
+            {
+                Error('Cannot add ' . $uid . ' to group ' . $group .
+                      ': group does not exist');
+                $ok = 0;
+            }
+        }
+    }
+    else
+    {
+        Error('Cannot add user ' . $uid .
+              'to groups: user does not exist');
+        $ok = 0;
+    }
+    return $ok;
+}
+
+
+sub delUserFromGroups
+{
+    my $self = shift;
+    my $uid = shift;
+    my @groups = shift;
+
+    my $ok = 1;
+    if( $self->userExists( $uid ) )
+    {
+        foreach my $group ( @groups )
+        {
+            if( $self->groupExists( $group ) )
+            {
+                if( grep {$group eq $_} $self->memberOf( $uid ) )
+                {
+                    $self->{'db_users'}->delFromList( 'gm:' . $uid, $group );
+                    $self->setGroupModified( $group );
+                    Info('Deleted ' . $uid . ' from group ' . $group);
+                }
+                else
+                {
+                    Error('Cannot delete ' . $uid . ' from group ' . $group .
+                          ': user is not a member of this group');
+                    $ok = 0;
+                }
+            }
+            else
+            {
+                Error('Cannot detete ' . $uid . ' from group ' . $group .
+                      ': group does not exist');
+                $ok = 0;
+            }
+        }
+    }
+    else
+    {
+        Error('Cannot delete user ' . $uid .
+              'from groups: user does not exist');
+        $ok = 0;
+    }
+    return $ok;
+}
+
+
+sub addUser
+{
+    my $self = shift;
+    my $uid = shift;
+    my $attrValues = shift;
+
+    my $ok = 1;
+    if( length( $uid ) == 0 or $uid =~ /\W/ )
+    {
+        Error('Invalid user ID: ' . $uid);
+        $ok = 0;
+    }
+    elsif( $self->userExists( $uid ) )
+    {
+        Error('Cannot add user ' . $uid . ': the user already exists');
+        $ok = 0;
+    }
+    else
+    {
+        $self->setUserAttribute( $uid, 'uid', $uid );
+        if( defined( $attrValues ) )
+        {
+            $self->setUserAttributes( $uid, $attrValues );
+        }
+        Info('User added: ' . $uid);
+    }
+    return $ok;
+}
+
+
+sub userExists
+{
+    my $self = shift;
+    my $uid = shift;
+
+    my $dbuid = $self->userAttribute( $uid, 'uid' );
+    return( defined( $dbuid ) and ( $dbuid eq $uid ) );
+}
+
+sub listUsers
+{
+    my $self = shift;
+
+    my @ret;
+
+    my $cursor = $self->{'db_users'}->cursor();
+    while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) )
+    {
+        my( $selector, $uid, $attr ) = split(':', $key);
+        if( $selector eq 'ua' and $attr eq 'uid' )
+        {
+            push( @ret, $uid );
+        }
+    }
+    undef $cursor;
+    return @ret;
+}
+
+sub setUserAttribute
+{
+    my $self = shift;
+    my $uid = shift;
+    my $attr = shift;
+    my $val = shift;
+
+    my $ok = 1;
+    if( length( $attr ) == 0 or $attr =~ /\W/ )
+    {
+        Error('Invalid attribute name: ' . $attr);
+        $ok = 0;
+    }
+    else
+    {
+        $self->{'db_users'}->put( 'ua:' . $uid . ':' . $attr, $val );
+        $self->{'db_users'}->addToList( 'uA:' . $uid, $attr );
+        if( $attr ne 'modified' )
+        {
+            $self->setUserModified( $uid );
+        }
+        Debug('Set ' . $attr . ' for ' . $uid . ': ' . $val);
+    }
+    return $ok;
+}
+
+
+sub delUserAttribute
+{
+    my $self = shift;
+    my $uid = shift;
+    my @attrs = @_;
+
+    foreach my $attr ( @attrs )
+    {
+        $self->{'db_users'}->del( 'ua:' . $uid . ':' . $attr );
+        $self->{'db_users'}->delFromList( 'uA:' . $uid, $attr );
+        $self->setUserModified( $uid );
+        Debug('Deleted ' . $attr . ' from ' . $uid);
+    }
+}
+
+
+sub setUserAttributes
+{
+    my $self = shift;
+    my $uid = shift;
+    my $attrValues = shift;
+
+    my $ok = 1;
+    
+    foreach my $attr ( keys %{$attrValues} )
+    {
+        $ok = $self->setUserAttribute( $uid, $attr, $attrValues->{$attr} )
+            ? $ok:0;
+    }
+    
+    return $ok;
+}
+
+
+sub setUserModified
+{
+    my $self = shift;
+    my $uid = shift;
+
+    $self->setUserAttribute( $uid, 'modified', scalar( localtime( time() ) ) );
+}
+
+sub listUserAttributes
+{
+    my $self = shift;
+    my $uid = shift;
+
+    my $list = $self->{'db_users'}->get( 'uA:' . $uid );
+
+    return split( ',', $list );
+}
+
+
+sub setPassword
+{
+    my $self = shift;
+    my $uid = shift;
+    my $password = shift;
+
+    my $ok = 1;
+    if( $self->userExists( $uid ) )
+    {
+        if( length( $password ) < $Torrus::ACL::minPasswordLength )
+        {
+            Error('Password too short: must be ' .
+                  $Torrus::ACL::minPasswordLength . ' characters long');
+            $ok = 0;
+        }
+        else
+        {
+            my $attrValues = $self->{'auth'}->setPassword( $uid, $password );
+            $self->setUserAttributes( $uid, $attrValues );
+            Info('Password set for ' . $uid);
+        }
+    }
+    else
+    {
+        Error('Cannot change password for user ' . $uid .
+              ': user does not exist');
+        $ok = 0;
+    }
+    return $ok;
+}
+
+
+sub deleteUser
+{
+    my $self = shift;
+    my $uid = shift;
+
+    my $ok = 1;
+    if( $self->userExists( $uid ) )
+    {
+        my $cursor = $self->{'db_users'}->cursor( -Write => 1 );
+        while( my ($key, $val) = $self->{'db_users'}->next( $cursor ) )
+        {
+            my( $selector, $dbuid ) = split(':', $key);
+            if( ( $selector eq 'gm' or $selector eq 'ua' ) and
+                $dbuid eq $uid )
+            {
+                $self->{'db_users'}->c_del( $cursor );
+            }
+        }
+        undef $cursor;
+
+        Info('User deleted: ' . $uid);
+    }
+    else
+    {
+        Error('Cannot delete user ' . $uid . ': user does not exist');
+        $ok = 0;
+    }
+    return $ok;
+}
+
+
+sub setGroupAttribute
+{
+    my $self = shift;
+    my $group = shift;
+    my $attr = shift;
+    my $val = shift;
+
+    my $ok = 1;
+    if( length( $attr ) == 0 or $attr =~ /\W/ )
+    {
+        Error('Invalid attribute name: ' . $attr);
+        $ok = 0;
+    }
+    else
+    {
+        $self->{'db_users'}->put( 'ga:' . $group . ':' . $attr, $val );
+        $self->{'db_users'}->addToList( 'gA:' . $group, $attr );
+        if( $attr ne 'modified' )
+        {
+            $self->setGroupModified( $group );
+        }
+        Debug('Set ' . $attr . ' for ' . $group . ': ' . $val);
+    }
+    return $ok;
+}
+
+
+sub listGroupAttributes
+{
+    my $self = shift;
+    my $group = shift;
+
+    my $list = $self->{'db_users'}->get( 'gA:' . $group );
+
+    return split( ',', $list );
+}
+
+
+
+sub setGroupModified
+{
+    my $self = shift;
+    my $group = shift;
+
+    $self->setGroupAttribute( $group, 'modified',
+                              scalar( localtime( time() ) ) );
+}
+
+
+sub setPrivilege
+{
+    my $self = shift;
+    my $group = shift;
+    my $object = shift;
+    my $privilege = shift;
+
+    my $ok = 1;
+    if( $self->groupExists( $group ) )
+    {
+        $self->{'db_acl'}->put( $group.':'.$object.':'.$privilege, 1 );
+        $self->setGroupModified( $group );
+        Info('Privilege ' . $privilege . ' for object ' . $object .
+             ' set for group ' . $group);
+    }
+    else
+    {
+        Error('Cannot set privilege for group ' . $group .
+              ': group does not exist');
+        $ok = 0;
+    }
+    return $ok;
+}
+
+
+sub clearPrivilege
+{
+    my $self = shift;
+    my $group = shift;
+    my $object = shift;
+    my $privilege = shift;
+
+    my $ok = 1;
+    if( $self->groupExists( $group ) )
+    {
+        my $key = $group.':'.$object.':'.$privilege;
+        if( $self->{'db_acl'}->get( $key ) )
+        {
+            $self->{'db_acl'}->del( $key );
+            $self->setGroupModified( $group );
+            Info('Privilege ' . $privilege . ' for object ' . $object .
+                 ' revoked from group ' . $group);
+        }
+    }
+    else
+    {
+        Error('Cannot revoke privilege from group ' . $group .
+              ': group does not exist');
+        $ok = 0;
+    }
+    return $ok;
+}
+
+
+sub listPrivileges
+{
+    my $self = shift;
+    my $group = shift;
+
+    my $ret = {};
+
+    my $cursor = $self->{'db_acl'}->cursor();
+    while( my ($key, $val) = $self->{'db_acl'}->next( $cursor ) )
+    {
+        my( $dbgroup, $object, $privilege ) = split( ':', $key );
+        if( $dbgroup eq $group )
+        {
+            $ret->{$object}{$privilege} = 1;
+        }
+    }
+    undef $cursor;
+
+    return $ret;
+}
+
+
+sub clearConfig
+{
+    my $self = shift;
+
+    $self->{'db_acl'}->trunc();
+    $self->{'db_users'}->trunc();
+
+    Info('Cleared the ACL configuration');
+    return 1;
+}
+
+sub exportACL
+{
+    my $self = shift;
+    my $exportfile = shift;
+    my $exporttemplate = shift;
+
+    my $ok;
+    eval 'require Torrus::ACL::Export;
+          $ok = Torrus::ACL::Export::exportACL( $self, $exportfile,
+                                              $exporttemplate );';
+    if( $@ )
+    {
+        Error($@);
+        return 0;
+    }
+    else
+    {
+        return $ok;
+    }
+}
+
+sub importACL
+{
+    my $self = shift;
+    my $importfile = shift;
+
+    my $ok;
+    eval 'require Torrus::ACL::Import;
+          $ok = Torrus::ACL::Import::importACL( $self, $importfile );';
+
+    if( $@ )
+    {
+        Error($@);
+        return 0;
+    }
+    else
+    {
+        return $ok;
+    }
+}
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ACL/Export.pm b/torrus/perllib/Torrus/ACL/Export.pm
new file mode 100644
index 000000000..a4c8c6a5a
--- /dev/null
+++ b/torrus/perllib/Torrus/ACL/Export.pm
@@ -0,0 +1,91 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Export.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ACL::Export;
+
+use Torrus::ACL;
+use Torrus::ACL::Edit;
+use Torrus::Log;
+
+use Template;
+
+use strict;
+
+
+sub exportACL
+{
+    my $self = shift;
+    my $exportfile = shift;
+    my $exporttemplate = shift;
+
+    my $tt = new Template(INCLUDE_PATH => $Torrus::Global::templateDirs,
+                          TRIM => 1);
+
+    my $vars = {
+        'groups'      => sub { return $self->listGroups(); },
+        'users'       => sub { return $self->listUsers(); },
+        'memberof'    => sub { return $self->memberOf($_[0]); },
+        'uattrlist'   => sub { return $self->listUserAttributes($_[0]); },
+        'uattr'       => sub { return $self->userAttribute($_[0], $_[1]); },
+        'gattrlist'   => sub { return $self->listGroupAttributes($_[0]); },
+        'gattr'       => sub { return $self->groupAttribute($_[0], $_[1]); },
+        'privileges'  => sub { return $self->listPrivileges($_[0]); },
+        'version'    => $Torrus::Global::version,
+        'xmlnorm'     => \&xmlnormalize
+        };
+
+    my $ok = $tt->process($exporttemplate, $vars, $exportfile);
+
+    if( not $ok )
+    {
+        print STDERR "Error while processing template: ".$tt->error()."\n";
+    }
+    else
+    {
+        Info('Wrote ' . $exportfile);
+    }
+
+    return $ok;
+}
+
+
+sub xmlnormalize
+{
+    my( $txt )= @_;
+
+    $txt =~ s/\&/\&amp\;/gm;
+    $txt =~ s/\</\&lt\;/gm;
+    $txt =~ s/\>/\&gt\;/gm;
+    $txt =~ s/\'/\&apos\;/gm;
+    $txt =~ s/\"/\&quot\;/gm;
+
+    return $txt;
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ACL/Import.pm b/torrus/perllib/Torrus/ACL/Import.pm
new file mode 100644
index 000000000..5c522cf6a
--- /dev/null
+++ b/torrus/perllib/Torrus/ACL/Import.pm
@@ -0,0 +1,157 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Import.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ACL::Import;
+
+use Torrus::ACL;
+use Torrus::ACL::Edit;
+use Torrus::Log;
+
+use XML::LibXML;
+use strict;
+
+my %formatsSupported = ('1.0' => 1,
+                        '1.1' => 1);
+
+sub importACL
+{
+    my $self = shift;
+    my $filename = shift;
+
+    my $ok = 1;
+    my $parser = new XML::LibXML;
+    my $doc;
+    eval { $doc = $parser->parse_file( $filename );  };
+    if( $@ )
+    {
+        Error("Failed to parse $filename: $@");
+        return 0;
+    }
+
+    my $root = $doc->documentElement();
+    if( $root->nodeName() ne 'aclexport' )
+    {
+        Error('XML root element is not "aclexport" in ' . $filename);
+        return 0;
+    }
+
+    my $format_version =
+        (($root->getElementsByTagName('file-info'))[0]->
+         getElementsByTagName('format-version'))[0]->textContent();
+    if( not $format_version or not $formatsSupported{$format_version} )
+    {
+        Error('Invalid format or format version not supported: ' . $filename);
+        return 0;
+    }
+
+    foreach my $groupnode ( ($root->getElementsByTagName('groups'))[0]->
+                            getElementsByTagName('group') )
+    {
+        my $group = $groupnode->getAttribute('name');
+        Debug('Importing group: ' . $group);
+        if( not $self->groupExists( $group ) )
+        {
+            $ok = $self->addGroups( $group ) ? $ok:0;
+        }
+        else
+        {
+            Debug('Group already exists: ' . $group);
+        }
+
+        foreach my $privnode ( $groupnode->getElementsByTagName('privilege') )
+        {
+            my $object = $privnode->getAttribute('object');
+            my $priv = $privnode->getAttribute('name');
+            Debug('Setting privilege ' . $priv . ' for ' . $object .
+                  ' to group ' . $group);
+            $ok = $self->setPrivilege( $group, $object, $priv ) ? $ok:0;
+        }
+
+        foreach my $attrnode ( $groupnode->getElementsByTagName('attribute') )
+        {
+            my $attr = $attrnode->getAttribute('name');
+            if( $attr ne 'modified' )
+            {
+                my $value = $attrnode->getAttribute('value');
+                Debug('Setting attribute ' . $attr . ' for group ' . $group .
+                      ' to ' . $value);
+                $ok = $self->setGroupAttribute( $group, $attr, $value )
+                    ? $ok:0;
+            }
+        }
+    }
+
+    foreach my $usernode ( ($root->getElementsByTagName('users'))[0]->
+                            getElementsByTagName('user') )
+    {
+        my $uid = $usernode->getAttribute('uid');
+        Debug('Importing user: ' . $uid);
+
+        if( not $self->userExists( $uid ) )
+        {
+            $ok = $self->addUser( $uid ) ? $ok:0;
+        }
+        else
+        {
+            Debug('User already exists: ' . $uid);
+        }
+
+        foreach my $membernode ( $usernode->getElementsByTagName('member-of') )
+        {
+            my $group = $membernode->getAttribute('group');
+            Debug('Adding ' . $uid . ' to group ' . $group);
+
+            if( not grep {$group eq $_} $self->memberOf( $uid ) )
+            {
+                $ok = $self->addUserToGroups( $uid, $group ) ? $ok:0;
+            }
+            else
+            {
+                Debug('User ' . $uid . ' is already in group ' . $group);
+            }
+        }
+
+        foreach my $attrnode ( $usernode->getElementsByTagName('attribute') )
+        {
+            my $attr = $attrnode->getAttribute('name');
+            if( $attr ne 'modified' )
+            {
+                my $value = $attrnode->getAttribute('value');
+                Debug('Setting attribute ' . $attr . ' for user ' . $uid .
+                      ' to ' . $value);
+                $ok = $self->setUserAttribute( $uid, $attr, $value ) ? $ok:0;
+            }
+        }
+    }
+    Debug('Import finished');
+    return $ok;
+}
+
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Apache2Handler.pm b/torrus/perllib/Torrus/Apache2Handler.pm
new file mode 100644
index 000000000..3c7544374
--- /dev/null
+++ b/torrus/perllib/Torrus/Apache2Handler.pm
@@ -0,0 +1,62 @@
+#  Copyright (C) 2010  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Apache2Handler.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Apache mod_perl handler. See http://perl.apache.org
+
+package Torrus::Apache2Handler;
+
+use strict;
+use Apache2::Const -compile => qw(:common);
+
+use Torrus::CGI;
+
+sub handler : method
+{
+    my($class, $r) = @_;
+
+    # Before torrus-1.0.9, Apache2 handler was designed
+    # for "SetHandler modperl". Now it should be used with perl-script
+    # handler only
+    
+    if( $r->handler() ne 'perl-script')
+    {
+        $r->content_type('text/plain');
+        $r->print("Apache configuration must be changed.\n");
+        $r->print("The current version ot Torrus is incompatible with ");
+        $r->print("\"SetHandler modperl\" statement.\n");
+        $r->print("Change it to:\n");
+        $r->print("  SetHandler perl-script\n");
+        return Apache2::Const::OK;
+    }
+    
+    my $q = CGI->new($r);
+    Torrus::CGI->process( $q );
+
+    return Apache2::Const::OK;    
+}
+
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ApacheHandler.pm b/torrus/perllib/Torrus/ApacheHandler.pm
new file mode 100644
index 000000000..a1335793c
--- /dev/null
+++ b/torrus/perllib/Torrus/ApacheHandler.pm
@@ -0,0 +1,46 @@
+#  Copyright (C) 2010  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ApacheHandler.pm,v 1.1 2010-12-27 00:03:38 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Apache mod_perl handler. See http://perl.apache.org
+
+package Torrus::ApacheHandler;
+
+use strict;
+use Apache;
+
+use Torrus::CGI;
+
+sub handler
+{
+    my $r = shift;
+
+    my $q = CGI->new($r);
+    Torrus::CGI->process( $q );
+    
+    return Apache::Constants::OK;    
+}
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/CGI.pm b/torrus/perllib/Torrus/CGI.pm
new file mode 100644
index 000000000..574e87252
--- /dev/null
+++ b/torrus/perllib/Torrus/CGI.pm
@@ -0,0 +1,423 @@
+#  Copyright (C) 2010  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CGI.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Universal CGI handler for Apache mod_perl and FastCGI
+
+package Torrus::CGI;
+
+use strict;
+use CGI;
+use IO::File;
+
+# This modue is not a part of mod_perl
+use Apache::Session::File;
+
+
+use Torrus::Log;
+use Torrus::Renderer;
+use Torrus::SiteConfig;
+use Torrus::ACL;
+
+## Torrus::CGI->process($q)
+## Expects a CGI object as input
+
+sub process
+{
+    my($class, $q) = @_;
+
+    my $path_info = $q->url(-path => 1);
+
+    # quickly give plaintext file contents
+    {
+        my $pos = index( $path_info, $Torrus::Renderer::plainURL );
+        if( $pos >= 0 )
+        {
+            my $fname = $Torrus::Global::webPlainDir . '/' .
+                substr( $path_info,
+                        $pos + length($Torrus::Renderer::plainURL) );
+
+            my $ok = 0;
+
+            my $type;
+            if( $path_info =~ /\.css$/o )
+            {
+                $type = 'text/css';
+            }
+            else
+            {
+                $type = 'text/html';
+            }
+            
+            if( -r $fname )
+            {
+                my $fh = new IO::File( $fname );
+                if( defined( $fh ) )
+                {
+                    print $q->header('-type' => $type,
+                                     '-expires' => '+1h');
+                    
+                    $fh->binmode(':raw');
+                    my $buffer;           
+                    while( $fh->read( $buffer, 65536 ) )
+                    {
+                        print( $buffer );
+                    }
+                    $fh->close();
+                    $ok = 1;
+                }
+            }
+
+            if( not $ok )
+            {
+                print $q->header(-status=>400),
+                $q->start_html('Error'),
+                $q->h2('Error'),
+                $q->strong('Cannot retrieve file: ' . $fname);
+            }
+            
+            return;
+        }
+    }
+    
+    my @paramNames = $q->param();
+
+    if( $q->param('DEBUG') and not $Torrus::Renderer::globalDebug ) 
+    {
+        &Torrus::Log::setLevel('debug');
+    }
+
+    my %options = ();
+    foreach my $name ( @paramNames )
+    {
+        if( $name =~ /^[A-Z]/ and $name ne 'SESSION_ID' )
+        {
+            $options{'variables'}->{$name} = $q->param($name);
+        }
+    }
+
+    my( $fname, $mimetype, $expires );
+    my @cookies;
+
+    my $renderer = new Torrus::Renderer();
+    if( not defined( $renderer ) )
+    {
+        return report_error($q, 'Error initializing Renderer');
+    }
+
+    my $tree = $path_info;
+    $tree =~ s/^.*\/(.*)$/$1/;
+
+    if( $Torrus::CGI::authorizeUsers )
+    {
+        $options{'acl'} = new Torrus::ACL;
+        
+        my $hostauth = $q->param('hostauth');
+        if( defined( $hostauth ) )
+        {
+            my $uid = $q->remote_addr();
+            $uid =~ s/\W/_/go;
+            my $password = $uid . '//' . $hostauth;
+
+            Debug('Host-based authentication for ' . $uid);
+            
+            if( not $options{'acl'}->authenticateUser( $uid, $password ) )
+            {
+                print $q->header(-status=>'403 Forbidden',
+                                 '-type' => 'text/plain');
+                print('Host-based authentication failed for ' . $uid);
+                Info('Host-based authentication failed for ' . $uid);
+                return;
+            }
+            
+            Info('Host authenticated: ' . $uid);
+            $options{'uid'} = $uid;
+        }
+        else
+        {
+            
+            my $ses_id = $q->cookie('SESSION_ID');
+
+            my $needs_new_session = 1;
+            my %session;
+
+            if( $ses_id )
+            {
+                # create a session object based on the cookie we got from the
+                # browser, or a new session if we got no cookie
+                eval
+                {
+                    tie %session, 'Apache::Session::File', $ses_id, {
+                        Directory     => $Torrus::Global::sesStoreDir,
+                        LockDirectory => $Torrus::Global::sesLockDir }
+                };
+                if( not $@ )
+                {
+                    if( $options{'variables'}->{'LOGOUT'} )
+                    {
+                        tied( %session )->delete();
+                    }
+                    else
+                    {
+                        $needs_new_session = 0;
+                    }
+                }
+            }
+
+            if( $needs_new_session )
+            {
+                tie %session, 'Apache::Session::File', undef, {
+                    Directory     => $Torrus::Global::sesStoreDir,
+                    LockDirectory => $Torrus::Global::sesLockDir };
+            }
+
+            # might be a new session, so lets give them their cookie back
+
+            my %cookie = (-name  => 'SESSION_ID',
+                          -value => $session{'_session_id'});
+            
+            if( $session{'uid'} )
+            {
+                $options{'uid'} = $session{'uid'};
+                if( $session{'remember_login'} )
+                {
+                    $cookie{'-expires'} = '+60d';
+                }
+            }
+            else
+            {
+                my $needsLogin = 1;
+
+                # POST form parameters
+
+                my $uid = $q->param('uid');
+                my $password = $q->param('password');
+                if( defined( $uid ) and defined( $password ) )
+                {
+                    if( $options{'acl'}->authenticateUser( $uid, $password ) )
+                    {
+                        $session{'uid'} = $options{'uid'} = $uid;
+                        $needsLogin = 0;
+                        Info('User logged in: ' . $uid);
+                        
+                        if( $q->param('remember') )
+                        {
+                            $cookie{'-expires'} = '+60d';
+                            $session{'remember_login'} = 1;
+                        }
+                    }
+                    else
+                    {
+                        $options{'authFailed'} = 1;
+                    }
+                }
+
+                if( $needsLogin )
+                {
+                    $options{'urlPassTree'} = $tree;
+                    foreach my $param ( 'token', 'path', 'nodeid',
+                                        'view', 'v' )
+                    {
+                        my $val = $q->param( $param );
+                        if( defined( $val ) and length( $val ) > 0 )
+                        {
+                            $options{'urlPassParams'}{$param} = $val;
+                        }
+                    }
+                    
+                    ( $fname, $mimetype, $expires ) =
+                        $renderer->renderUserLogin( %options );
+                    
+                    die('renderUserLogin returned undef') unless $fname;
+                }
+            }
+            untie %session;
+            
+            push(@cookies, $q->cookie(%cookie));
+        }
+    }
+
+    if( not $fname )
+    {
+        if( not $tree or not Torrus::SiteConfig::treeExists( $tree ) )
+        {
+            ( $fname, $mimetype, $expires ) =
+                $renderer->renderTreeChooser( %options );
+        }
+        else
+        {
+            if( $Torrus::CGI::authorizeUsers and
+                not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree,
+                                                   'DisplayTree' ) )
+            {
+                return report_error($q, 'Permission denied');
+            }
+            
+            if( $Torrus::Renderer::displayReports and
+                defined( $q->param('htmlreport') ) )
+            {
+                if( $Torrus::CGI::authorizeUsers and
+                    not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree,
+                                                       'DisplayReports' ) )
+                {
+                    return report_error($q, 'Permission denied');
+                }
+
+                my $reportfname = $q->param('htmlreport');
+                # strip off leading slashes for security
+                $reportfname =~ s/^.*\///o;
+                
+                $fname = $Torrus::Global::reportsDir . '/' . $tree .
+                    '/html/' . $reportfname;
+                if( not -f $fname )
+                {
+                    return report_error($q, 'No such file: ' . $reportfname);
+                }
+                
+                $mimetype = 'text/html';
+                $expires = '3600';
+            }
+            else
+            {
+                my $config_tree = new Torrus::ConfigTree( -TreeName => $tree );
+                if( not defined($config_tree) )
+                {
+                    return report_error($q, 'Configuration is not ready');
+                }
+                
+                my $token = $q->param('token');
+                if( not defined($token) )
+                {
+                    my $path = $q->param('path');
+                    if( not defined($path) )
+                    {
+                        my $nodeid = $q->param('nodeid');
+                        if( defined($nodeid) )
+                        {
+                            $token = $config_tree->getNodeByNodeid( $nodeid );
+                            if( not defined($token) )
+                            {
+                                return report_error
+                                    ($q, 'Cannot find nodeid:' . $nodeid);
+                            }
+                        }
+                        else
+                        {
+                            $token = $config_tree->token('/');
+                        }
+                    }
+                    else
+                    {
+                        $token = $config_tree->token($path);
+                        if( not defined($token) )
+                        {
+                            return report_error($q, 'Invalid path');
+                        }
+                    }
+                }
+                elsif( $token !~ /^S/ and
+                       not defined( $config_tree->path( $token ) ) )
+                {
+                    return report_error($q, 'Invalid token');
+                }
+                
+                my $view = $q->param('view');
+                if( not defined($view) )
+                {
+                    $view = $q->param('v');
+                }
+
+                ( $fname, $mimetype, $expires ) =
+                    $renderer->render( $config_tree, $token, $view, %options );
+                
+                undef $config_tree;
+            }
+        }
+    }
+
+    undef $renderer;
+    &Torrus::DB::cleanupEnvironment();
+
+    if( defined( $options{'acl'} ) )
+    {
+        undef $options{'acl'};
+    }
+
+    if( defined($fname) )
+    {
+        if( not -e $fname )
+        {
+            return report_error($q, 'No such file or directory: ' . $fname);
+        }
+        
+        Debug("Render returned $fname $mimetype $expires");
+
+        my $fh = new IO::File( $fname );
+        if( defined( $fh ) )
+        {
+            print $q->header('-type' => $mimetype,
+                             '-expires' => '+'.$expires.'s',
+                             '-cookie' => \@cookies);
+            
+            $fh->binmode(':raw');
+            my $buffer;           
+            while( $fh->read( $buffer, 65536 ) )
+            {
+                print( $buffer );
+            }
+            $fh->close();
+        }
+        else
+        {
+            return report_error($q, 'Cannot open file ' . $fname . ': ' . $!);
+        }
+    }
+    else
+    {
+        return report_error($q, "Renderer returned error.\n" .
+                            "Probably wrong directory permissions or " .
+                            "directory missing:\n" .
+                            $Torrus::Global::cacheDir);            
+    }
+    
+    if( not $Torrus::Renderer::globalDebug )
+    {
+        &Torrus::Log::setLevel('info');
+    }
+}
+
+
+sub report_error
+{
+    my $q = shift;
+    my $msg = shift;
+
+    print $q->header('-type' => 'text/plain',
+                     '-expires' => 'now');
+
+    print('Error: ' . $msg);
+}
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Collector.pm b/torrus/perllib/Torrus/Collector.pm
new file mode 100644
index 000000000..0789be05f
--- /dev/null
+++ b/torrus/perllib/Torrus/Collector.pm
@@ -0,0 +1,695 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Collector.pm,v 1.1 2010-12-27 00:03:38 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::Collector;
+@Torrus::Collector::ISA = qw(Torrus::Scheduler::PeriodicTask);
+
+use strict;
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::RPN;
+use Torrus::Scheduler;
+
+BEGIN
+{
+    foreach my $mod ( @Torrus::Collector::loadModules )
+    {
+        eval( 'require ' . $mod );
+        die( $@ ) if $@;
+    }
+}
+
+# Executed once after the fork. Here modules can launch processing threads
+sub initThreads
+{
+    foreach my $key ( %Torrus::Collector::initThreadsHandlers )
+    {
+        if( ref( $Torrus::Collector::initThreadsHandlers{$key} ) )
+        {
+            &{$Torrus::Collector::initThreadsHandlers{$key}}();
+        }
+    }
+}
+
+
+## One collector module instance holds all leaf tokens which
+## must be collected at the same time.
+
+sub new
+{
+    my $proto = shift;
+    my %options = @_;
+
+    if( not $options{'-Name'} )
+    {
+        $options{'-Name'} = "Collector";
+    }
+
+    my $class = ref($proto) || $proto;
+    my $self  = $class->SUPER::new( %options );
+    bless $self, $class;
+
+    foreach my $collector_type ( keys %Torrus::Collector::collectorTypes )
+    {
+        $self->{'types'}{$collector_type} = {};
+        $self->{'types_in_use'}{$collector_type} = 0;
+    }
+
+    foreach my $storage_type ( keys %Torrus::Collector::storageTypes )
+    {
+        $self->{'storage'}{$storage_type} = {};
+        $self->{'storage_in_use'}{$storage_type} = 0;
+        
+        my $storage_string = $storage_type . '-storage';
+        if( ref( $Torrus::Collector::initStorage{$storage_string} ) )
+        {
+            &{$Torrus::Collector::initStorage{$storage_string}}($self);
+        }
+    }
+
+    $self->{'tree_name'} = $options{'-TreeName'};
+    
+    return $self;
+}
+
+
+sub addTarget
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+
+    my $ok = 1;
+    $self->{'targets'}{$token}{'path'} = $config_tree->path($token);
+
+    my $collector_type = $config_tree->getNodeParam($token, 'collector-type');
+    if( not $Torrus::Collector::collectorTypes{$collector_type} )
+    {
+        Error('Unknown collector type: ' . $collector_type);
+        return;
+    }
+
+    $self->fetchParams($config_tree, $token, $collector_type);
+
+    $self->{'targets'}{$token}{'type'} = $collector_type;
+    $self->{'types_in_use'}{$collector_type} = 1;
+    
+    my $storage_types = $config_tree->getNodeParam($token, 'storage-type');
+    foreach my $storage_type ( split( ',', $storage_types ) )
+    {
+        if( not $Torrus::Collector::storageTypes{$storage_type} )
+        {
+            Error('Unknown storage type: ' . $storage_type);
+        }
+        else
+        {
+            my $storage_string = $storage_type . '-storage';
+            if( not exists( $self->{'targets'}{$token}{'storage-types'} ) )
+            {
+                $self->{'targets'}{$token}{'storage-types'} = [];
+            }
+            push( @{$self->{'targets'}{$token}{'storage-types'}},
+                  $storage_type );
+            
+            $self->fetchParams($config_tree, $token, $storage_string);
+            $self->{'storage_in_use'}{$storage_type} = 1;
+        }
+    }
+
+    # If specified, store the value transformation code
+    my $code = $config_tree->getNodeParam($token, 'transform-value');
+    if( defined $code )
+    {
+        $self->{'targets'}{$token}{'transform'} = $code;
+    }
+    
+    # If specified, store the scale RPN
+    my $scalerpn = $config_tree->getNodeParam($token, 'collector-scale');
+    if( defined $scalerpn )
+    {
+        $self->{'targets'}{$token}{'scalerpn'} = $scalerpn;
+    }
+    
+    # If specified, store the value map
+    my $valueMap = $config_tree->getNodeParam($token, 'value-map');
+    if( defined $valueMap and length($valueMap) > 0 )
+    {
+        my $map = {};
+        foreach my $item ( split( ',', $valueMap ) )
+        {
+            my ($key, $value) = split( ':', $item );
+            $map->{$key} = $value;
+        }
+        $self->{'targets'}{$token}{'value-map'} = $map;
+    }
+
+    # Initialize local token, collectpor, and storage data
+    if( not defined $self->{'targets'}{$token}{'local'} )
+    {
+        $self->{'targets'}{$token}{'local'} = {};
+    }
+
+    if( ref( $Torrus::Collector::initTarget{$collector_type} ) )
+    {
+        $ok = &{$Torrus::Collector::initTarget{$collector_type}}($self,
+                                                                 $token);
+    }
+
+    if( $ok )
+    {
+        foreach my $storage_type
+            ( @{$self->{'targets'}{$token}{'storage-types'}} )
+        {
+            my $storage_string = $storage_type . '-storage';
+            if( ref( $Torrus::Collector::initTarget{$storage_string} ) )
+            {
+                &{$Torrus::Collector::initTarget{$storage_string}}($self,
+                                                                   $token);
+            }
+        }
+    }
+    
+    if( not $ok )
+    {
+        $self->deleteTarget( $token );
+    }
+}
+
+
+sub fetchParams
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $type = shift;
+
+    if( not defined( $Torrus::Collector::params{$type} ) )
+    {
+        Error("\%Torrus::Collector::params does not have member $type");
+        return;
+    }
+
+    my $ref = \$self->{'targets'}{$token}{'params'};
+
+    my @maps = ( $Torrus::Collector::params{$type} );
+
+    while( scalar( @maps ) > 0 )
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        my @next_maps = ();
+        foreach my $map ( @maps )
+        {
+            foreach my $param ( keys %{$map} )
+            {
+                my $value = $config_tree->getNodeParam( $token, $param );
+
+                if( ref( $map->{$param} ) )
+                {
+                    if( defined $value )
+                    {
+                        if( exists $map->{$param}->{$value} )
+                        {
+                            if( defined $map->{$param}->{$value} )
+                            {
+                                push( @next_maps,
+                                      $map->{$param}->{$value} );
+                            }
+                        }
+                        else
+                        {
+                            Error("Parameter $param has unknown value: " .
+                                  $value . " in " . $self->path($token));
+                        }
+                    }
+                }
+                else
+                {
+                    if( not defined $value )
+                    {
+                        # We know the default value
+                        $value = $map->{$param};
+                    }
+                }
+                # Finally store the value
+                if( defined $value )
+                {
+                    $$ref->{$param} = $value;
+                }
+            }
+        }
+        @maps = @next_maps;
+    }
+}
+
+
+sub fetchMoreParams
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my @params = @_;
+
+    &Torrus::DB::checkInterrupted();
+
+    my $ref = \$self->{'targets'}{$token}{'params'};
+
+    foreach my $param ( @params )
+    {
+        my $value = $config_tree->getNodeParam( $token, $param );
+        if( defined $value )
+        {
+            $$ref->{$param} = $value;
+        }
+    }
+}
+
+
+sub param
+{
+    my $self = shift;
+    my $token = shift;
+    my $param = shift;
+
+    return $self->{'targets'}{$token}{'params'}{$param};
+}
+
+sub setParam
+{
+    my $self = shift;
+    my $token = shift;
+    my $param = shift;
+    my $value = shift;
+
+    $self->{'targets'}{$token}{'params'}{$param} = $value;
+}
+
+
+sub path
+{
+    my $self = shift;
+    my $token = shift;
+
+    return $self->{'targets'}{$token}{'path'};
+}
+
+sub listCollectorTargets
+{
+    my $self = shift;
+    my $collector_type = shift;
+
+    my @ret;
+    foreach my $token ( keys %{$self->{'targets'}} )
+    {
+        if( $self->{'targets'}{$token}{'type'} eq $collector_type )
+        {
+            push( @ret, $token );
+        }
+    }
+    return @ret;
+}
+
+# A callback procedure that will be executed on deleteTarget()
+
+sub registerDeleteCallback
+{
+    my $self = shift;
+    my $token = shift;
+    my $proc = shift;
+
+    if( not ref( $self->{'targets'}{$token}{'deleteProc'} ) )
+    {
+        $self->{'targets'}{$token}{'deleteProc'} = [];
+    }
+    push( @{$self->{'targets'}{$token}{'deleteProc'}}, $proc );
+}
+
+sub deleteTarget
+{
+    my $self = shift;
+    my $token = shift;
+
+    &Torrus::DB::checkInterrupted();
+
+    Info('Deleting target: ' . $self->path($token));
+    
+    if( ref( $self->{'targets'}{$token}{'deleteProc'} ) )
+    {
+        foreach my $proc ( @{$self->{'targets'}{$token}{'deleteProc'}} )
+        {
+            &{$proc}( $self, $token );
+        }
+    }
+    delete $self->{'targets'}{$token};
+}
+
+# Returns a reference to token-specific local data
+
+sub tokenData
+{
+    my $self = shift;
+    my $token = shift;
+
+    return $self->{'targets'}{$token}{'local'};
+}
+
+# Returns a reference to collector type-specific local data
+
+sub collectorData
+{
+    my $self = shift;
+    my $type = shift;
+
+    return $self->{'types'}{$type};
+}
+
+# Returns a reference to storage type-specific local data
+
+sub storageData
+{
+    my $self = shift;
+    my $type = shift;
+
+    return $self->{'storage'}{$type};
+}
+
+
+# Runs each collector type, and then stores the values
+sub run
+{
+    my $self = shift;
+
+    undef $self->{'values'};
+
+    while( my ($collector_type, $ref) = each %{$self->{'types'}} )
+    {
+        next unless $self->{'types_in_use'}{$collector_type};
+
+        &Torrus::DB::checkInterrupted();
+        
+        if( $Torrus::Collector::needsConfigTree
+            {$collector_type}{'runCollector'} )
+        {
+            $self->{'config_tree'} =
+                new Torrus::ConfigTree( -TreeName => $self->{'tree_name'},
+                                        -Wait => 1 );
+        }
+        
+        &{$Torrus::Collector::runCollector{$collector_type}}( $self, $ref );
+        
+        if( defined( $self->{'config_tree'} ) )
+        {
+            undef $self->{'config_tree'};
+        }
+    }
+
+    while( my ($storage_type, $ref) = each %{$self->{'storage'}} )
+    {
+        next unless $self->{'storage_in_use'}{$storage_type};
+        
+        &Torrus::DB::checkInterrupted();
+        
+        if( $Torrus::Collector::needsConfigTree
+            {$storage_type}{'storeData'} )
+        {
+            $self->{'config_tree'} =
+                new Torrus::ConfigTree( -TreeName => $self->{'tree_name'},
+                                        -Wait => 1 );
+        }
+
+        &{$Torrus::Collector::storeData{$storage_type}}( $self, $ref );
+
+        if( defined( $self->{'config_tree'} ) )
+        {
+            undef $self->{'config_tree'};
+        }        
+    }
+    
+    while( my ($collector_type, $ref) = each %{$self->{'types'}} )
+    {
+        next unless $self->{'types_in_use'}{$collector_type};
+        
+        if( ref( $Torrus::Collector::postProcess{$collector_type} ) )
+        {
+            &Torrus::DB::checkInterrupted();
+            
+            if( $Torrus::Collector::needsConfigTree
+                {$collector_type}{'postProcess'} )
+            {
+                $self->{'config_tree'} =
+                    new Torrus::ConfigTree( -TreeName => $self->{'tree_name'},
+                                            -Wait => 1 );
+            }
+            
+            &{$Torrus::Collector::postProcess{$collector_type}}( $self, $ref );
+
+            if( defined( $self->{'config_tree'} ) )
+            {
+                undef $self->{'config_tree'};
+            }
+        }
+    }
+}
+
+
+# This procedure is called by the collector type-specific functions
+# every time there's a new value for a token
+sub setValue
+{
+    my $self = shift;
+    my $token = shift;
+    my $value = shift;
+    my $timestamp = shift;
+    my $uptime = shift;
+
+    if( $value ne 'U' )
+    {
+        if( defined( my $code = $self->{'targets'}{$token}{'transform'} ) )
+        {            
+            # Screen out the percent sign and $_
+            $code =~ s/DOLLAR/\$/gm;
+            $code =~ s/MOD/\%/gm;
+            Debug('Value before transformation: ' . $value);
+            $_ = $value;
+            $value = do { eval $code };
+            if( $@ )
+            {
+                Error('Fatal error in transformation code: ' . $@ );
+                $value = 'U';
+            }
+            elsif( $value !~ /^[0-9.+-eE]+$/o and $value ne 'U' )
+            {
+                Error('Non-numeric value after transformation: ' . $value);
+                $value = 'U';
+            }
+        }
+        elsif( defined( my $map = $self->{'targets'}{$token}{'value-map'} ) )
+        {
+            my $newValue;
+            if( defined( $map->{$value} ) )
+            {
+                $newValue = $map->{$value};
+            }
+            elsif( defined( $map->{'_'} ) )
+            {
+                $newValue = $map->{'_'};
+            }
+            else
+            {
+                Warn('Could not find value mapping for ' . $value .
+                     'in ' . $self->path($token));
+            }
+
+            if( defined( $newValue ) )
+            {
+                Debug('Value mapping: ' . $value . ' -> ' . $newValue);
+                $value = $newValue;
+            }
+        }
+
+        if( defined( $self->{'targets'}{$token}{'scalerpn'} ) )
+        {
+            Debug('Value before scaling: ' . $value);
+            my $rpn = new Torrus::RPN;
+            $value = $rpn->run( $value . ',' .
+                                $self->{'targets'}{$token}{'scalerpn'},
+                                sub{} );
+        }
+    }
+
+    if( isDebug() )
+    {
+        Debug('Value ' . $value . ' set for ' .
+              $self->path($token) . ' TS=' . $timestamp);
+    }
+
+    foreach my $storage_type
+        ( @{$self->{'targets'}{$token}{'storage-types'}} )
+    {
+        &{$Torrus::Collector::setValue{$storage_type}}( $self, $token,
+                                                        $value, $timestamp,
+                                                        $uptime );
+    }
+}
+
+
+sub configTree
+{
+    my $self = shift;
+
+    if( defined( $self->{'config_tree'} ) )
+    {
+        return $self->{'config_tree'};
+    }
+    else
+    {
+        Error('Cannot provide ConfigTree object');
+        return undef;
+    }
+}
+
+
+#######  Collector scheduler  ########
+
+package Torrus::CollectorScheduler;
+@Torrus::CollectorScheduler::ISA = qw(Torrus::Scheduler);
+
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::Scheduler;
+use Torrus::TimeStamp;
+
+
+sub beforeRun
+{
+    my $self = shift;
+
+    &Torrus::DB::checkInterrupted();
+
+    my $tree = $self->treeName();
+    my $config_tree = new Torrus::ConfigTree(-TreeName => $tree, -Wait => 1);
+    if( not defined( $config_tree ) )
+    {
+        return undef;
+    }
+
+    my $data = $self->data();
+
+    my $instance = $self->{'options'}{'-Instance'};
+        
+    # Prepare the list of tokens, sorted by period and offset,
+    # from config tree or from cache.
+
+    my $need_new_tasks = 0;
+
+    Torrus::TimeStamp::init();
+    my $timestamp_key = $tree . ':' . $instance . ':collector_cache';
+    my $known_ts = Torrus::TimeStamp::get( $timestamp_key );
+    my $actual_ts = $config_tree->getTimestamp();
+    
+    if( $actual_ts >= $known_ts or not $data->{'targets_initialized'} )
+    {
+        Info('Initializing tasks for collector instance ' . $instance);
+        Debug("Config TS: $actual_ts, Collector TS: $known_ts");
+        my $init_start = time();
+
+        my $targets = {};
+
+        my $db_tokens =
+            new Torrus::DB('collector_tokens' . '_' . $instance . '_' .
+                           $config_tree->{'ds_config_instance'},
+                           -Subdir => $tree);
+        
+        my $cursor = $db_tokens->cursor();
+        while( my ($token, $schedule) = $db_tokens->next($cursor) )
+        {
+            my ($period, $offset) = split(/:/o, $schedule);
+            if( not exists( $targets->{$period}{$offset} ) )
+            {
+                $targets->{$period}{$offset} = [];
+            }
+            push( @{$targets->{$period}{$offset}}, $token );
+
+            &Torrus::DB::checkInterrupted();
+        }
+        undef $cursor;
+        $db_tokens->closeNow();
+        undef $db_tokens;
+
+        &Torrus::DB::checkInterrupted();
+
+        # Set the timestamp
+        &Torrus::TimeStamp::setNow( $timestamp_key );
+        
+        $self->flushTasks();
+
+        foreach my $period ( keys %{$targets} )
+        {
+            foreach my $offset ( keys %{$targets->{$period}} )
+            {
+                my $collector =
+                    new Torrus::Collector( -Period => $period,
+                                           -Offset => $offset,
+                                           -TreeName => $tree,
+                                           -Instance => $instance );
+
+                foreach my $token ( @{$targets->{$period}{$offset}} )
+                {
+                    &Torrus::DB::checkInterrupted();
+                    $collector->addTarget( $config_tree, $token );
+                }
+
+                $self->addTask( $collector );
+            }
+        }
+        Verbose(sprintf("Tasks initialization finished in %d seconds",
+                        time() - $init_start));
+
+        $data->{'targets_initialized'} = 1;        
+        Info('Tasks for collector instance ' . $instance . ' initialized');
+
+        foreach my $collector_type ( keys %Torrus::Collector::collectorTypes )
+        {
+            if( ref($Torrus::Collector::initCollectorGlobals{
+                $collector_type}) )
+            {
+                &{$Torrus::Collector::initCollectorGlobals{
+                    $collector_type}}($tree, $instance);
+                
+                Verbose('Initialized collector globals for type: ' .
+                        $collector_type);
+            }
+        }
+    }
+    
+    Torrus::TimeStamp::release();
+    
+    return 1;
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Collector/CDef.pm b/torrus/perllib/Torrus/Collector/CDef.pm
new file mode 100644
index 000000000..28dff8a9a
--- /dev/null
+++ b/torrus/perllib/Torrus/Collector/CDef.pm
@@ -0,0 +1,120 @@
+#
+#  Copyright (C) 2004-2005  Christian Schnidrig
+#  Copyright (C) 2007  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# $Id: CDef.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $
+# Christian Schnidrig <christian.schnidrig@bluewin.ch>
+
+
+# Torrus collector module for combining multiple datasources into one
+
+package Torrus::Collector::CDef;
+
+use strict;
+
+use Torrus::Collector::CDef_Params;
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::RPN;
+use Torrus::DataAccess;
+use Torrus::Collector::RRDStorage;
+
+# Register the collector type
+$Torrus::Collector::collectorTypes{'cdef'} = 1;
+
+# List of needed parameters and default values
+$Torrus::Collector::params{'cdef'} = \%Torrus::Collector::CDef_Params::params;
+$Torrus::Collector::initTarget{'cdef'} = \&Torrus::Collector::CDef::initTarget;
+
+
+# get access to the configTree;
+$Torrus::Collector::needsConfigTree{'cdef'}{'runCollector'} = 1;
+
+sub initTarget
+{
+    my $collector = shift;
+    my $token = shift;
+    
+    my $cref = $collector->collectorData( 'cdef' );
+    if( not defined( $cref->{'crefTokens'} ) )
+    {
+        $cref->{'crefTokens'} = [];
+    }
+
+    push( @{$cref->{'crefTokens'}}, $token );
+    
+    return 1;
+}
+
+# This is first executed per target
+$Torrus::Collector::runCollector{'cdef'} =
+    \&Torrus::Collector::CDef::runCollector;
+
+sub runCollector
+{
+    my $collector = shift;
+    my $cref = shift;
+    my $config_tree = $collector->configTree();
+
+    my $now = time();
+    my $da = new Torrus::DataAccess;
+
+    # By default, try to get the data from one period behind
+    my $defaultAccessTime = $now -
+        ( $now % $collector->period() ) + $collector->offset();
+    
+    foreach my $token ( @{$cref->{'crefTokens'}} )
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        my $accessTime = $defaultAccessTime -
+            ( $collector->period() *
+              $collector->param( $token, 'cdef-collector-delay' ) );
+
+        # The RRDtool is non-reentrant, and we need to be careful
+        # when running multiple threads
+        Torrus::Collector::RRDStorage::semaphoreDown();
+        
+        my ($value, $timestamp) =
+            $da->read_RPN( $config_tree, $token,
+                           $collector->param( $token, 'rpn-expr' ),
+                           $accessTime );
+
+        Torrus::Collector::RRDStorage::semaphoreUp();
+
+        if( defined( $value ) )
+        {
+            if ( $timestamp <
+                 ( $accessTime -
+                   ( $collector->period() *
+                     $collector->param( $token, 'cdef-collector-tolerance' ))))
+            {
+                Error( "CDEF: Data is " . ($accessTime-$timestamp) .
+                       " seconds too old for " . $collector->path($token) );
+            }
+            else
+            {
+                $collector->setValue( $token, $value, $timestamp );
+            }
+        }
+    }
+}
+
+
+
+1;
+
diff --git a/torrus/perllib/Torrus/Collector/CDef_Params.pm b/torrus/perllib/Torrus/Collector/CDef_Params.pm
new file mode 100644
index 000000000..4bd84ba9d
--- /dev/null
+++ b/torrus/perllib/Torrus/Collector/CDef_Params.pm
@@ -0,0 +1,69 @@
+#
+#  Copyright (C) 2004  Christian Schnidrig
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# $Id: CDef_Params.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $
+# Christian Schnidrig <christian.schnidrig@bluewin.ch>
+
+
+# Parameter definitions for CDef collector plugin
+
+package Torrus::Collector::CDef_Params;
+
+use strict;
+
+###  Initialize the configuration validator with module-specific parameters
+our %params =
+    (
+     'rpn-expr'                 => undef,
+     'cdef-collector-delay'     => undef,
+     'cdef-collector-tolerance' => undef,
+     );
+
+
+sub initValidatorLeafParams
+{
+    my $hashref = shift;
+    $hashref->{'ds-type'}{'collector'}{'collector-type'}{'cdef'} =
+        \%params;
+}
+
+
+my %admInfoParamCategories =
+    (
+     'cdef-collector-delay'        => 'CDef_Collector',
+     'cdef-collector-tolerance'    => 'CDef_Collector',
+     );     
+
+
+sub initAdmInfo
+{
+    my $map = shift;
+    my $categories = shift;
+    
+    $map->{'ds-type'}{'collector'}{'collector-type'}{'cdef'} =
+        \%params;
+    
+    while( my ($pname, $category) = each %admInfoParamCategories )
+    {
+        $categories->{$pname} = $category;
+    }
+}
+
+
+
+1;
+
diff --git a/torrus/perllib/Torrus/Collector/ExtDBI.pm b/torrus/perllib/Torrus/Collector/ExtDBI.pm
new file mode 100644
index 000000000..7d1394191
--- /dev/null
+++ b/torrus/perllib/Torrus/Collector/ExtDBI.pm
@@ -0,0 +1,128 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ExtDBI.pm,v 1.1 2010-12-27 00:03:58 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+## Pluggable backend module for ExternalStorage
+## Stores data in a generic SQL database
+
+# We use some internals of Torrus::SQL::SrvExport, but
+# handle the SQL by ourselves, for better efficiency.
+
+package Torrus::Collector::ExtDBI;
+
+use strict;
+use DBI;
+use Date::Format;
+
+use Torrus::SQL::SrvExport;
+use Torrus::Log;
+
+$Torrus::Collector::ExternalStorage::backendInit =
+    \&Torrus::Collector::ExtDBI::backendInit;
+
+$Torrus::Collector::ExternalStorage::backendOpenSession =
+    \&Torrus::Collector::ExtDBI::backendOpenSession;
+
+$Torrus::Collector::ExternalStorage::backendStoreData =
+    \&Torrus::Collector::ExtDBI::backendStoreData;
+
+$Torrus::Collector::ExternalStorage::backendCloseSession =
+    \&Torrus::Collector::ExtDBI::backendCloseSession;
+
+
+# Optional SQL connection subtype, configurable from torrus-siteconfig.pl
+our $subtype;
+
+my $dbh;
+my $sth;
+
+sub backendInit
+{
+    my $collector = shift;
+    my $token = shift;
+}
+
+sub backendOpenSession
+{
+    $dbh = Torrus::SQL::SrvExport->dbh( $subtype );
+    
+    if( defined( $dbh ) )
+    {
+        $sth = $dbh->prepare( Torrus::SQL::SrvExport->sqlInsertStatement() );
+        if( not defined( $sth ) )
+        {
+            Error('Error preparing the SQL statement: ' . $dbh->errstr);
+        }
+    }
+}
+
+
+sub backendStoreData
+{
+    my $timestamp = shift;
+    my $serviceid = shift;
+    my $value = shift;
+    my $interval = shift;
+    
+    if( defined( $dbh ) and defined( $sth ) )
+    {
+        my $datestr = time2str('%Y-%m-%d', $timestamp);
+        my $timestr = time2str('%H:%M:%S', $timestamp);
+        if( isDebug() )
+        {
+            Debug('Updating SQL database: ' .
+                  join(', ', $datestr, $timestr,
+                       $serviceid, $value, $interval ));
+        }
+
+        if( $sth->execute( $datestr, $timestr,
+                           $serviceid, $value, $interval ) )
+        {
+            return 1;
+        }
+        else
+        {
+            Error('Error executing SQL: ' . $dbh->errstr);
+        }
+    }
+
+    return undef;
+}
+
+
+sub backendCloseSession
+{
+    undef $sth;
+    if( defined( $dbh ) )
+    {
+        $dbh->commit();
+        $dbh->disconnect();
+        undef $dbh;
+    }
+}
+
+
+    
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Collector/ExternalStorage.pm b/torrus/perllib/Torrus/Collector/ExternalStorage.pm
new file mode 100644
index 000000000..1a876fa1d
--- /dev/null
+++ b/torrus/perllib/Torrus/Collector/ExternalStorage.pm
@@ -0,0 +1,415 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ExternalStorage.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Collector::ExternalStorage;
+
+use Torrus::ConfigTree;
+use Torrus::Log;
+
+use strict;
+use Math::BigInt;
+use Math::BigFloat;
+
+# Pluggable backend module implements all storage-specific tasks
+BEGIN
+{
+    eval( 'require ' . $Torrus::Collector::ExternalStorage::backend );
+    die( $@ ) if $@;    
+}
+
+# These variables must be set by the backend module
+our $backendInit;
+our $backendOpenSession;
+our $backendStoreData;
+our $backendCloseSession;
+
+# Register the storage type
+$Torrus::Collector::storageTypes{'ext'} = 1;
+
+
+# List of needed parameters and default values
+
+$Torrus::Collector::params{'ext-storage'} = {
+    'ext-dstype' => {
+        'GAUGE' => undef,
+        'COUNTER32' => {
+            'ext-counter-max' => undef},
+        'COUNTER64' => {
+            'ext-counter-max' => undef}},
+    'ext-service-id' => undef
+    };
+
+
+
+
+$Torrus::Collector::initTarget{'ext-storage'} =
+    \&Torrus::Collector::ExternalStorage::initTarget;
+
+sub initTarget
+{
+    my $collector = shift;
+    my $token = shift;
+
+    my $sref = $collector->storageData( 'ext' );
+
+    $collector->registerDeleteCallback
+        ( $token, \&Torrus::Collector::ExternalStorage::deleteTarget );
+
+    my $serviceid =
+        $collector->param($token, 'ext-service-id');
+
+    if( defined( $sref->{'serviceid'}{$serviceid} ) )
+    {
+        Error('ext-service-id is not unique: "' . $serviceid .
+              '". External storage is not activated for ' .
+              $collector->path($token));
+        return;
+    }
+
+    $sref->{'serviceid'}{$serviceid} = 1;
+
+    my $processor;
+    my $dstype = $collector->param($token, 'ext-dstype');
+    if( $dstype eq 'GAUGE' )
+    {
+        $processor = \&Torrus::Collector::ExternalStorage::processGauge;
+    }
+    else
+    {
+        if( $dstype eq 'COUNTER32' )
+        {
+            $processor =
+                \&Torrus::Collector::ExternalStorage::processCounter32;
+        }
+        else
+        {
+            $processor =
+                \&Torrus::Collector::ExternalStorage::processCounter64;
+        }
+        
+        my $max = $collector->param( $token, 'ext-counter-max' );
+        if( defined( $max ) )
+        {
+            $sref->{'max'}{$token} = Math::BigFloat->new($max);
+        }
+    }
+
+    $sref->{'tokens'}{$token} = $processor;
+
+    &{$backendInit}( $collector, $token );
+}
+
+
+
+$Torrus::Collector::setValue{'ext'} =
+    \&Torrus::Collector::ExternalStorage::setValue;
+
+
+sub setValue
+{
+    my $collector = shift;
+    my $token = shift;
+    my $value = shift;
+    my $timestamp = shift;
+
+    my $sref = $collector->storageData( 'ext' );
+
+    my $prevTimestamp = $sref->{'prevTimestamp'}{$token};
+    if( not defined( $prevTimestamp ) )
+    {
+        $prevTimestamp = $timestamp;
+    }
+        
+    my $procvalue =
+        &{$sref->{'tokens'}{$token}}( $collector, $token, $value, $timestamp );
+    if( defined( $procvalue ) )
+    {
+        if( ref( $procvalue ) )
+        {
+            # Convert a BigFloat into a scientific notation string
+            $procvalue = $procvalue->bsstr();
+        }
+        $sref->{'values'}{$token} =
+            [$procvalue, $timestamp, $timestamp - $prevTimestamp];
+    }
+    
+    $sref->{'prevTimestamp'}{$token} = $timestamp;
+}
+
+
+sub processGauge
+{
+    my $collector = shift;
+    my $token = shift;
+    my $value = shift;
+    my $timestamp = shift;
+
+    return $value;
+}
+
+
+sub processCounter32
+{
+    my $collector = shift;
+    my $token = shift;
+    my $value = shift;
+    my $timestamp = shift;
+
+    return processCounter( 32, $collector, $token, $value, $timestamp );
+}
+
+sub processCounter64
+{
+    my $collector = shift;
+    my $token = shift;
+    my $value = shift;
+    my $timestamp = shift;
+
+    return processCounter( 64, $collector, $token, $value, $timestamp );
+}
+
+my $base32 = Math::BigInt->new(2)->bpow(32);
+my $base64 = Math::BigInt->new(2)->bpow(64);
+
+sub processCounter
+{
+    my $base = shift;
+    my $collector = shift;
+    my $token = shift;
+    my $value = shift;
+    my $timestamp = shift;
+
+    my $sref = $collector->storageData( 'ext' );
+
+    if( isDebug() )
+    {
+        Debug('ExternalStorage::processCounter: token=' . $token .
+              ' value=' . $value . ' timestamp=' . $timestamp);
+    }
+
+    if( $value eq 'U' )
+    {
+        # the agent rebooted, so we flush the counter
+        delete $sref->{'prevCounter'}{$token};
+        return undef;
+    }
+        
+    $value = Math::BigInt->new( $value );
+    my $ret;
+    
+    if( exists( $sref->{'prevCounter'}{$token} ) )
+    {
+        my $prevValue = $sref->{'prevCounter'}{$token};
+        my $prevTimestamp = $sref->{'prevTimestamp'}{$token};
+        if( isDebug() )
+        {
+            Debug('ExternalStorage::processCounter: prevValue=' . $prevValue .
+                  ' prevTimestamp=' . $prevTimestamp);
+        }
+        
+        if( $prevValue->bcmp( $value ) > 0 ) # previous is bigger
+        {
+            $ret = Math::BigFloat->new($base==32 ? $base32:$base64);
+            $ret->bsub( $prevValue );
+            $ret->badd( $value );
+        }
+        else
+        {
+            $ret = Math::BigFloat->new( $value );
+            $ret->bsub( $prevValue );
+        }
+        $ret->bdiv( $timestamp - $prevTimestamp );
+        if( defined( $sref->{'max'}{$token} ) )
+        {
+            if( $ret->bcmp( $sref->{'max'}{$token} ) > 0 )
+            {
+                Debug('Resulting counter rate is above the maximum');
+                $ret = undef;
+            }
+        }
+    }
+
+    $sref->{'prevCounter'}{$token} = $value;
+
+    if( defined( $ret ) and isDebug() )
+    {
+        Debug('ExternalStorage::processCounter: Resulting value=' . $ret);
+    }
+    return $ret;
+}
+
+
+
+$Torrus::Collector::storeData{'ext'} =
+    \&Torrus::Collector::ExternalStorage::storeData;
+
+# timestamp of last unavailable storage
+my $storageUnavailable = 0;
+
+# Last time we tried to reach it
+my $storageLastTry = 0;
+
+# how often we retry - configurable in torrus-config.pl
+our $unavailableRetry;
+
+# maximum age for backlog in case of unavailable storage.
+# We stop recording new data when maxage is reached.
+our $backlogMaxAge;
+
+sub storeData
+{
+    my $collector = shift;
+    my $sref = shift;
+
+    &Torrus::DB::checkInterrupted();
+
+    my $nTokens = scalar( keys %{$sref->{'values'}} );
+
+    if( $nTokens == 0 )
+    {
+        return;
+    }
+    
+    Verbose('Exporting data to external storage for ' .
+            $nTokens . ' tokens');
+    &{$backendOpenSession}();
+    
+    while( my($token, $valuetriple) = each( %{$sref->{'values'}} ) )
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        my( $value, $timestamp, $interval ) = @{$valuetriple};
+        my $serviceid =
+            $collector->param($token, 'ext-service-id');
+        
+        my $toBacklog = 0;
+        
+        if( $storageUnavailable > 0 and 
+            time() < $storageLastTry + $unavailableRetry )
+        {
+            $toBacklog = 1;
+        }
+        else
+        {
+            $storageUnavailable = 0;
+            $storageLastTry = time();
+            
+            if( exists( $sref->{'backlog'} ) )
+            {
+                # Try to flush the backlog first
+                Verbose('Trying to flush the backlog');
+                    
+                my $ok = 1;
+                while( scalar(@{$sref->{'backlog'}}) > 0 and $ok )
+                {
+                    my $quarter = shift @{$sref->{'backlog'}};
+                    if( not &{$backendStoreData}( @{$quarter} ) )
+                    {
+                        Warn('Unable to flush the backlog, external ' .
+                             'storage is unavailable');
+                        
+                        unshift( @{$sref->{'backlog'}}, $quarter );
+                        $ok = 0;
+                        $toBacklog = 1;
+                    }
+                }
+                if( $ok )
+                {
+                    delete( $sref->{'backlog'} );
+                    Verbose('Backlog is successfully flushed');
+                }                    
+            }
+            
+            if( not $toBacklog )
+            {
+                if( not &{$backendStoreData}( $timestamp, $serviceid,
+                                              $value, $interval ) )
+                {
+                    Warn('Unable to store data, external storage is ' .
+                         'unavailable. Saving data to backlog');
+                    
+                    $toBacklog = 1;                    
+                }
+            }
+        }
+        
+        if( $toBacklog )
+        {
+            if( $storageUnavailable == 0 )
+            {
+                $storageUnavailable = time();
+            }
+            
+            if( not exists( $sref->{'backlog'} ) )
+            {
+                $sref->{'backlog'} = [];
+                $sref->{'backlogStart'} = time();
+            }
+            
+            if( time() < $sref->{'backlogStart'} + $backlogMaxAge )
+            {
+                push( @{$sref->{'backlog'}},
+                      [ $timestamp, $serviceid, $value, $interval ] );
+            }
+            else
+            {
+                Error('Backlog has reached its maximum age, stopped storing ' .
+                      'any more data');
+            }
+        }
+    }    
+    
+    undef $sref->{'values'};
+    &{$backendCloseSession}();
+}
+
+
+
+
+
+# Callback executed by Collector
+
+sub deleteTarget
+{
+    my $collector = shift;
+    my $token = shift;
+
+    my $sref = $collector->storageData( 'ext' );
+
+    my $serviceid =
+        $collector->param($token, 'ext-service-id');
+    delete $sref->{'serviceid'}{$serviceid};
+
+    if( defined( $sref->{'prevCounter'}{$token} ) )
+    {
+        delete $sref->{'prevCounter'}{$token};
+    }
+    
+    delete $sref->{'tokens'}{$token};
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Collector/RRDStorage.pm b/torrus/perllib/Torrus/Collector/RRDStorage.pm
new file mode 100644
index 000000000..7f806fac2
--- /dev/null
+++ b/torrus/perllib/Torrus/Collector/RRDStorage.pm
@@ -0,0 +1,584 @@
+#  Copyright (C) 2002-2007  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RRDStorage.pm,v 1.1 2010-12-27 00:03:58 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Collector::RRDStorage;
+
+use Torrus::ConfigTree;
+use Torrus::Log;
+
+use strict;
+use RRDs;
+
+our $useThreads;
+our $threadsInUse = 0;
+our $thrQueueLimit;
+our $thrUpdateQueue;
+our $thrErrorsQueue;
+# RRDtool is not reentrant. use this semaphore for every call to RRDs::*
+our $rrdtoolSemaphore;
+our $thrUpdateThread;
+
+our $moveConflictRRD;
+our $conflictRRDPath;
+
+# Register the storage type
+$Torrus::Collector::storageTypes{'rrd'} = 1;
+
+
+# List of needed parameters and default values
+
+$Torrus::Collector::params{'rrd-storage'} = {
+    'data-dir' => undef,
+    'data-file' => undef,
+    'rrd-create-rra' => undef,
+    'rrd-create-heartbeat' => undef,
+    'rrd-create-min'  => 'U',
+    'rrd-create-max'  => 'U',
+    'rrd-hwpredict'   => {
+        'enabled' => {
+            'rrd-create-hw-alpha' => 0.1,
+            'rrd-create-hw-beta'  => 0.0035,
+            'rrd-create-hw-gamma' => 0.1,
+            'rrd-create-hw-winlen' => 9,
+            'rrd-create-hw-failth' => 6,
+            'rrd-create-hw-season' => 288,
+            'rrd-create-hw-rralen' => undef },
+        'disabled' => undef },
+    'rrd-create-dstype' => undef,
+    'rrd-ds' => undef
+    };
+
+
+$Torrus::Collector::initThreadsHandlers{'rrd-storage'} =
+    \&Torrus::Collector::RRDStorage::initThreads;
+
+sub initThreads
+{
+    if( $useThreads and not defined( $thrUpdateThread ) )
+    {
+        Verbose('RRD storage is configured for multithreading. Initializing ' .
+                'the background thread');
+        require threads;
+        require threads::shared;
+        require Thread::Queue;
+        require Thread::Semaphore;
+
+        $thrUpdateQueue = new Thread::Queue;
+        $thrErrorsQueue = new Thread::Queue;
+        $rrdtoolSemaphore = new Thread::Semaphore;
+        
+        $thrUpdateThread = threads->create( \&rrdUpdateThread );
+        $thrUpdateThread->detach();
+        $threadsInUse = 1;
+    }
+}
+
+
+
+$Torrus::Collector::initTarget{'rrd-storage'} =
+    \&Torrus::Collector::RRDStorage::initTarget;
+
+sub initTarget
+{
+    my $collector = shift;
+    my $token = shift;
+
+    my $sref = $collector->storageData( 'rrd' );
+
+    $collector->registerDeleteCallback
+        ( $token, \&Torrus::Collector::RRDStorage::deleteTarget );
+
+    my $filename =
+        $collector->param($token, 'data-dir') . '/' .
+        $collector->param($token, 'data-file');
+
+    $sref->{'byfile'}{$filename}{$token} = 1;
+    $sref->{'filename'}{$token} = $filename;
+}
+
+
+
+$Torrus::Collector::setValue{'rrd'} =
+    \&Torrus::Collector::RRDStorage::setValue;
+
+
+sub setValue
+{
+    my $collector = shift;
+    my $token = shift;
+    my $value = shift;
+    my $timestamp = shift;
+    my $uptime = shift;
+
+    my $sref = $collector->storageData( 'rrd' );
+
+    $sref->{'values'}{$token} = [$value, $timestamp, $uptime];
+}
+
+
+$Torrus::Collector::storeData{'rrd'} =
+    \&Torrus::Collector::RRDStorage::storeData;
+
+sub storeData
+{
+    my $collector = shift;
+    my $sref = shift;
+
+    if( $threadsInUse )
+    {
+        $collector->setStatValue( 'RRDQueue', $thrUpdateQueue->pending() );
+    }
+    
+    if( $threadsInUse and $thrUpdateQueue->pending() > $thrQueueLimit )
+    {
+        Error('Cannot enqueue RRD files for updating: ' .
+              'queue size is above limit');
+    }
+    else
+    {
+        while( my ($filename, $tokens) = each %{$sref->{'byfile'}} )
+        {
+            &Torrus::DB::checkInterrupted();
+            
+            if( not -e $filename )
+            {
+                createRRD( $collector, $sref, $filename, $tokens );
+            }
+            
+            if( -e $filename )
+            {
+                updateRRD( $collector, $sref, $filename, $tokens );
+            }
+        }
+    }
+
+    delete $sref->{'values'};
+}
+
+
+sub semaphoreDown
+{    
+    if( $threadsInUse )
+    {
+        $rrdtoolSemaphore->down();
+    }
+}
+
+sub semaphoreUp
+{
+    if( $threadsInUse )
+    {
+        $rrdtoolSemaphore->up();
+    }
+}
+
+
+sub createRRD
+{
+    my $collector = shift;
+    my $sref = shift;
+    my $filename = shift;
+    my $tokens  = shift;
+
+    # We use hashes here, in order to make the superset of RRA
+    # definitions, and unique RRD names
+    my %DS_hash;
+    my %RRA_hash;
+
+    # Holt-Winters parameters
+    my $needs_hw = 0;
+    my %hwparam;
+
+    my $timestamp = time();
+
+    foreach my $token ( keys %{$tokens} )
+    {
+        my $ds_string =
+            sprintf('DS:%s:%s:%d:%s:%s',
+                    $collector->param($token, 'rrd-ds'),
+                    $collector->param($token, 'rrd-create-dstype'),
+                    $collector->param($token, 'rrd-create-heartbeat'),
+                    $collector->param($token, 'rrd-create-min'),
+                    $collector->param($token, 'rrd-create-max'));
+        $DS_hash{$ds_string} = 1;
+
+        foreach my $rra_string
+            ( split(/\s+/, $collector->param($token, 'rrd-create-rra')) )
+        {
+            $RRA_hash{$rra_string} = 1;
+        }
+
+        if( $collector->param($token, 'rrd-hwpredict') eq 'enabled' )
+        {
+            $needs_hw = 1;
+
+            foreach my $param ( 'alpha', 'beta', 'gamma', 'winlen', 'failth',
+                                'season', 'rralen' )
+            {
+                my $value = $collector->param($token, 'rrd-create-hw-'.$param);
+
+                if( defined( $hwparam{$param} ) and
+                    $hwparam{$param} != $value )
+                {
+                    my $paramname = 'rrd-create-hw-'.$param;
+                    Warn("Parameter " . $paramname . " was already defined " .
+                         "with differentr value for " . $filename);
+                }
+
+                $hwparam{$param} = $value;
+            }
+        }
+
+        if( ref $sref->{'values'}{$token} )
+        {
+            my $new_ts = $sref->{'values'}{$token}[1];
+            if( $new_ts > 0 and $new_ts < $timestamp )
+            {
+                $timestamp = $new_ts;
+            }
+        }
+    }
+
+    my @DS = sort keys %DS_hash;
+    my @RRA = sort keys %RRA_hash;
+
+    if( $needs_hw )
+    {
+        ## Define the RRAs for Holt-Winters prediction
+
+        my $hwpredict_rran   = scalar(@RRA) + 1;
+        my $seasonal_rran    = $hwpredict_rran + 1;
+        my $devseasonal_rran = $hwpredict_rran + 2;
+        my $devpredict_rran  = $hwpredict_rran + 3;
+        my $failures_rran    = $hwpredict_rran + 4;
+
+        push( @RRA, sprintf('RRA:HWPREDICT:%d:%e:%e:%d:%d',
+                            $hwparam{'rralen'},
+                            $hwparam{'alpha'},
+                            $hwparam{'beta'},
+                            $hwparam{'season'},
+                            $seasonal_rran));
+
+        push( @RRA, sprintf('RRA:SEASONAL:%d:%e:%d',
+                            $hwparam{'season'},
+                            $hwparam{'gamma'},
+                            $hwpredict_rran));
+
+        push( @RRA, sprintf('RRA:DEVSEASONAL:%d:%e:%d',
+                            $hwparam{'season'},
+                            $hwparam{'gamma'},
+                            $hwpredict_rran));
+
+        push( @RRA, sprintf('RRA:DEVPREDICT:%d:%d',
+                            $hwparam{'rralen'},
+                            $devseasonal_rran));
+
+        push( @RRA, sprintf('RRA:FAILURES:%d:%d:%d:%d',
+                            $hwparam{'rralen'},
+                            $hwparam{'failth'},
+                            $hwparam{'winlen'},
+                            $devseasonal_rran));
+    }
+
+    my $step = $collector->period();
+    my $start = $timestamp - $step;
+
+    my @OPT = ( sprintf( '--start=%d', $start ),
+                sprintf( '--step=%d', $step ) );
+
+    &Torrus::DB::checkInterrupted();
+    
+    Debug("Creating RRD $filename: " . join(" ", @OPT, @DS, @RRA));
+
+    semaphoreDown();
+    
+    RRDs::create($filename,
+                 @OPT,
+                 @DS,
+                 @RRA);
+
+    my $err = RRDs::error();
+
+    semaphoreUp();
+
+    Error("ERROR creating $filename: $err") if $err;
+    
+    delete $sref->{'rrdinfo_ds'}{$filename};
+}
+
+
+sub updateRRD
+{
+    my $collector = shift;
+    my $sref = shift;
+    my $filename = shift;
+    my $tokens  = shift;
+
+    if( not defined( $sref->{'rrdinfo_ds'}{$filename} ) )
+    {
+        my $ref = {};
+        $sref->{'rrdinfo_ds'}{$filename} = $ref;
+
+        semaphoreDown();
+        
+        my $rrdinfo = RRDs::info( $filename );
+
+        semaphoreUp();
+
+        foreach my $prop ( keys %$rrdinfo )
+        {
+            if( $prop =~ /^ds\[(\S+)\]\./o )
+            {
+                $ref->{$1} = 1;
+            }
+        }
+        
+        &Torrus::DB::checkInterrupted();
+    }
+
+    # First we compare the sets of datasources in our memory and in RRD file
+    my %ds_updating = ();
+    my $ds_conflict = 0;
+
+    foreach my $token ( keys %{$tokens} )
+    {
+        $ds_updating{ $collector->param($token, 'rrd-ds') } = $token;
+    }
+
+    # Check if we update all datasources in RRD file
+    foreach my $ds ( keys %{$sref->{'rrdinfo_ds'}{$filename}} )
+    {
+        if( not $ds_updating{$ds} )
+        {
+            Warn('Datasource exists in RRD file, but it is not updated: ' .
+                 $ds . ' in ' . $filename);
+            $ds_conflict = 1;
+        }
+    }
+
+    # Check if all DS that we update are defined in RRD
+    foreach my $ds ( keys %ds_updating )
+    {
+        if( not $sref->{'rrdinfo_ds'}{$filename}{$ds} )
+        {
+            Error("Datasource being updated does not exist: $ds in $filename");
+            delete $ds_updating{$ds};
+            $ds_conflict = 1;
+        }
+    }
+
+    if( $ds_conflict and $moveConflictRRD )
+    {
+        if( not -f $filename )
+        {
+            Error($filename . 'is not a regular file');
+            return;
+        }
+        
+        my( $sec, $min, $hour, $mday, $mon, $year) = localtime( time() );
+        my $destfile = sprintf('%s_%04d%02d%02d%02d%02d',
+                               $filename,
+                               $year + 1900, $mon+1, $mday, $hour, $min);
+        
+        my $destdir = $conflictRRDPath;
+        if( defined( $destdir ) and -d $destdir )
+        {
+            my @fpath = split('/', $destfile);
+            my $fname = pop( @fpath );
+            $destfile = $destdir . '/' . $fname;
+        }
+
+        Warn('Moving the conflicted RRD file ' . $filename .
+             ' to ' . $destfile);
+        rename( $filename, $destfile ) or
+            Error("Cannot rename $filename to $destfile: $!");
+        
+        delete $sref->{'rrdinfo_ds'}{$filename};
+        
+        createRRD( $collector, $sref, $filename, $tokens );
+    }
+        
+    if( scalar( keys %ds_updating ) == 0 )
+    {
+        Error("No datasources to update in $filename");
+        return;
+    }
+
+    &Torrus::DB::checkInterrupted();
+
+    # Build the arguments for RRDs::update.
+    my $template;
+    my $values;
+
+    # We will use the average timestamp
+    my @timestamps;
+    my $max_ts = 0;
+    my $min_ts = time();
+
+    my $step = $collector->period();
+
+    foreach my $ds ( keys %ds_updating )
+    {
+        my $token = $ds_updating{$ds};
+        if( length($template) > 0 )
+        {
+            $template .= ':';
+        }
+        $template .= $ds;
+
+        my $now = time();
+        my ( $value, $timestamp, $uptime ) = ( 'U', $now, $now );
+        if( ref $sref->{'values'}{$token} )
+        {
+            ($value, $timestamp, $uptime) = @{$sref->{'values'}{$token}};
+        }
+
+        push( @timestamps, $timestamp );
+        if( $timestamp > $max_ts )
+        {
+            $max_ts = $timestamp;
+        }
+        if( $timestamp < $min_ts )
+        {
+            $min_ts = $timestamp;
+        }
+
+        # The plus sign generated by BigInt is not a problem for rrdtool
+        $values .= ':'. $value;
+    }
+
+    # Get the average timestamp
+    my $sum = 0;
+    map {$sum += $_} @timestamps;
+    my $avg_ts = $sum / scalar( @timestamps );
+
+    if( ($max_ts - $avg_ts) > $Torrus::Global::RRDTimestampTolerance )
+    {
+        Error("Maximum timestamp value is beyond the tolerance in $filename");
+    }
+    if( ($avg_ts - $min_ts) > $Torrus::Global::RRDTimestampTolerance )
+    {
+        Error("Minimum timestamp value is beyond the tolerance in $filename");
+    }
+
+    my @cmd = ( "--template=" . $template,
+                sprintf("%d%s", $avg_ts, $values) );
+
+    &Torrus::DB::checkInterrupted();
+
+    if( $threadsInUse )
+    {
+        # Process errors from RRD update thread
+        my $errfilename;
+        while( defined( $errfilename = $thrErrorsQueue->dequeue_nb() ) )
+        {
+            delete $sref->{'rrdinfo_ds'}{$errfilename};
+        }
+
+        Debug('Enqueueing update job for ' . $filename);
+        
+        my $cmdlist = &threads::shared::share([]);
+        push( @{$cmdlist}, $filename, @cmd );
+        $thrUpdateQueue->enqueue( $cmdlist );
+    }
+    else
+    {
+        if( isDebug )
+        {
+            Debug("Updating $filename: " . join(' ', @cmd));
+        }
+        RRDs::update( $filename, @cmd );
+        my $err = RRDs::error();
+        if( $err )
+        {
+            Error("ERROR updating $filename: $err");
+            delete $sref->{'rrdinfo_ds'}{$filename};
+        }
+    }
+}
+
+
+# A background thread that updates RRD files
+sub rrdUpdateThread
+{
+    &Torrus::DB::setSafeSignalHandlers();
+    $| = 1;
+    &Torrus::Log::setTID( threads->tid() );
+    
+    my $cmdlist;
+    &threads::shared::share( \$cmdlist );
+    
+    while(1)
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        $cmdlist = $thrUpdateQueue->dequeue();
+        
+        if( isDebug )
+        {
+            Debug("Updating RRD: " . join(' ', @{$cmdlist}));
+        }
+
+        $rrdtoolSemaphore->down();
+
+        RRDs::update( @{$cmdlist} );
+        my $err = RRDs::error();
+
+        $rrdtoolSemaphore->up();
+
+        if( $err )
+        {
+            Error('ERROR updating' . $cmdlist->[0] . ': ' . $err);
+            $thrErrorsQueue->enqueue( $cmdlist->[0] );
+        }
+    }
+}
+
+
+
+# Callback executed by Collector
+
+sub deleteTarget
+{
+    my $collector = shift;
+    my $token = shift;
+
+    my $sref = $collector->storageData( 'rrd' );
+    my $filename = $sref->{'filename'}{$token};
+
+    delete $sref->{'filename'}{$token};
+
+    delete $sref->{'byfile'}{$filename}{$token};
+    if( scalar( keys %{$sref->{'byfile'}{$filename}} ) == 0 )
+    {
+        delete $sref->{'byfile'}{$filename};
+    }
+
+    delete $sref->{'values'}{$token};
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Collector/SNMP.pm b/torrus/perllib/Torrus/Collector/SNMP.pm
new file mode 100644
index 000000000..5d3d8cdc0
--- /dev/null
+++ b/torrus/perllib/Torrus/Collector/SNMP.pm
@@ -0,0 +1,1261 @@
+#  Copyright (C) 2002-2007  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: SNMP.pm,v 1.1 2010-12-27 00:03:58 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Collector::SNMP;
+
+use Torrus::Collector::SNMP_Params;
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::SNMP_Failures;
+
+use strict;
+use Net::hostent;
+use Socket;
+use Net::SNMP qw(:snmp);
+use Math::BigInt;
+
+
+# Register the collector type
+$Torrus::Collector::collectorTypes{'snmp'} = 1;
+
+
+# List of needed parameters and default values
+
+$Torrus::Collector::params{'snmp'} = {
+    'snmp-ipversion'    => undef,
+    'snmp-transport'    => undef,
+    'snmp-version'      => undef,
+    'snmp-port'         => undef,
+    'snmp-community'    => undef,
+    'snmp-username'     => undef,
+    'snmp-authkey'      => undef,
+    'snmp-authpassword' => undef,
+    'snmp-authprotocol' => 'md5',
+    'snmp-privkey'      => undef,
+    'snmp-privpassword' => undef,
+    'snmp-privprotocol' => 'des',
+    'snmp-timeout'      => undef,
+    'snmp-retries'      => undef,
+    'domain-name'       => undef,
+    'snmp-host'         => undef,
+    'snmp-localaddr'    => undef,
+    'snmp-localport'    => undef,
+    'snmp-object'       => undef,
+    'snmp-oids-per-pdu' => undef,
+    'snmp-object-type'  => 'OTHER',
+    'snmp-check-sysuptime' => 'yes',
+    'snmp-max-msg-size' => undef,
+    'snmp-ignore-mib-errors' => undef,
+    };
+
+my $sysUpTime = '1.3.6.1.2.1.1.3.0';
+
+# Hosts that are running SNMPv1. We do not reresh maps on them, as
+# they are too slow
+my %snmpV1Hosts;
+
+# SNMP tables lookup maps
+my %maps;
+
+# Old lookup maps, used temporarily during refresh cycle
+my %oldMaps;
+
+# How frequent we refresh the SNMP mapping
+our $mapsRefreshPeriod;
+
+# Random factor in refresh period
+our $mapsRefreshRandom;
+
+# Time period after configuration re-compile when we refresh existing mappings
+our $mapsUpdateInterval;
+
+# how often we check for expired maps
+our $mapsExpireCheckPeriod;
+
+# expiration time for each map
+my %mapsExpire;
+
+# Lookups scheduled for execution
+my %mapLookupScheduled;
+
+# SNMP session objects for map lookups
+my @mappingSessions;
+
+
+# Timestamps of hosts last found unreachable
+my %hostUnreachableSeen;
+
+# Last time we tried to reach an unreachable host
+my %hostUnreachableRetry;
+
+# Hosts that were deleted because of unreachability for too long
+my %unreachableHostDeleted;
+
+
+our $db_failures;
+
+# Flush stats after a restart or recompile
+$Torrus::Collector::initCollectorGlobals{'snmp'} =
+    \&Torrus::Collector::SNMP::initCollectorGlobals;
+
+sub initCollectorGlobals
+{
+    my $tree = shift;
+    my $instance = shift;
+    
+    if( not defined( $db_failures ) )
+    {
+        $db_failures =
+            new Torrus::SNMP_Failures( -Tree => $tree,
+                                       -Instance => $instance,
+                                       -WriteAccess => 1 );
+    }
+
+    if( defined( $db_failures ) )
+    {
+        $db_failures->init();
+    }
+
+    # re-init counters and collect garbage
+    %oldMaps = ();
+    %hostUnreachableSeen = ();
+    %hostUnreachableRetry = ();
+    %unreachableHostDeleted = ();
+    
+    # Configuration re-compile was probably caused by new object instances
+    # appearing on the monitored devices. Here we force the maps to refresh
+    # soon enough in order to catch up with the changes
+
+    my $now = time();    
+    foreach my $maphash ( keys %mapsExpire )
+    {
+        $mapsExpire{$maphash} = int( $now + rand( $mapsUpdateInterval ) );
+    }    
+}
+
+
+# This is first executed per target
+
+$Torrus::Collector::initTarget{'snmp'} = \&Torrus::Collector::SNMP::initTarget;
+
+
+
+sub initTarget
+{
+    my $collector = shift;
+    my $token = shift;
+
+    my $tref = $collector->tokenData( $token );
+    my $cref = $collector->collectorData( 'snmp' );
+
+    $collector->registerDeleteCallback
+        ( $token, \&Torrus::Collector::SNMP::deleteTarget );
+
+    my $hostname = getHostname( $collector, $token );
+    if( not defined( $hostname ) )
+    {
+        return 0;
+    }
+
+    $tref->{'hostname'} = $hostname;
+    
+    return Torrus::Collector::SNMP::initTargetAttributes( $collector, $token );
+}
+
+
+sub initTargetAttributes
+{
+    my $collector = shift;
+    my $token = shift;
+
+    &Torrus::DB::checkInterrupted();
+
+    my $tref = $collector->tokenData( $token );
+    my $cref = $collector->collectorData( 'snmp' );
+
+    my $hostname = $tref->{'hostname'};
+    my $port = $collector->param($token, 'snmp-port');
+    my $version = $collector->param($token, 'snmp-version');
+
+    my $community;
+    if( $version eq '1' or $version eq '2c' )
+    {
+        $community = $collector->param($token, 'snmp-community');
+    }
+    else
+    {
+        # We use community string to identify the agent.
+        # For SNMPv3, it's the user name
+        $community = $collector->param($token, 'snmp-username');
+    }
+
+    my $hosthash = join('|', $hostname, $port, $community);
+    $tref->{'hosthash'} = $hosthash;
+
+    if( $version eq '1' )
+    {
+        $snmpV1Hosts{$hosthash} = 1;
+    }
+    
+    # If the object is defined as a map, retrieve the whole map
+    # and cache it.
+
+    if( isHostDead( $collector, $hosthash ) )
+    {
+        return 0;
+    }
+        
+    if( not checkUnreachableRetry( $collector, $hosthash ) )
+    {
+        $cref->{'needsRemapping'}{$token} = 1;
+        return 1;
+    }
+    
+    my $oid = $collector->param($token, 'snmp-object');
+    $oid = expandOidMappings( $collector, $token, $hosthash, $oid );
+
+    if( not $oid )
+    {
+        if( $unreachableHostDeleted{$hosthash} )
+        {
+            # we tried our best, but the target is dead
+            return 0;
+        }
+        else
+        {
+            # we return OK status, to let the storage initiate
+            $cref->{'needsRemapping'}{$token} = 1;
+            return 1;
+        }
+    }
+    elsif( $oid eq 'notfound' )
+    {
+        return 0;
+    }
+
+    # Collector should be able to find the target
+    # by host, port, community, and oid.
+    # There can be several targets with the same host|port|community+oid set.
+
+    $cref->{'targets'}{$hosthash}{$oid}{$token} = 1;
+    $cref->{'activehosts'}{$hosthash} = 1;
+
+    $tref->{'oid'} = $oid;
+
+    $cref->{'oids_per_pdu'}{$hosthash} =
+        $collector->param($token, 'snmp-oids-per-pdu');
+
+    if( $collector->param($token, 'snmp-object-type') eq 'COUNTER64' )
+    {
+        $cref->{'64bit_oid'}{$oid} = 1;
+    }
+
+    if( $collector->param($token, 'snmp-check-sysuptime') eq 'no' )
+    {
+        $cref->{'nosysuptime'}{$hosthash} = 1;
+    }
+
+    if( $collector->param($token, 'snmp-ignore-mib-errors') eq 'yes' )
+    {
+        $cref->{'ignoremiberrors'}{$hosthash}{$oid} = 1;
+    }
+    
+    return 1;
+}
+
+
+sub getHostname
+{
+    my $collector = shift;
+    my $token = shift;
+
+    my $cref = $collector->collectorData( 'snmp' );
+
+    my $hostname = $collector->param($token, 'snmp-host');
+    my $domain = $collector->param($token, 'domain-name');
+    
+    if( length( $domain ) > 0 and
+        index($hostname, '.') < 0 and
+        index($hostname, ':') < 0 )
+    {
+        $hostname .= '.' . $domain;
+    }
+    
+    return $hostname;
+}
+
+
+sub snmpSessionArgs
+{
+    my $collector = shift;
+    my $token = shift;
+    my $hosthash = shift;
+
+    my $cref = $collector->collectorData( 'snmp' );
+    if( defined( $cref->{'snmpargs'}{$hosthash} ) )
+    {
+        return $cref->{'snmpargs'}{$hosthash};
+    }
+
+    my $transport = $collector->param($token, 'snmp-transport') . '/ipv' .
+        $collector->param($token, 'snmp-ipversion');
+    
+    my ($hostname, $port, $community) = split(/\|/o, $hosthash);
+
+    my $version = $collector->param($token, 'snmp-version');
+    my $ret = [ -domain       => $transport,
+                -hostname     => $hostname,
+                -port         => $port,
+                -timeout      => $collector->param($token, 'snmp-timeout'),
+                -retries      => $collector->param($token, 'snmp-retries'),
+                -version      => $version ];
+    
+    foreach my $arg ( qw(-localaddr -localport) )
+    {
+        if( defined( $collector->param($token, 'snmp' . $arg) ) )
+        {
+            push( @{$ret}, $arg, $collector->param($token, 'snmp' . $arg) );
+        }
+    }
+            
+    if( $version eq '1' or $version eq '2c' )
+    {
+        push( @{$ret}, '-community', $community );
+    }
+    else
+    {
+        push( @{$ret}, -username, $community);
+
+        foreach my $arg ( qw(-authkey -authpassword -authprotocol
+                             -privkey -privpassword -privprotocol) )
+        {
+            if( defined( $collector->param($token, 'snmp' . $arg) ) )
+            {
+                push( @{$ret},
+                      $arg, $collector->param($token, 'snmp' . $arg) );
+            }
+        }
+    }
+
+    $cref->{'snmpargs'}{$hosthash} = $ret;
+    return $ret;
+}
+              
+
+
+sub openBlockingSession
+{
+    my $collector = shift;
+    my $token = shift;
+    my $hosthash = shift;
+
+    my $args = snmpSessionArgs( $collector, $token, $hosthash );
+    my ($session, $error) =
+        Net::SNMP->session( @{$args},
+                            -nonblocking  => 0,
+                            -translate    => ['-all', 0, '-octetstring', 1] );
+    if( not defined($session) )
+    {
+        Error('Cannot create SNMP session for ' . $hosthash . ': ' . $error);
+    }
+    else
+    {
+        my $maxmsgsize = $collector->param($token, 'snmp-max-msg-size');
+        if( defined( $maxmsgsize ) and $maxmsgsize > 0 )
+        {
+            $session->max_msg_size( $maxmsgsize );
+        }
+    }
+    
+    return $session;
+}
+
+sub openNonblockingSession
+{
+    my $collector = shift;
+    my $token = shift;
+    my $hosthash = shift;
+
+    my $args = snmpSessionArgs( $collector, $token, $hosthash );
+    
+    my ($session, $error) =
+        Net::SNMP->session( @{$args},
+                            -nonblocking  => 0x1,
+                            -translate    => ['-timeticks' => 0] );
+    if( not defined($session) )
+    {
+        Error('Cannot create SNMP session for ' . $hosthash . ': ' . $error);
+        return undef;
+    }
+    
+    if( $collector->param($token, 'snmp-transport') eq 'udp' )
+    {
+        # We set SO_RCVBUF only once, because Net::SNMP shares
+        # one UDP socket for all sessions.
+        
+        my $sock_name = $session->transport()->sock_name();
+        my $refcount = $Net::SNMP::Transport::SOCKETS->{
+            $sock_name}->[&Net::SNMP::Transport::_SHARED_REFC()];
+                                                                      
+        if( $refcount == 1 )
+        {
+            my $buflen = int($Torrus::Collector::SNMP::RxBuffer);
+            my $socket = $session->transport()->socket();
+            my $ok = $socket->sockopt( SO_RCVBUF, $buflen );
+            if( not $ok )
+            {
+                Error('Could not set SO_RCVBUF to ' .
+                      $buflen . ': ' . $!);
+            }
+            else
+            {
+                Debug('Set SO_RCVBUF to ' . $buflen);
+            }
+        }
+    }
+
+    my $maxmsgsize = $collector->param($token, 'snmp-max-msg-size');
+    if( defined( $maxmsgsize ) and $maxmsgsize > 0 )
+    {
+        $session->max_msg_size( $maxmsgsize );
+        
+    }
+    
+    return $session;
+}
+
+
+sub expandOidMappings
+{
+    my $collector = shift;
+    my $token = shift;
+    my $hosthash = shift;
+    my $oid_in = shift;
+        
+    my $cref = $collector->collectorData( 'snmp' );
+
+    my $oid = $oid_in;
+
+    # Process Map statements
+
+    while( index( $oid, 'M(' ) >= 0 )
+    {
+        if( not $oid =~ /^(.*)M\(\s*([0-9\.]+)\s*,\s*([^\)]+)\)(.*)$/o )
+        {
+            Error("Error in OID mapping syntax: $oid");
+            return undef;
+        }
+
+        my $head = $1;
+        my $map = $2;
+        my $key = $3;
+        my $tail = $4;
+
+        # Remove trailing space from key
+        $key =~ s/\s+$//o;
+
+        my $value =
+            lookupMap( $collector, $token, $hosthash, $map, $key );
+
+        if( defined( $value ) )
+        {
+            if( $value eq 'notfound' )
+            {
+                return 'notfound';
+            }
+            else
+            {
+                $oid = $head . $value . $tail;
+            }
+        }
+        else
+        {
+            return undef;
+        }
+    }
+
+    # process value lookups
+
+    while( index( $oid, 'V(' ) >= 0 )
+    {
+        if( not $oid =~ /^(.*)V\(\s*([0-9\.]+)\s*\)(.*)$/o )
+        {
+            Error("Error in OID value lookup syntax: $oid");
+            return undef;
+        }
+
+        my $head = $1;
+        my $key = $2;
+        my $tail = $4;
+
+        my $value;
+
+        if( not defined( $cref->{'value-lookups'}
+                         {$hosthash}{$key} ) )
+        {
+            # Retrieve the OID value from host
+
+            my $session = openBlockingSession( $collector, $token, $hosthash );
+            if( not defined($session) )
+            {
+                return undef;
+            }
+
+            my $result = $session->get_request( -varbindlist => [$key] );
+            $session->close();
+            if( defined $result and defined($result->{$key}) )
+            {
+                $value = $result->{$key};
+                $cref->{'value-lookups'}{$hosthash}{$key} = $value;
+            }
+            else
+            {
+                Error("Error retrieving $key from $hosthash: " .
+                      $session->error());
+                probablyDead( $collector, $hosthash );
+                return undef;
+            }
+        }
+        else
+        {
+            $value =
+                $cref->{'value-lookups'}{$hosthash}{$key};
+        }
+        if( defined( $value ) )
+        {
+            $oid = $head . $value . $tail;
+        }
+        else
+        {
+            return 'notfound';
+        }
+    }
+
+    # Debug('OID expanded: ' . $oid_in . ' -> ' . $oid');
+    return $oid;
+}
+
+# Look up table index in a map by value
+
+sub lookupMap
+{
+    my $collector = shift;
+    my $token = shift;
+    my $hosthash = shift;
+    my $map = shift;
+    my $key = shift;
+
+    my $cref = $collector->collectorData( 'snmp' );
+    my $maphash = join('#', $hosthash, $map);
+    
+    if( not defined( $maps{$hosthash}{$map} ) )
+    {
+        my $ret;
+
+        if( defined( $oldMaps{$hosthash}{$map} ) and
+            defined( $key ) )
+        {
+            $ret = $oldMaps{$hosthash}{$map}{$key};
+        }
+        
+        if( $mapLookupScheduled{$maphash} )
+        {
+            return $ret;
+        }
+
+        if( scalar(@mappingSessions) >=
+            $Torrus::Collector::SNMP::maxSessionsPerDispatcher )
+        {
+            snmp_dispatcher();
+            @mappingSessions = ();
+            %mapLookupScheduled = ();
+        }
+
+        # Retrieve map from host
+        Debug('Retrieving map ' . $map . ' from ' . $hosthash);
+
+        my $session = openNonblockingSession( $collector, $token, $hosthash );
+        if( not defined($session) )
+        {
+            return $ret;
+        }
+        else
+        {
+            push( @mappingSessions, $session );
+        }
+
+        # Retrieve the map table
+
+        $session->get_table( -baseoid => $map,
+                             -callback => [\&mapLookupCallback,
+                                           $collector, $hosthash, $map] );
+
+        $mapLookupScheduled{$maphash} = 1;
+
+        if( not $snmpV1Hosts{$hosthash} )
+        {
+            $mapsExpire{$maphash} =
+                int( time() + $mapsRefreshPeriod +
+                     rand( $mapsRefreshPeriod * $mapsRefreshRandom ) );
+        }
+        
+        return $ret;
+    }
+
+    if( defined( $key ) )
+    {
+        my $value = $maps{$hosthash}{$map}{$key};
+        if( not defined $value )
+        {
+            Error("Cannot find value $key in map $map for $hosthash in ".
+                  $collector->path($token));
+            if( defined ( $maps{$hosthash}{$map} ) )
+            {
+                Error("Current map follows");
+                while( my($key, $val) = each
+                       %{$maps{$hosthash}{$map}} )
+                {
+                    Error("'$key' => '$val'");
+                }
+            }
+            return 'notfound';
+        }
+        else
+        {
+            if( not $snmpV1Hosts{$hosthash} )
+            {
+                $cref->{'mapsDependentTokens'}{$maphash}{$token} = 1;
+                $cref->{'mapsRelatedMaps'}{$token}{$maphash} = 1;
+            }
+            
+            return $value;
+        }
+    }
+    else
+    {
+        return undef;
+    }
+}
+
+
+sub mapLookupCallback
+{
+    my $session = shift;
+    my $collector = shift;
+    my $hosthash = shift;
+    my $map = shift;
+
+    &Torrus::DB::checkInterrupted();
+    
+    Debug('Received mapping PDU from ' . $hosthash);
+
+    my $result = $session->var_bind_list();
+    if( defined $result )
+    {
+        my $preflen = length($map) + 1;
+        
+        while( my( $oid, $key ) = each %{$result} )
+        {
+            my $val = substr($oid, $preflen);
+            $maps{$hosthash}{$map}{$key} = $val;
+            # Debug("Map $map discovered: '$key' -> '$val'");
+        }
+    }
+    else
+    {
+        Error("Error retrieving table $map from $hosthash: " .
+              $session->error());
+        $session->close();
+        probablyDead( $collector, $hosthash );
+        return undef;
+    }    
+}
+
+sub activeMappingSessions
+{
+    return scalar( @mappingSessions );
+}
+    
+# The target host is unreachable. We try to reach it few more times and
+# give it the final diagnose.
+
+sub probablyDead
+{
+    my $collector = shift;
+    my $hosthash = shift;
+
+    my $cref = $collector->collectorData( 'snmp' );
+
+    # Stop all collection for this host, until next initTargetAttributes
+    # is successful
+    delete $cref->{'activehosts'}{$hosthash};
+
+    my $probablyAlive = 1;
+
+    if( defined( $hostUnreachableSeen{$hosthash} ) )
+    {
+        if( $Torrus::Collector::SNMP::unreachableTimeout > 0 and
+            time() -
+            $hostUnreachableSeen{$hosthash} >
+            $Torrus::Collector::SNMP::unreachableTimeout )
+        {
+            $probablyAlive = 0;
+        }
+    }
+    else
+    {
+        $hostUnreachableSeen{$hosthash} = time();
+
+        if( defined( $db_failures ) )
+        {
+            $db_failures->host_failure('unreachable', $hosthash);
+            $db_failures->set_counter('unreachable',
+                                      scalar( keys %hostUnreachableSeen));
+        }
+    }
+
+    if( $probablyAlive )
+    {
+        Info('Target host is unreachable. Will try again later: ' . $hosthash);
+    }
+    else
+    {
+        # It is dead indeed. Delete all tokens associated with this host
+        Info('Target host is unreachable during last ' .
+             $Torrus::Collector::SNMP::unreachableTimeout .
+             ' seconds. Giving it up: ' . $hosthash);
+        my @deleteTargets = ();
+        while( my ($oid, $ref1) =
+               each %{$cref->{'targets'}{$hosthash}} )
+        {
+            while( my ($token, $dummy) = each %{$ref1} )
+            {
+                push( @deleteTargets, $token );
+            }
+        }
+        
+        Debug('Deleting ' . scalar( @deleteTargets ) . ' tokens');
+        foreach my $token ( @deleteTargets )
+        {
+            $collector->deleteTarget($token);
+        }
+                
+        delete $hostUnreachableSeen{$hosthash};
+        delete $hostUnreachableRetry{$hosthash};
+        $unreachableHostDeleted{$hosthash} = 1;
+
+        if( defined( $db_failures ) )
+        {
+            $db_failures->host_failure('deleted', $hosthash);
+            $db_failures->set_counter('unreachable',
+                                      scalar( keys %hostUnreachableSeen));
+            $db_failures->set_counter('deleted',
+                                      scalar( keys %unreachableHostDeleted));
+        }
+    }
+    
+    return $probablyAlive;
+}
+
+# Return false if the try is too early
+
+sub checkUnreachableRetry
+{
+    my $collector = shift;
+    my $hosthash = shift;
+
+    my $cref = $collector->collectorData( 'snmp' );
+
+    my $ret = 1;
+    if( $hostUnreachableSeen{$hosthash} )
+    {
+        my $lastRetry = $hostUnreachableRetry{$hosthash};
+
+        if( not defined( $lastRetry ) )
+        {
+            $lastRetry = $hostUnreachableSeen{$hosthash};
+        }
+            
+        if( time() < $lastRetry +
+            $Torrus::Collector::SNMP::unreachableRetryDelay )
+        {
+            $ret = 0;
+        }
+        else
+        {
+            $hostUnreachableRetry{$hosthash} = time();
+        }            
+    }
+    
+    return $ret;
+}
+
+
+sub isHostDead
+{
+    my $collector = shift;
+    my $hosthash = shift;
+
+    my $cref = $collector->collectorData( 'snmp' );
+    return $unreachableHostDeleted{$hosthash};
+}
+
+
+sub hostReachableAgain
+{
+    my $collector = shift;
+    my $hosthash = shift;
+    
+    my $cref = $collector->collectorData( 'snmp' );
+    if( exists( $hostUnreachableSeen{$hosthash} ) )
+    {
+        delete $hostUnreachableSeen{$hosthash};
+        if( defined( $db_failures ) )
+        {
+            $db_failures->remove_host($hosthash);            
+            $db_failures->set_counter('unreachable',
+                                      scalar( keys %hostUnreachableSeen));
+        }
+    }
+}
+
+
+# Callback executed by Collector
+
+sub deleteTarget
+{
+    my $collector = shift;
+    my $token = shift;
+
+    my $tref = $collector->tokenData( $token );
+    my $cref = $collector->collectorData( 'snmp' );
+
+    my $hosthash = $tref->{'hosthash'};    
+    my $oid = $tref->{'oid'};
+
+    delete $cref->{'targets'}{$hosthash}{$oid}{$token};
+    if( not %{$cref->{'targets'}{$hosthash}{$oid}} )
+    {
+        delete $cref->{'targets'}{$hosthash}{$oid};
+
+        if( not %{$cref->{'targets'}{$hosthash}} )
+        {
+            delete $cref->{'targets'}{$hosthash};
+        }
+    }
+
+    delete $cref->{'needsRemapping'}{$token};
+    
+    foreach my $maphash ( keys %{$cref->{'mapsRelatedMaps'}{$token}} )
+    {
+        delete $cref->{'mapsDependentTokens'}{$maphash}{$token};
+    }
+    delete $cref->{'mapsRelatedMaps'}{$token};
+}
+
+# Main collector cycle
+
+$Torrus::Collector::runCollector{'snmp'} =
+    \&Torrus::Collector::SNMP::runCollector;
+
+sub runCollector
+{
+    my $collector = shift;
+    my $cref = shift;
+
+    # Info(sprintf('runCollector() Offset: %d, active hosts: %d, maps: %d',
+    #              $collector->offset(),
+    #              scalar( keys %{$cref->{'activehosts'}} ),
+    #              scalar(keys %maps)));
+    
+    # Create one SNMP session per host address.
+    # We assume that version, timeout and retries are the same
+    # within one address
+
+    # We limit the number of sessions per snmp_dispatcher run
+    # because of some strange bugs: with more than 400 sessions per
+    # dispatcher, some requests are not sent out
+
+    my @hosts = keys %{$cref->{'activehosts'}};
+    
+    while( scalar(@mappingSessions) + scalar(@hosts) > 0 )
+    {
+        my @batch = ();
+        while( ( scalar(@mappingSessions) + scalar(@batch) <
+                 $Torrus::Collector::SNMP::maxSessionsPerDispatcher )
+               and
+               scalar(@hosts) > 0 )
+        {
+            push( @batch, pop( @hosts ) );
+        }
+
+        &Torrus::DB::checkInterrupted();
+
+        my @sessions;
+
+        foreach my $hosthash ( @batch )
+        {
+            my @oids = sort keys %{$cref->{'targets'}{$hosthash}};
+
+            # Info(sprintf('Host %s: %d OIDs',
+            #              $hosthash,
+            #              scalar(@oids)));
+            
+            # Find one representative token for the host
+            
+            if( scalar( @oids ) == 0 )
+            {
+                next;
+            }
+        
+            my @reptokens = keys %{$cref->{'targets'}{$hosthash}{$oids[0]}};
+            if( scalar( @reptokens ) == 0 )
+            {
+                next;
+            }
+            my $reptoken = $reptokens[0];
+            
+            my $session =
+                openNonblockingSession( $collector, $reptoken, $hosthash );
+            
+            &Torrus::DB::checkInterrupted();
+            
+            if( not defined($session) )
+            {
+                next;
+            }
+            else
+            {
+                Debug('Created SNMP session for ' . $hosthash);
+                push( @sessions, $session );
+            }
+            
+            my $oids_per_pdu = $cref->{'oids_per_pdu'}{$hosthash};
+
+            my @pdu_oids = ();
+            my $delay = 0;
+            
+            while( scalar( @oids ) > 0 )
+            {
+                my $oid = shift @oids;
+                push( @pdu_oids, $oid );
+
+                if( scalar( @oids ) == 0 or
+                    ( scalar( @pdu_oids ) >= $oids_per_pdu ) )
+                {
+                    if( not $cref->{'nosysuptime'}{$hosthash} )
+                    {
+                        # We insert sysUpTime into every PDU, because
+                        # we need it in further processing
+                        push( @pdu_oids, $sysUpTime );
+                    }
+                    
+                    if( Torrus::Log::isDebug() )
+                    {
+                        Debug('Sending SNMP PDU to ' . $hosthash . ':');
+                        foreach my $oid ( @pdu_oids )
+                        {
+                            Debug($oid);
+                        }
+                    }
+
+                    # Generate the list of tokens that form this PDU
+                    my $pdu_tokens = {};
+                    foreach my $oid ( @pdu_oids )
+                    {
+                        if( defined( $cref->{'targets'}{$hosthash}{$oid} ) )
+                        {
+                            foreach my $token
+                                ( keys %{$cref->{'targets'}{$hosthash}{$oid}} )
+                            {
+                                $pdu_tokens->{$oid}{$token} = 1;
+                            }
+                        }
+                    }
+                    my $result =
+                        $session->
+                        get_request( -delay => $delay,
+                                     -callback =>
+                                     [ \&Torrus::Collector::SNMP::callback,
+                                       $collector, $pdu_tokens, $hosthash ],
+                                     -varbindlist => \@pdu_oids );
+                    if( not defined $result )
+                    {
+                        Error("Cannot create SNMP request: " .
+                              $session->error);
+                    }
+                    @pdu_oids = ();
+                    $delay += 0.01;
+                }
+            }
+        }
+        
+        &Torrus::DB::checkInterrupted();
+        
+        snmp_dispatcher();
+
+        # Check if there were pending map lookup sessions
+        
+        if( scalar( @mappingSessions ) > 0 )
+        {
+            @mappingSessions = ();
+            %mapLookupScheduled = ();
+        }
+    }
+}
+
+
+sub callback
+{
+    my $session = shift;
+    my $collector = shift;
+    my $pdu_tokens = shift;
+    my $hosthash = shift;
+
+    &Torrus::DB::checkInterrupted();
+    
+    my $cref = $collector->collectorData( 'snmp' );
+
+    Debug('SNMP Callback executed for ' . $hosthash);
+
+    if( not defined( $session->var_bind_list() ) )
+    {
+        Error('SNMP Error for ' . $hosthash . ': ' . $session->error() .
+              ' when retrieving ' . join(' ', sort keys %{$pdu_tokens}));
+
+        probablyDead( $collector, $hosthash );
+        
+        # Clear the mapping
+        delete $maps{$hosthash};
+        foreach my $oid ( keys %{$pdu_tokens} )
+        {
+            foreach my $token ( keys %{$pdu_tokens->{$oid}} )
+            {
+                $cref->{'needsRemapping'}{$token} = 1;
+            }
+        }
+        return;
+    }
+    else
+    {
+        hostReachableAgain( $collector, $hosthash );
+    }
+
+    my $timestamp = time();
+
+    my $checkUptime = not $cref->{'nosysuptime'}{$hosthash};
+    my $doSetValue = 1;
+    
+    my $uptime = 0;
+
+    if( $checkUptime )
+    {
+        my $uptimeTicks = $session->var_bind_list()->{$sysUpTime};
+        if( defined $uptimeTicks )
+        {
+            $uptime = $uptimeTicks / 100;
+            Debug('Uptime: ' . $uptime);
+        }
+        else
+        {
+            Error('Did not receive sysUpTime for ' . $hosthash);
+        }
+
+        if( $uptime < $collector->period() or
+            ( defined($cref->{'knownUptime'}{$hosthash})
+              and
+              $uptime + $collector->period() <
+              $cref->{'knownUptime'}{$hosthash} ) )
+        {
+            # The agent has reloaded. Clean all maps and push UNDEF
+            # values to the storage
+            
+            Info('Agent rebooted: ' . $hosthash);
+            delete $maps{$hosthash};
+
+            $timestamp -= $uptime;
+            foreach my $oid ( keys %{$pdu_tokens} )
+            {
+                foreach my $token ( keys %{$pdu_tokens->{$oid}} )
+                {
+                    $collector->setValue( $token, 'U', $timestamp, $uptime );
+                    $cref->{'needsRemapping'}{$token} = 1;
+                }
+            }
+            
+            $doSetValue = 0;
+        }
+        $cref->{'knownUptime'}{$hosthash} = $uptime;
+    }
+    
+    if( $doSetValue )
+    {
+        while( my ($oid, $value) = each %{ $session->var_bind_list() } )
+        {
+            # Debug("OID=$oid, VAL=$value");
+            if( $value eq 'noSuchObject' or
+                $value eq 'noSuchInstance' or
+                $value eq 'endOfMibView' )
+            {
+                if( not $cref->{'ignoremiberrors'}{$hosthash}{$oid} )
+                {
+                    Error("Error retrieving $oid from $hosthash: $value");
+                    
+                    foreach my $token ( keys %{$pdu_tokens->{$oid}} )
+                    {
+                        if( defined( $db_failures ) )
+                        {
+                            $db_failures->mib_error
+                                ($hosthash, $collector->path($token));
+                        }
+
+                        $collector->deleteTarget($token);
+                    }
+                }
+            }
+            else
+            {
+                if( $cref->{'64bit_oid'}{$oid} )
+                {
+                    $value = Math::BigInt->new($value);
+                }
+
+                foreach my $token ( keys %{$pdu_tokens->{$oid}} )
+                {
+                    $collector->setValue( $token, $value,
+                                          $timestamp, $uptime );
+                }
+            }
+        }
+    }
+}
+
+
+# Execute this after the collector has finished
+
+$Torrus::Collector::postProcess{'snmp'} =
+    \&Torrus::Collector::SNMP::postProcess;
+
+sub postProcess
+{
+    my $collector = shift;
+    my $cref = shift;
+
+    # It could happen that postProcess is called for a collector which
+    # has no targets, and therefore it's the only place where we can
+    # initialize these variables
+    
+    if( not defined( $cref->{'mapsLastExpireChecked'} ) )
+    {
+        $cref->{'mapsLastExpireChecked'} = 0;
+    }
+
+    if( not defined( $cref->{'mapsRefreshed'} ) )
+    {
+        $cref->{'mapsRefreshed'} = [];
+    }
+    
+    # look if some maps are ready after last expiration check
+    if( scalar( @{$cref->{'mapsRefreshed'}} ) > 0 )
+    {
+        foreach my $maphash ( @{$cref->{'mapsRefreshed'}} )
+        {
+            foreach my $token
+                ( keys %{$cref->{'mapsDependentTokens'}{$maphash}} )
+            {
+                $cref->{'needsRemapping'}{$token} = 1;
+            }
+        }
+        $cref->{'mapsRefreshed'} = [];
+    }
+
+    my $now = time();
+    
+    if( $cref->{'mapsLastExpireChecked'} + $mapsExpireCheckPeriod <= $now )
+    {
+        $cref->{'mapsLastExpireChecked'} = $now;
+        
+        # Check the maps expiration and arrange lookup for expired
+        
+        while( my ( $maphash, $expire ) = each %mapsExpire )
+        {
+            if( $expire <= $now and not $mapLookupScheduled{$maphash} )
+            {
+                &Torrus::DB::checkInterrupted();
+
+                my ( $hosthash, $map ) = split( /\#/o, $maphash );
+
+                if( $unreachableHostDeleted{$hosthash} )
+                {
+                    # This host is no longer polled. Remove the leftovers
+                    
+                    delete $mapsExpire{$maphash};
+                    delete $maps{$hosthash};
+                }
+                else
+                {
+                    # Find one representative token for the map
+                    my @tokens =
+                        keys %{$cref->{'mapsDependentTokens'}{$maphash}};
+                    if( scalar( @tokens ) == 0 )
+                    {
+                        next;
+                    }
+                    my $reptoken = $tokens[0];
+
+                    # save the map for the time of refresh                    
+                    $oldMaps{$hosthash}{$map} = $maps{$hosthash}{$map};
+                    delete $maps{$hosthash}{$map};
+
+                    # this will schedule the map retrieval for the next
+                    # collector cycle
+                    Debug('Refreshing map: ' . $maphash);
+                
+                    lookupMap( $collector, $reptoken,
+                               $hosthash, $map, undef );
+
+                    # After the next collector period, the maps will be
+                    # ready and tokens may be updated without losing the data
+                    push( @{$cref->{'mapsRefreshed'}}, $maphash );
+                }
+            }                
+        }
+    }
+    
+    foreach my $token ( keys %{$cref->{'needsRemapping'}} )
+    {
+        &Torrus::DB::checkInterrupted();
+
+        delete $cref->{'needsRemapping'}{$token};
+        if( not Torrus::Collector::SNMP::initTargetAttributes
+            ( $collector, $token ) )
+        {
+            $collector->deleteTarget($token);
+        }
+    }    
+}
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Collector/SNMP_Params.pm b/torrus/perllib/Torrus/Collector/SNMP_Params.pm
new file mode 100644
index 000000000..8b05264ea
--- /dev/null
+++ b/torrus/perllib/Torrus/Collector/SNMP_Params.pm
@@ -0,0 +1,149 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: SNMP_Params.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Collector::SNMP_Params;
+
+###  Initialize the configuration validator with module-specific parameters
+###  Moved to a separate module to speed up the compiler initialization
+
+my %validatorLeafParams =
+    (
+     'snmp-ipversion'     => {'4'   => undef, '6'   => undef},
+     'snmp-transport'     => {'udp' => undef, 'tcp' => undef},
+     'snmp-host'          => undef,
+     'snmp-port'          => undef,
+     '+snmp-localaddr'    => undef,
+     '+snmp-localport'    => undef,
+     '+domain-name'       => undef,     
+     'snmp-object'        => undef,
+     'snmp-version'       => { '1'  => { 'snmp-community'     => undef },
+                               '2c' => { 'snmp-community'     => undef },
+                               '3'  => {
+                                   'snmp-username' => undef,
+                                   '+snmp-authkey' => undef,
+                                   '+snmp-authpassword' => undef,
+                                   '+snmp-authprotocol' => {
+                                       'md5' => undef,
+                                       'sha' => undef },
+                                   '+snmp-privkey' => undef,
+                                   '+snmp-privpassword' => undef,
+                                   '+snmp-privprotocol' => {
+                                       'des'       => undef,
+                                       'aes128cfb' => undef,
+                                       '3desede'   => undef } } },
+     'snmp-timeout'       => undef,
+     'snmp-retries'       => undef,
+     'snmp-oids-per-pdu'  => undef,
+     '+snmp-object-type'  => { 'OTHER'     => undef,
+                               'COUNTER64' => undef },
+     '+snmp-check-sysuptime' => { 'yes' => undef,
+                                   'no'  => undef },
+     '+snmp-max-msg-size' => undef,
+     '+snmp-ignore-mib-errors' => undef,
+     );
+
+sub initValidatorLeafParams
+{
+    my $hashref = shift;
+    $hashref->{'ds-type'}{'collector'}{'collector-type'}{'snmp'} =
+        \%validatorLeafParams;
+}
+
+
+my %admInfoLeafParams =
+    (
+     'snmp-ipversion'     => undef,
+     'snmp-transport'     => undef,
+     'snmp-host'          => undef,
+     'snmp-port'          => undef,
+     'snmp-localaddr'     => undef,
+     'snmp-localport'     => undef,
+     'domain-name'        => undef,
+     'snmp-community'     => undef,
+     'snmp-username'      => undef,
+     'snmp-authkey'       => undef,
+     'snmp-authpassword'  => undef,
+     'snmp-authprotocol'  => undef,
+     'snmp-privkey'       => undef,
+     'snmp-privpassword'  => undef,
+     'snmp-privprotocol'  => undef,
+     'snmp-object'        => undef,
+     'snmp-version'       => undef,
+     'snmp-timeout'       => undef,
+     'snmp-retries'       => undef,
+     'snmp-oids-per-pdu'  => undef,
+     'snmp-object-type'   => undef,
+     'snmp-check-sysuptime' => undef,
+     'snmp-max-msg-size' => undef,
+     'snmp-ignore-mib-errors' => undef,
+     );
+
+
+my %admInfoParamCategories =
+    (
+     'snmp-ipversion'     => 'SNMP',
+     'snmp-transport'     => 'SNMP',
+     'snmp-host'          => 'SNMP',
+     'snmp-port'          => 'SNMP',
+     'snmp-localaddr'     => 'SNMP',
+     'snmp-localport'     => 'SNMP',
+     'domain-name'        => 'SNMP',
+     'snmp-community'     => 'SNMP',
+     'snmp-username'      => 'SNMP',
+     'snmp-authkey'       => 'SNMP',
+     'snmp-authpassword'  => 'SNMP',
+     'snmp-authprotocol'  => 'SNMP',
+     'snmp-privkey'       => 'SNMP',
+     'snmp-privpassword'  => 'SNMP',
+     'snmp-privprotocol'  => 'SNMP',     
+     'snmp-object'        => 'SNMP',
+     'snmp-version'       => 'SNMP',
+     'snmp-timeout'       => 'SNMP',
+     'snmp-retries'       => 'SNMP',
+     'snmp-oids-per-pdu'  => 'SNMP',
+     'snmp-object-type'   => 'SNMP',
+     'snmp-check-sysuptime' => 'SNMP',
+     'snmp-max-msg-size'  => 'SNMP',
+     'snmp-ignore-mib-errors' => 'SNMP'
+     );
+
+
+sub initAdmInfo
+{
+    my $map = shift;
+    my $categories = shift;
+    
+    $map->{'ds-type'}{'collector'}{'collector-type'}{'snmp'} =
+        \%admInfoLeafParams;
+    
+    while( ($pname, $category) = each %admInfoParamCategories )
+    {
+        $categories->{$pname} = $category;
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ConfigBuilder.pm b/torrus/perllib/Torrus/ConfigBuilder.pm
new file mode 100644
index 000000000..7762c00dc
--- /dev/null
+++ b/torrus/perllib/Torrus/ConfigBuilder.pm
@@ -0,0 +1,529 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ConfigBuilder.pm,v 1.1 2010-12-27 00:03:40 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# XML configuration builder
+
+package Torrus::ConfigBuilder;
+
+use strict;
+use XML::LibXML;
+use IO::File;
+
+use Torrus::Log;
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    bless $self, $class;
+
+    my $doc = XML::LibXML->createDocument( "1.0", "UTF-8" );
+    my $root = $doc->createElement('configuration');
+    $doc->setDocumentElement( $root );
+    $self->{'doc'} = $doc;
+    $self->{'docroot'} = $root;
+
+    $root->appendChild($doc->createComment('DO NOT EDIT THIS FILE'));
+
+    my $dsnode = $doc->createElement('datasources');
+    $self->{'docroot'}->appendChild( $dsnode );
+    $self->{'datasources'} = $dsnode;
+
+    $self->{'required_templates'} = {};
+
+    $self->{'statistics'} = {};
+
+    $self->{'registry_overlays'} = [];
+    
+    return $self;
+}
+
+
+sub setRegistryOverlays
+{
+    my $self = shift;
+    
+    $self->{'registry_overlays'} = [];
+    push( @{$self->{'registry_overlays'}}, @_ );
+}
+
+
+sub lookupRegistry
+{
+    my $self = shift;
+    my $template = shift;
+
+    my $ret = undef;
+
+    foreach my $regOverlay ( @{$self->{'registry_overlays'}} )
+    {
+        if( defined( $regOverlay->{$template} ) )
+        {
+            $ret = $regOverlay->{$template};
+        }
+    }
+    
+    if( not defined( $ret ) and
+        defined( $Torrus::ConfigBuilder::templateRegistry{$template} ) )
+    {
+        $ret = $Torrus::ConfigBuilder::templateRegistry{$template};
+    }
+    
+    if( not defined( $ret ) )
+    {
+        if( scalar( %Torrus::ConfigBuilder::templateRegistry ) > 0 )
+        {
+            Warn('Template ' . $template .
+                 ' is not listed in ConfigBuilder template registry');
+        }
+    }
+
+    return $ret;
+}
+    
+
+
+
+sub addCreatorInfo
+{
+    my $self = shift;
+    my $creatorInfo = shift;
+
+    my $creatorNode = $self->{'doc'}->createElement('creator-info');
+    $creatorNode->appendText( $creatorInfo );
+    $self->{'docroot'}->insertBefore( $creatorNode, $self->{'datasources'} );
+}
+
+
+sub addRequiredFiles
+{
+    my $self = shift;
+
+    foreach my $file ( $self->requiredFiles() )
+    {
+        $self->addFileInclusion( $file );
+    }
+}
+
+
+sub addFileInclusion
+{
+    my $self = shift;
+    my $file = shift;
+
+    my $node = $self->{'doc'}->createElement('include');
+    $node->setAttribute( 'filename', $file );
+    $self->{'docroot'}->insertBefore( $node, $self->{'datasources'} );
+}
+
+
+sub startDefinitions
+{
+    my $self = shift;
+
+    my $node = $self->{'doc'}->createElement('definitions');
+    $self->{'docroot'}->insertBefore( $node, $self->{'datasources'} );
+    return $node;
+}
+
+
+sub addDefinition
+{
+    my $self = shift;
+    my $definitionsNode = shift;;
+    my $name = shift;
+    my $value = shift;
+
+    my $node = $self->{'doc'}->createElement('def');
+    $node->setAttribute( 'name', $name );
+    $node->setAttribute( 'value', $value );
+    $definitionsNode->appendChild( $node );
+}
+
+
+sub startParamProps
+{
+    my $self = shift;
+
+    my $node = $self->{'doc'}->createElement('param-properties');
+    $self->{'docroot'}->insertBefore( $node, $self->{'datasources'} );
+    return $node;
+}
+
+
+sub addParamProp
+{
+    my $self = shift;
+    my $propsNode = shift;;
+    my $param = shift;
+    my $prop = shift;
+    my $value = shift;
+
+    my $node = $self->{'doc'}->createElement('prop');
+    $node->setAttribute( 'param', $param );
+    $node->setAttribute( 'prop', $prop );
+    $node->setAttribute( 'value', $value );
+    $propsNode->appendChild( $node );
+}
+
+
+
+sub addSubtree
+{
+    my $self = shift;
+    my $parentNode = shift;
+    my $subtreeName = shift;
+    my $params = shift;      # hash reference with param name-value pairs
+    my $templates = shift;   # array reference with template names
+
+    return $self->addChildElement( 0, $parentNode, $subtreeName,
+                                   $params, $templates );
+}
+
+
+sub addLeaf
+{
+    my $self = shift;
+    my $parentNode = shift;
+    my $leafName = shift;
+    my $params = shift;      # hash reference with param name-value pairs
+    my $templates = shift;   # array reference with template names
+
+    return $self->addChildElement( 1, $parentNode, $leafName,
+                                   $params, $templates );
+}
+
+
+sub addChildElement
+{
+    my $self = shift;
+    my $isLeaf = shift;
+    my $parentNode = shift;
+    my $childName = shift;
+    my $params = shift;
+    my $templates = shift;
+
+    my $doc = $self->{'doc'};
+
+    if( not ref( $parentNode ) )
+    {
+        $parentNode = $self->{'datasources'};
+    }
+
+    my $childNode = $doc->createElement( $isLeaf ? 'leaf' : 'subtree' );
+    $childNode->setAttribute( 'name', $childName );
+    $childNode = $parentNode->appendChild( $childNode );
+
+    if( ref( $templates ) )
+    {
+        foreach my $tmpl ( sort @{$templates} )
+        {
+            $self->addTemplateApplication( $childNode, $tmpl );
+        }
+    }
+
+    $self->addParams( $childNode, $params );
+
+    return $childNode;
+}
+
+
+sub getChildSubtree
+{
+    my $self = shift;
+    my $parentNode = shift;
+    my $childName = shift;
+
+    if( not ref( $parentNode ) )
+    {
+        $parentNode = $self->{'datasources'};
+    }
+    
+    my @subtrees =
+        $parentNode->findnodes( 'subtree[@name="' . $childName . '"]' );
+    if( not @subtrees )
+    {
+        Error('Cannot find subtree named ' . $childName);
+        return undef;
+    }
+    return $subtrees[0];
+}
+
+
+# Reconstruct the path to the given subtree or leaf
+sub getElementPath
+{
+    my $self = shift;
+    my $node = shift;
+
+    my $path = '';
+    if( $node->nodeName() eq 'subtree' )
+    {
+        $path = '/';
+    }
+
+    while( not $node->isSameNode( $self->{'datasources'} ) )
+    {
+        $path = '/' . $node->getAttribute( 'name' ) . $path;
+        $node = $node->parentNode();
+    }
+    
+    return $path;
+}
+
+
+sub getTopSubtree
+{
+    my $self = shift;
+    return $self->{'datasources'};
+}
+
+
+sub addTemplateApplication
+{
+    my $self = shift;
+    my $parentNode = shift;
+    my $template = shift;
+
+    if( not ref( $parentNode ) )
+    {
+        $parentNode = $self->{'datasources'};
+    }
+
+    my $found = 0;
+
+    my $reg = $self->lookupRegistry( $template );
+    if( defined( $reg ) )
+    {
+        $self->{'required_templates'}{$template} = 1;
+        my $name = $reg->{'name'};
+        if( defined( $name ) )
+        {
+            $template = $name;
+        }
+    }
+    
+    my $tmplNode = $self->{'doc'}->createElement( 'apply-template' );
+    $tmplNode->setAttribute( 'name', $template );
+    $parentNode->appendChild( $tmplNode );
+}
+
+
+sub addParams
+{
+    my $self = shift;
+    my $parentNode = shift;
+    my $params = shift;
+
+    if( ref( $params ) )
+    {
+        foreach my $paramName ( sort keys %{$params} )
+        {
+            $self->addParam( $parentNode, $paramName, $params->{$paramName} );
+        }
+    }
+}
+
+
+sub addParam
+{
+    my $self = shift;
+    my $parentNode = shift;
+    my $param = shift;
+    my $value = shift;
+
+    if( not ref( $parentNode ) )
+    {
+        $parentNode = $self->{'datasources'};
+    }
+
+    my $paramNode = $self->{'doc'}->createElement( 'param' );
+    $paramNode->setAttribute( 'name', $param );
+    $paramNode->setAttribute( 'value', $value );
+    $parentNode->appendChild( $paramNode );
+}
+
+
+sub addAlias
+{
+    my $self = shift;
+    my $parentNode = shift;
+    my $aliasPath = shift;
+
+    if( not ref( $parentNode ) ) # I hope nobody would need this
+    {
+        $parentNode = $self->{'datasources'};
+    }
+
+    my $aliasNode = $self->{'doc'}->createElement( 'alias' );
+    $aliasNode->appendText( $aliasPath );
+    $parentNode->appendChild( $aliasNode );
+}
+
+
+sub setVar
+{
+    my $self = shift;
+    my $parentNode = shift;
+    my $name = shift;
+    my $value = shift;
+
+    my $setvarNode = $self->{'doc'}->createElement( 'setvar' );
+    $setvarNode->setAttribute( 'name', $name );
+    $setvarNode->setAttribute( 'value', $value );
+    $parentNode->appendChild( $setvarNode );
+}
+    
+    
+
+sub startMonitors
+{
+    my $self = shift;
+
+    my $node = $self->{'doc'}->createElement('monitors');
+    $self->{'docroot'}->appendChild( $node );
+    return $node;
+}
+
+
+sub addMonitorAction
+{
+    my $self = shift;
+    my $monitorsNode = shift;;
+    my $name = shift;
+    my $params = shift;
+
+    my $node = $self->{'doc'}->createElement('action');
+    $node->setAttribute( 'name', $name );
+    $monitorsNode->appendChild( $node );
+
+    $self->addParams( $node, $params );
+}
+
+
+sub addMonitor
+{
+    my $self = shift;
+    my $monitorsNode = shift;;
+    my $name = shift;
+    my $params = shift;
+
+    my $node = $self->{'doc'}->createElement('monitor');
+    $node->setAttribute( 'name', $name );
+    $monitorsNode->appendChild( $node );
+
+    $self->addParams( $node, $params );
+}
+
+
+sub startTokensets
+{
+    my $self = shift;
+
+    my $node = $self->{'doc'}->createElement('token-sets');
+    $self->{'docroot'}->appendChild( $node );
+    return $node;
+}
+
+
+sub addTokenset
+{
+    my $self = shift;
+    my $tsetsNode = shift;;
+    my $name = shift;
+    my $params = shift;
+
+    my $node = $self->{'doc'}->createElement('token-set');
+    $node->setAttribute( 'name', $name );
+    $tsetsNode->appendChild( $node );
+
+    $self->addParams( $node, $params );
+}
+
+
+sub addStatistics
+{
+    my $self = shift;
+
+    foreach my $stats ( sort keys %{$self->{'statistics'}} )
+    {
+        my $node = $self->{'doc'}->createElement('configbuilder-statistics');
+        $node->setAttribute( 'category', $stats );
+        $node->setAttribute( 'value', $self->{'statistics'}{$stats} );
+        $self->{'docroot'}->appendChild( $node );
+    }
+}
+
+
+
+sub requiredFiles
+{
+    my $self = shift;
+
+    my %files;
+    foreach my $template ( keys %{$self->{'required_templates'}} )
+    {
+        my $file;
+        my $reg = $self->lookupRegistry( $template );
+        if( defined( $reg ) )
+        {
+            $file = $reg->{'source'};
+        }
+        
+        if( defined( $file ) )
+        {
+            $files{$file} = 1;
+        }
+        else
+        {
+            Error('Source file is not defined for template ' . $template .
+                  ' in ConfigBuilder template registry');
+        }
+    }
+    return( sort keys %files );
+}
+
+
+
+sub toFile
+{
+    my $self = shift;
+    my $filename = shift;
+
+    my $fh = new IO::File('> ' . $filename);
+    if( defined( $fh ) )
+    {
+        my $ok = $self->{'doc'}->toFH( $fh, 2 );
+        $fh->close();
+        return $ok;
+    }
+    else
+    {
+        return undef;
+    }
+}
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ConfigTree.pm b/torrus/perllib/Torrus/ConfigTree.pm
new file mode 100644
index 000000000..efa4aaff8
--- /dev/null
+++ b/torrus/perllib/Torrus/ConfigTree.pm
@@ -0,0 +1,1158 @@
+#  Copyright (C) 2002-2007  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ConfigTree.pm,v 1.1 2010-12-27 00:03:41 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ConfigTree;
+
+use Torrus::DB;
+use Torrus::Log;
+use Torrus::TimeStamp;
+
+use strict;
+
+
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    $self->{'treename'} = $options{'-TreeName'};
+    die('ERROR: TreeName is mandatory') if not $self->{'treename'};
+
+    $self->{'db_config_instances'} =
+        new Torrus::DB( 'config_instances', -WriteAccess => 1 );
+    defined( $self->{'db_config_instances'} ) or return( undef );
+
+    my $i = $self->{'db_config_instances'}->get('ds:' . $self->{'treename'});
+    if( not defined($i) )
+    {
+        $i = 0;
+        $self->{'first_time_created'} = 1;
+    }
+
+    my $dsConfInstance = sprintf( '%d', $i );
+
+    $i = $self->{'db_config_instances'}->get('other:' . $self->{'treename'});
+    $i = 0 unless defined( $i );
+
+    my $otherConfInstance = sprintf( '%d', $i );
+
+    if( $options{'-WriteAccess'} )
+    {
+        $self->{'is_writing'} = 1;
+        
+        # Acquire exlusive lock on the database and set the compiling flag
+        {
+            my $ok = 1;
+            my $key = 'compiling:' . $self->{'treename'};
+            my $cursor = $self->{'db_config_instances'}->cursor( -Write => 1 );
+            my $compilingFlag =
+                $self->{'db_config_instances'}->c_get( $cursor, $key );
+            if( $compilingFlag )
+            {
+                if( $options{'-ForceWriter'} )
+                {
+                    Warn('Another compiler process is probably still ' .
+                         'running. This may lead to an unusable ' .
+                         'database state');
+                }
+                else
+                {
+                    Error('Another compiler is running for the tree ' .
+                          $self->{'treename'});
+                    $ok = 0;
+                }
+            }
+            else
+            {
+                $self->{'db_config_instances'}->c_put( $cursor, $key, 1 );
+            }
+            undef $cursor;
+            if( not $ok )
+            {
+                return undef;
+            }
+            $self->{'iam_writer'} = 1;
+        }
+
+        if( not $options{'-NoDSRebuild'} )
+        {
+            $dsConfInstance = sprintf( '%d', ( $dsConfInstance + 1 ) % 2 );
+        }
+        $otherConfInstance = sprintf( '%d', ( $otherConfInstance + 1 ) % 2 );
+    }
+
+    $self->{'ds_config_instance'} = $dsConfInstance;
+    $self->{'other_config_instance'} = $otherConfInstance;
+
+    $self->{'db_readers'} = new Torrus::DB('config_readers',
+                                           -Subdir => $self->{'treename'},
+                                           -WriteAccess => 1 );
+    defined( $self->{'db_readers'} ) or return( undef );
+
+    $self->{'db_dsconfig'} =
+        new Torrus::DB('ds_config_' . $dsConfInstance,
+                       -Subdir => $self->{'treename'},  -Btree => 1,
+                       -WriteAccess => $options{'-WriteAccess'});
+    defined( $self->{'db_dsconfig'} ) or return( undef );
+    
+    $self->{'db_otherconfig'} =
+        new Torrus::DB('other_config_' . $otherConfInstance,
+                       -Subdir => $self->{'treename'}, -Btree => 1,
+                       -WriteAccess => $options{'-WriteAccess'});
+    defined( $self->{'db_otherconfig'} ) or return( undef );
+    
+    $self->{'db_aliases'} =
+        new Torrus::DB('aliases_' . $dsConfInstance,
+                       -Subdir => $self->{'treename'},  -Btree => 1,
+                       -WriteAccess => $options{'-WriteAccess'});
+    defined( $self->{'db_aliases'} ) or return( undef );
+
+    if( $options{'-WriteAccess'} )
+    {
+        $self->setReady(0);
+        $self->waitReaders();
+
+        if( $options{'-Rebuild'} )
+        {
+            $self->{'db_otherconfig'}->trunc();
+            if( not $options{'-NoDSRebuild'} )
+            {
+                $self->{'db_dsconfig'}->trunc();
+                $self->{'db_aliases'}->trunc();
+            }
+        }
+    }
+    else
+    {
+        $self->setReader();
+
+        if( not $self->isReady() )
+        {
+            if( $options{'-Wait'} )
+            {
+                Warn('Configuration is not ready');
+
+                my $waitingTimeout =
+                    time() + $Torrus::Global::ConfigReadyTimeout;
+                my $success = 0;
+
+                while( not $success and time() < $waitingTimeout )
+                {
+                    $self->clearReader();
+
+                    Info('Sleeping ' .
+                         $Torrus::Global::ConfigReadyRetryPeriod .
+                         ' seconds');
+                    sleep $Torrus::Global::ConfigReadyRetryPeriod;
+
+                    $self->setReader();
+
+                    if( $self->isReady() )
+                    {
+                        $success = 1;
+                        Info('Now configuration is ready');
+                    }
+                    else
+                    {
+                        Info('Configuration is still not ready');
+                    }
+                }
+                if( not $success )
+                {
+                    Error('Configuration wait timed out');
+                    $self->clearReader();
+                    return undef;
+                }
+            }
+            else
+            {
+                Error('Configuration is not ready');
+                $self->clearReader();
+                return undef;
+            }
+        }
+    }
+
+    # Read the parameter properties into memory
+    $self->{'db_paramprops'} =
+        new Torrus::DB('paramprops_' . $dsConfInstance,
+                       -Subdir => $self->{'treename'},  -Btree => 1,
+                       -WriteAccess => $options{'-WriteAccess'});
+    defined( $self->{'db_paramprops'} ) or return( undef );
+    
+    if( $options{'-Rebuild'} )
+    {
+        $self->{'db_paramprops'}->trunc();
+    }
+    else
+    {
+        my $cursor = $self->{'db_paramprops'}->cursor();
+        while( my ($key, $val) =
+               $self->{'db_paramprops'}->next( $cursor ) )
+        {
+            my( $param, $prop ) = split( /:/o, $key );
+            $self->{'paramprop'}{$prop}{$param} = $val;
+        }
+        undef $cursor;
+        $self->{'db_paramprops'}->closeNow();
+        delete $self->{'db_paramprops'};
+    }
+
+    
+    $self->{'db_sets'} =
+        new Torrus::DB('tokensets_' . $dsConfInstance,
+                       -Subdir => $self->{'treename'}, -Btree => 0,
+                       -WriteAccess => 1, -Truncate => $options{'-Rebuild'});
+    defined( $self->{'db_sets'} ) or return( undef );
+
+
+    $self->{'db_nodepcache'} =
+        new Torrus::DB('nodepcache_' . $dsConfInstance,
+                       -Subdir => $self->{'treename'}, -Btree => 1,
+                       -WriteAccess => 1,
+                       -Truncate => ($options{'-Rebuild'} and
+                                     not $options{'-NoDSRebuild'}));
+    defined( $self->{'db_nodepcache'} ) or return( undef );
+
+
+    $self->{'db_nodeid'} =
+        new Torrus::DB('nodeid_' . $dsConfInstance,
+                       -Subdir => $self->{'treename'}, -Btree => 1,
+                       -WriteAccess => 1,
+                       -Truncate => ($options{'-Rebuild'} and
+                                     not $options{'-NoDSRebuild'}));
+    defined( $self->{'db_nodeid'} ) or return( undef );
+
+    return $self;
+}
+
+
+sub DESTROY
+{
+    my $self = shift;
+
+    Debug('Destroying ConfigTree object');
+
+    if( $self->{'iam_writer'} )
+    {
+        # Acquire exlusive lock on the database and clear the compiling flag
+        my $cursor = $self->{'db_config_instances'}->cursor( -Write => 1 );
+        $self->{'db_config_instances'}->c_put
+            ( $cursor, 'compiling:' . $self->{'treename'}, 0 );
+        undef $cursor;
+    }
+    else
+    {
+        $self->clearReader();
+    }
+
+    undef $self->{'db_dsconfig'};
+    undef $self->{'db_otherconfig'};
+    undef $self->{'db_aliases'};
+    undef $self->{'db_sets'};
+    undef $self->{'db_nodepcache'};
+    undef $self->{'db_readers'};
+}
+
+# Manage the readinness flag
+
+sub setReady
+{
+    my $self = shift;
+    my $ready = shift;
+    $self->{'db_otherconfig'}->put( 'ConfigurationReady', $ready ? 1:0 );
+}
+
+sub isReady
+{
+    my $self = shift;
+    return $self->{'db_otherconfig'}->get( 'ConfigurationReady' );
+}
+
+# Manage the readers database
+
+sub setReader
+{
+    my $self = shift;
+
+    my $readerId = 'pid=' . $$ . ',rand=' . sprintf('%.10d', rand(1e9));
+    Debug('Setting up reader: ' . $readerId);
+    $self->{'reader_id'} = $readerId;
+    $self->{'db_readers'}->put( $readerId,
+                                sprintf('%d:%d:%d',
+                                        time(),
+                                        $self->{'ds_config_instance'},
+                                        $self->{'other_config_instance'}) );
+}
+
+sub clearReader
+{
+    my $self = shift;
+
+    if( defined( $self->{'reader_id'} ) )
+    {
+        Debug('Clearing reader: ' . $self->{'reader_id'});
+        $self->{'db_readers'}->del( $self->{'reader_id'} );
+        delete $self->{'reader_id'};
+    }
+}
+
+
+sub waitReaders
+{
+    my $self = shift;
+
+    # Let the active readers finish their job
+    my $noReaders = 0;
+    while( not $noReaders )
+    {
+        my @readers = ();
+        my $cursor = $self->{'db_readers'}->cursor();
+        while( my ($key, $val) = $self->{'db_readers'}->next( $cursor ) )
+        {
+            my( $timestamp, $dsInst, $otherInst ) = split( /:/o, $val );
+            if( $dsInst == $self->{'ds_config_instance'} or
+                $otherInst == $self->{'other_config_instance'} )
+            {
+                push( @readers, {
+                    'reader' => $key,
+                    'timestamp' => $timestamp } );
+            }
+        }
+        undef $cursor;
+        if( @readers > 0 )
+        {
+            Info('Waiting for ' . scalar(@readers) . ' readers:');
+            my $recentTS = 0;
+            foreach my $reader ( @readers )
+            {
+                Info($reader->{'reader'} . ', timestamp: ' .
+                     localtime( $reader->{'timestamp'} ));
+                if( $reader->{'timestamp'} > $recentTS )
+                {
+                    $recentTS = $reader->{'timestamp'};
+                }
+            }
+            if( $recentTS + $Torrus::Global::ConfigReadersWaitTimeout >=
+                time() )
+            {
+                Info('Sleeping ' . $Torrus::Global::ConfigReadersWaitPeriod  .
+                     ' seconds');
+                sleep( $Torrus::Global::ConfigReadersWaitPeriod );
+            }
+            else
+            {
+                # the readers are too long active. we ignore them now
+                Warn('Readers wait timed out. Flushing the readers list for ' .
+                     'DS config instance ' . $self->{'ds_config_instance'} .
+                     ' and Other config instance ' .
+                     $self->{'other_config_instance'});
+
+                my $cursor = $self->{'db_readers'}->cursor( -Write => 1 );
+                while( my ($key, $val) =
+                       $self->{'db_readers'}->next( $cursor ) )
+                {
+                    my( $timestamp, $dsInst, $otherInst ) =
+                        split( /:/o, $val );
+                    if( $dsInst == $self->{'ds_config_instance'} or
+                        $otherInst == $self->{'other_config_instance'} )
+                    {
+                        $self->{'db_readers'}->c_del( $cursor );
+                    }
+                }
+                undef $cursor;
+                $noReaders = 1;
+            }
+        }
+        else
+        {
+            $noReaders = 1;
+        }
+    }
+}
+
+
+
+# This should be called after Torrus::TimeStamp::init();
+
+sub getTimestamp
+{
+    my $self = shift;
+    return Torrus::TimeStamp::get($self->{'treename'} . ':configuration');
+}
+
+sub treeName
+{
+    my $self = shift;
+    return $self->{'treename'};
+}
+
+
+# Returns array with path components
+
+sub splitPath
+{
+    my $self = shift;
+    my $path = shift;
+    my @ret = ();
+    while( length($path) > 0 )
+    {
+        my $node;
+        $path =~ s/^([^\/]*\/?)//o; $node = $1;
+        push(@ret, $node);
+    }
+    return @ret;
+}
+
+sub nodeName
+{
+    my $self = shift;
+    my $path = shift;
+    $path =~ s/.*\/([^\/]+)\/?$/$1/o;
+    return $path;
+}
+
+sub token
+{
+    my $self = shift;
+    my $path = shift;
+
+    my $token = $self->{'db_dsconfig'}->get( 'pt:'.$path );
+    if( not defined( $token ) )
+    {
+        my $prefixLen = 1; # the leading slash is anyway there
+        my $pathLen = length( $path );
+        while( not defined( $token ) and $prefixLen < $pathLen )
+        {
+            my $result = $self->{'db_aliases'}->getBestMatch( $path );
+            if( not defined( $result ) )
+            {
+                $prefixLen = $pathLen; # exit the loop
+            }
+            else
+            {
+                # Found a partial match
+                $prefixLen = length( $result->{'key'} );
+                my $aliasTarget = $self->path( $result->{'value'} );
+                $path = $aliasTarget . substr( $path, $prefixLen );
+                $token = $self->{'db_dsconfig'}->get( 'pt:'.$path );
+            }
+        }
+    }
+    return $token;
+}
+
+sub path
+{
+    my $self = shift;
+    my $token = shift;
+    return $self->{'db_dsconfig'}->get( 'tp:'.$token );
+}
+
+sub nodeExists
+{
+    my $self = shift;
+    my $path = shift;
+
+    return defined( $self->{'db_dsconfig'}->get( 'pt:'.$path ) );
+}
+
+
+sub nodeType
+{
+    my $self = shift;
+    my $token = shift;
+
+    my $type = $self->{'nodetype_cache'}{$token};
+    if( not defined( $type ) )
+    {
+        $type = $self->{'db_dsconfig'}->get( 'n:'.$token );
+        $self->{'nodetype_cache'}{$token} = $type;
+    }
+    return $type;
+}
+    
+
+sub isLeaf
+{
+    my $self = shift;
+    my $token = shift;
+
+    return ( $self->nodeType($token) == 1 );
+}
+
+
+sub isSubtree
+{
+    my $self = shift;
+    my $token = shift;
+
+    return( $self->nodeType($token) == 0 );
+}
+
+# Returns the real token or undef
+sub isAlias
+{
+    my $self = shift;
+    my $token = shift;
+
+    return( ( $self->nodeType($token) == 2 ) ?
+            $self->{'db_dsconfig'}->get( 'a:'.$token ) : undef );
+}
+
+# Returns the list of tokens pointing to this one as an alias
+sub getAliases
+{
+    my $self = shift;
+    my $token = shift;
+
+    return $self->{'db_dsconfig'}->getListItems('ar:'.$token);
+}
+
+
+sub getParam
+{
+    my $self = shift;
+    my $name = shift;
+    my $param = shift;
+    my $fromDS = shift;
+
+    if( exists( $self->{'paramcache'}{$name}{$param} ) )
+    {
+        return $self->{'paramcache'}{$name}{$param};
+    }
+    else
+    {
+        my $db = $fromDS ? $self->{'db_dsconfig'} : $self->{'db_otherconfig'};
+        my $val = $db->get( 'P:'.$name.':'.$param );
+        $self->{'paramcache'}{$name}{$param} = $val;
+        return $val;
+    }
+}
+
+sub retrieveNodeParam
+{
+    my $self = shift;
+    my $token = shift;
+    my $param = shift;
+
+    # walk up the tree and save the grandparent's value at parent's cache
+    
+    my $value;    
+    my $currtoken = $token;
+    my @ancestors;
+    my $walked = 0;
+    
+    while( not defined($value) and defined($currtoken) )
+    {
+        $value = $self->getParam( $currtoken, $param, 1 );
+        if( not defined $value )
+        {
+            if( $walked )
+            {
+                push( @ancestors, $currtoken );
+            }
+            else
+            {
+                $walked = 1;
+            }
+            # walk up to the parent
+            $currtoken = $self->getParent($currtoken);
+        }
+    }
+
+    foreach my $ancestor ( @ancestors )
+    {
+        $self->{'paramcache'}{$ancestor}{$param} = $value;
+    }
+    
+    return $self->expandNodeParam( $token, $param, $value );
+}
+
+
+sub expandNodeParam
+{
+    my $self = shift;
+    my $token = shift;
+    my $param = shift;
+    my $value = shift;
+
+    # %parameter_substitutions% in ds-path-* in multigraph leaves
+    # are expanded by the Writer post-processing
+    if( defined $value and $self->getParamProperty( $param, 'expand' ) )
+    {
+        $value = $self->expandSubstitutions( $token, $param, $value );
+    }
+    return $value;
+}
+
+
+sub expandSubstitutions
+{
+    my $self = shift;
+    my $token = shift;
+    my $param = shift;
+    my $value = shift;
+
+    my $ok = 1;
+    my $changed = 1;
+
+    while( $changed and $ok )
+    {
+        $changed = 0;
+
+        # Substitute definitions
+        if( index($value, '$') >= 0 )
+        {
+            if( not $value =~ /\$(\w+)/o )
+            {
+                my $path = $self->path($token);
+                Error("Incorrect definition reference: $value in $path");
+                $ok = 0;
+            }
+            else
+            {
+                my $dname = $1;
+                my $dvalue = $self->getDefinition($dname);
+                if( not defined( $dvalue ) )
+                {
+                    my $path = $self->path($token);
+                    Error("Cannot find definition $dname in $path");
+                    $ok = 0;
+                }
+                else
+                {
+                    $value =~ s/\$$dname/$dvalue/g;
+                    $changed = 1;
+                }
+            }
+        }
+
+        # Substitute parameter references
+        if( index($value, '%') >= 0 and $ok )
+        {
+            if( not $value =~ /\%([a-zA-Z0-9\-_]+)\%/o )
+            {
+                Error("Incorrect parameter reference: $value");
+                $ok = 0;
+            }
+            else
+            {
+                my $pname = $1;
+                my $pval = $self->getNodeParam( $token, $pname );
+
+                if( not defined( $pval ) )
+                {
+                    my $path = $self->path($token);
+                    Error("Cannot expand parameter reference %".
+                          $pname."% in ".$path);
+                    $ok = 0;
+                }
+                else
+                {
+                    $value =~ s/\%$pname\%/$pval/g;
+                    $changed = 1;
+                }
+            }
+        }
+    }
+
+    if( ref( $Torrus::ConfigTree::nodeParamHook ) )
+    {
+        $value = &{$Torrus::ConfigTree::nodeParamHook}( $self, $token,
+                                                        $param, $value );
+    }
+
+    return $value;
+}
+
+
+sub getNodeParam
+{
+    my $self = shift;
+    my $token = shift;
+    my $param = shift;
+    my $noclimb = shift;
+
+    my $value;
+    if( $noclimb )
+    {
+        $value = $self->getParam( $token, $param, 1 );
+        return $self->expandNodeParam( $token, $param, $value );
+    }
+
+    if( $self->{'is_writing'} )
+    {
+        return $self->retrieveNodeParam( $token, $param );
+    }
+
+    my $cachekey = $token.':'.$param;
+    my $cacheval = $self->{'db_nodepcache'}->get( $cachekey );
+    if( defined( $cacheval ) )
+    {
+        my $status = substr( $cacheval, 0, 1 );
+        if( $status eq 'U' )
+        {
+            return undef;
+        }
+        else
+        {
+            return substr( $cacheval, 1 );
+        }
+    }
+
+    $value = $self->retrieveNodeParam( $token, $param );
+
+    if( defined( $value ) )
+    {
+        $self->{'db_nodepcache'}->put( $cachekey, 'D'.$value );
+    }
+    else
+    {
+        $self->{'db_nodepcache'}->put( $cachekey, 'U' );
+    }
+
+    return $value;
+}
+
+
+sub getParamNames
+{
+    my $self = shift;
+    my $name = shift;
+    my $fromDS = shift;
+
+    my $db = $fromDS ? $self->{'db_dsconfig'} : $self->{'db_otherconfig'};
+
+    return $db->getListItems('Pl:'.$name);
+}
+
+
+sub getParams
+{
+    my $self = shift;
+    my $name = shift;
+    my $fromDS = shift;
+
+    my $ret = {};
+    foreach my $param ( $self->getParamNames( $name, $fromDS ) )
+    {
+        $ret->{$param} = $self->getParam( $name, $param, $fromDS );
+    }
+    return $ret;
+}
+
+sub getParent
+{
+    my $self = shift;
+    my $token = shift;
+    if( exists( $self->{'parentcache'}{$token} ) )
+    {
+        return $self->{'parentcache'}{$token};
+    }
+    else
+    {
+        my $parent = $self->{'db_dsconfig'}->get( 'p:'.$token );
+        $self->{'parentcache'}{$token} = $parent;
+        return $parent;
+    }
+}
+
+
+sub getChildren
+{
+    my $self = shift;
+    my $token = shift;
+
+    if( (my $alias = $self->isAlias($token)) )
+    {
+        return $self->getChildren($alias);
+    }
+    else
+    {
+        return $self->{'db_dsconfig'}->getListItems( 'c:'.$token );
+    }
+}
+
+sub getParamProperty
+{
+    my $self = shift;
+    my $param = shift;
+    my $prop = shift;
+
+    return $self->{'paramprop'}{$prop}{$param};
+}
+
+
+sub getParamProperties
+{
+    my $self = shift;
+
+    return $self->{'paramprop'};
+}
+
+# Recognize the regexp patterns within a path,
+# like /Netflow/Exporters/.*/.*/bps.
+# Each pattern is applied against direct child names only.
+#
+sub getNodesByPattern
+{
+    my $self = shift;
+    my $pattern = shift;
+
+    if( $pattern !~ /^\//o )
+    {
+        Error("Incorrect pattern: $pattern");
+        return undef;
+    }
+
+    my @retlist = ();
+    foreach my $nodepattern ( $self->splitPath($pattern) )
+    {
+        my @next_retlist = ();
+
+        # Cut the trailing slash, if any
+        my $patternname = $nodepattern;
+        $patternname =~ s/\/$//o;
+
+        if( $patternname =~ /\W/o )
+        {
+            foreach my $candidate ( @retlist )
+            {
+                # This is a pattern, let's get all matching children
+                foreach my $child ( $self->getChildren( $candidate ) )
+                {
+                    # Cut the trailing slash and leading path
+                    my $childname = $self->path($child);
+                    $childname =~ s/\/$//o;
+                    $childname =~ s/.*\/([^\/]+)$/$1/o;
+                    if( $childname =~ $patternname )
+                    {
+                        push( @next_retlist, $child );
+                    }
+                }
+            }
+
+        }
+        elsif( length($patternname) == 0 )
+        {
+            @next_retlist = ( $self->token('/') );
+        }
+        else
+        {
+            foreach my $candidate ( @retlist )
+            {
+                my $proposal = $self->path($candidate).$nodepattern;
+                if( defined( my $proptoken = $self->token($proposal) ) )
+                {
+                    push( @next_retlist, $proptoken );
+                }
+            }
+        }
+        @retlist = @next_retlist;
+    }
+    return @retlist;
+}
+
+#
+# Recognizes absolute or relative path, '..' as the parent subtree
+#
+sub getRelative
+{
+    my $self = shift;
+    my $token = shift;
+    my $relPath = shift;
+
+    if( $relPath =~ /^\//o )
+    {
+        return $self->token( $relPath );
+    }
+    else
+    {
+        if( length( $relPath ) > 0 )
+        {
+            $token = $self->getParent( $token );
+        }
+
+        while( length( $relPath ) > 0 )
+        {
+            if( $relPath =~ /^\.\.\//o )
+            {
+                $relPath =~ s/^\.\.\///o;
+                if( $token ne $self->token('/') )
+                {
+                    $token = $self->getParent( $token );
+                }
+            }
+            else
+            {
+                my $childName;
+                $relPath =~ s/^([^\/]*\/?)//o; $childName = $1;
+                my $path = $self->path( $token );
+                $token = $self->token( $path . $childName );
+                if( not defined $token )
+                {
+                    return undef;
+                }
+            }
+        }
+        return $token;
+    }
+}
+
+
+sub getNodeByNodeid
+{
+    my $self = shift;
+    my $nodeid = shift;
+
+    return $self->{'db_nodeid'}->get( $nodeid );
+}
+
+# Returns arrayref or undef.
+# Each element is an arrayref to [nodeid, token] pair
+sub searchNodeidPrefix
+{
+    my $self = shift;
+    my $prefix = shift;
+
+    return $self->{'db_nodeid'}->searchPrefix( $prefix );
+}
+
+
+# Returns arrayref or undef.
+# Each element is an arrayref to [nodeid, token] pair
+sub searchNodeidSubstring
+{
+    my $self = shift;
+    my $substring = shift;
+
+    return $self->{'db_nodeid'}->searchSubstring( $substring );
+}
+
+
+
+sub getDefaultView
+{
+    my $self = shift;
+    my $token = shift;
+
+    my $view;
+    if( $self->isTset($token) )
+    {
+        if( $token eq 'SS' )
+        {
+            $view = $self->getParam('SS', 'default-tsetlist-view');
+        }
+        else
+        {
+            $view = $self->getParam($token, 'default-tset-view');
+            if( not defined( $view ) )
+            {
+                $view = $self->getParam('SS', 'default-tset-view');
+            }
+        }
+    }
+    elsif( $self->isSubtree($token) )
+    {
+        $view = $self->getNodeParam($token, 'default-subtree-view');
+    }
+    else
+    {
+        # This must be leaf
+        $view = $self->getNodeParam($token, 'default-leaf-view');
+    }
+
+    if( not defined( $view ) )
+    {
+        Error("Cannot find default view for $token");
+    }
+    return $view;
+}
+
+
+sub getInstanceParam
+{
+    my $self = shift;
+    my $type = shift;
+    my $name = shift;
+    my $param = shift;
+
+    if( $type eq 'node' )
+    {
+        return $self->getNodeParam($name, $param);
+    }
+    else
+    {
+        return $self->getParam($name, $param);
+    }
+}
+
+
+sub getViewNames
+{
+    my $self = shift;
+    return $self->{'db_otherconfig'}->getListItems( 'V:' );
+}
+
+
+sub viewExists
+{
+    my $self = shift;
+    my $vname = shift;
+    return $self->searchOtherList('V:', $vname);
+}
+
+
+sub getMonitorNames
+{
+    my $self = shift;
+    return $self->{'db_otherconfig'}->getListItems( 'M:' );
+}
+
+sub monitorExists
+{
+    my $self = shift;
+    my $mname = shift;
+    return $self->searchOtherList('M:', $mname);
+}
+
+
+sub getActionNames
+{
+    my $self = shift;
+    return $self->{'db_otherconfig'}->getListItems( 'A:' );
+}
+
+
+sub actionExists
+{
+    my $self = shift;
+    my $mname = shift;
+    return $self->searchOtherList('A:', $mname);
+}
+
+
+# Search for a value in comma-separated list
+sub searchOtherList
+{
+    my $self = shift;
+    my $key = shift;
+    my $name = shift;
+
+    return $self->{'db_otherconfig'}->searchList($key, $name);
+}
+
+# Token sets manipulation
+
+sub isTset
+{
+    my $self = shift;
+    my $token = shift;
+    return substr($token, 0, 1) eq 'S';
+}
+
+sub addTset
+{
+    my $self = shift;
+    my $tset = shift;
+    $self->{'db_sets'}->addToList('S:', $tset);
+}
+
+
+sub tsetExists
+{
+    my $self = shift;
+    my $tset = shift;
+    return $self->{'db_sets'}->searchList('S:', $tset);
+}
+
+sub getTsets
+{
+    my $self = shift;
+    return $self->{'db_sets'}->getListItems('S:');
+}
+
+sub tsetMembers
+{
+    my $self = shift;
+    my $tset = shift;
+
+    return $self->{'db_sets'}->getListItems('s:'.$tset);
+}
+
+sub tsetMemberOrigin
+{
+    my $self = shift;
+    my $tset = shift;
+    my $token = shift;
+    
+    return $self->{'db_sets'}->get('o:'.$tset.':'.$token);
+}
+
+sub tsetAddMember
+{
+    my $self = shift;
+    my $tset = shift;
+    my $token = shift;
+    my $origin = shift;
+
+    $self->{'db_sets'}->addToList('s:'.$tset, $token);
+    $self->{'db_sets'}->put('o:'.$tset.':'.$token, $origin);
+}
+
+
+sub tsetDelMember
+{
+    my $self = shift;
+    my $tset = shift;
+    my $token = shift;
+
+    $self->{'db_sets'}->delFromList('s:'.$tset, $token);
+    $self->{'db_sets'}->del('o:'.$tset.':'.$token);
+}
+
+# Definitions manipulation
+
+sub getDefinition
+{
+    my $self = shift;
+    my $name = shift;
+    return $self->{'db_dsconfig'}->get( 'd:'.$name );
+}
+
+sub getDefinitionNames
+{
+    my $self = shift;
+    return $self->{'db_dsconfig'}->getListItems( 'D:' );
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ConfigTree/Validator.pm b/torrus/perllib/Torrus/ConfigTree/Validator.pm
new file mode 100644
index 000000000..96923d032
--- /dev/null
+++ b/torrus/perllib/Torrus/ConfigTree/Validator.pm
@@ -0,0 +1,969 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Validator.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ConfigTree::Validator;
+
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::RPN;
+use Torrus::SiteConfig;
+use strict;
+
+Torrus::SiteConfig::loadStyling();
+
+%Torrus::ConfigTree::Validator::reportedErrors = ();
+
+my %rrd_params =
+    (
+     'leaf-type' => {'rrd-def' => {'rrd-ds' => undef,
+                                   'rrd-cf' => {'AVERAGE' => undef,
+                                                'MIN'     => undef,
+                                                'MAX'     => undef,
+                                                'LAST'    => undef},
+                                   'data-file' => undef,
+                                   'data-dir'  => undef},
+                     'rrd-cdef' => {'rpn-expr' => undef}},
+     );
+
+my %rrdmulti_params = ( 'ds-names' => undef );
+
+# Plugins might need to add a new storage type
+our %collector_params =
+    (
+     'collector-type'  => undef,
+     '@storage-type'   => {
+         'rrd' => {
+             'data-file'              => undef,
+             'data-dir'               => undef,
+             'leaf-type'              => {
+                 'rrd-def'  => {'rrd-ds' => undef,
+                                'rrd-cf' => {'AVERAGE' => undef,
+                                             'MIN'     => undef,
+                                             'MAX'     => undef,
+                                             'LAST'    => undef},
+                                'rrd-create-dstype' => {'GAUGE' => undef,
+                                                        'COUNTER' => undef,
+                                                        'DERIVE'  => undef,
+                                                        'ABSOLUTE' => undef },
+                                'rrd-create-rra'         => undef,
+                                'rrd-create-heartbeat'   => undef,
+                                '+rrd-hwpredict'         => {
+                                    'enabled' => {
+                                        'rrd-create-hw-rralen' => undef},
+                                    'disabled' => undef,
+                                }}}},
+         'ext' => {
+             'ext-dstype' => {
+                 'GAUGE' => undef,
+                 'COUNTER32' => undef,
+                 'COUNTER64' => undef },
+             'ext-service-id' => undef,
+             '+ext-service-units' => {
+                 'bytes' => undef }}},
+     'collector-period'      => undef,
+     'collector-timeoffset'  => undef,
+     '+collector-scale'      => undef,
+     '+collector-dispersed-timeoffset' => {
+         'no' => undef,
+         'yes' => undef }
+     # collector-timeoffset-min, max, step, and hashstring are validated
+     # during post-processing
+     );
+
+
+# Plugins might in theory create new datasource types
+our %leaf_params =
+    ('ds-type' => {'rrd-file' => \%rrd_params,
+                   'rrd-multigraph' => \%rrdmulti_params,
+                   'collector' => \%collector_params},
+     'rrgraph-views'             => undef,
+     '+rrd-scaling-base'         => {'1000' => undef, '1024' => undef},
+     '+graph-logarithmic'        => {'yes'  => undef, 'no' => undef},
+     '+graph-rigid-boundaries'   => {'yes'  => undef, 'no' => undef},
+     '+graph-ignore-decorations' => {'yes'  => undef, 'no' => undef});
+
+
+my %monitor_params =
+    ('monitor-type' => {'expression' => {'rpn-expr' => undef},
+                        'failures' => undef},
+     'action'       => undef,
+     'expires'      => undef
+     );
+
+my %action_params =
+    ('action-type' => {'tset' => {'tset-name' => undef},
+                       'exec' => {'command' => undef} }
+     );
+
+my %view_params =
+    ('expires' => undef,
+     'view-type' => {'rrgraph' => {'width' => undef,
+                                   'height' => undef,
+                                   'start' => undef,
+                                   'line-style' => undef,
+                                   'line-color' => undef,
+                                   '+ignore-limits' => {
+                                       'yes'=>undef, 'no'=>undef },
+                                   '+ignore-lower-limit' => {
+                                       'yes'=>undef, 'no'=>undef },
+                                   '+ignore-upper-limit' => {
+                                       'yes'=>undef, 'no'=>undef }},
+                     'rrprint' => {'start' => undef,
+                                   'print-cf' => undef},
+                     'html' => {'html-template' => undef},
+                     'adminfo' => undef}
+     );
+
+
+# Load additional validation, configurable from
+# torrus-config.pl and torrus-siteconfig.pl
+
+foreach my $mod ( @Torrus::Validator::loadLeafValidators )
+{
+    eval( 'require ' . $mod );
+    die( $@ ) if $@;
+    eval( '&' . $mod . '::initValidatorLeafParams( \%leaf_params )' );
+    die( $@ ) if $@;
+}
+
+
+sub validateNodes
+{
+    my $config_tree = shift;
+    my $token = $config_tree->token('/');
+
+    if( defined($token) )
+    {
+        return validateNode($config_tree, $token);
+    }
+    else
+    {
+        Error("The datasource tree is empty");
+        return 0;
+    }
+}
+
+sub validateNode
+{
+    my $config_tree = shift;
+    my $token = shift;
+
+    &Torrus::DB::checkInterrupted();
+
+    my $ok = 1;
+
+    if( $config_tree->isLeaf($token) )
+    {
+        # Verify the default view
+        my $view = $config_tree->getNodeParam( $token, 'default-leaf-view' );
+        if( not defined( $view ) )
+        {
+            my $path = $config_tree->path( $token );
+            Error("Default view is not defined for leaf $path");
+            $ok = 0;
+        }
+        elsif( not $config_tree->{'validator'}{'viewExists'}{$view} and
+               not $config_tree->viewExists( $view ) )
+        {
+            my $path = $config_tree->path( $token );
+            Error("Non-existent view is defined as default for leaf $path");
+            $ok = 0;
+        }
+        else
+        {
+            # Cache the view name
+            $config_tree->{'validator'}{'viewExists'}{$view} = 1;
+        }
+
+        # Verify parameters
+        $ok = validateInstanceParams($config_tree, $token,
+                                     'node', \%leaf_params);
+
+        if( $ok )
+        {
+            my $rrviewslist =
+                $config_tree->getNodeParam( $token, 'rrgraph-views' );
+
+            # Check the cache first
+            if( not $config_tree->{'validator'}{'graphviews'}{$rrviewslist} )
+            {
+                my @rrviews = split( ',', $rrviewslist );
+
+                if( scalar(@rrviews) != 5 )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error('rrgraph-views sould refer 5 views in' . $path);
+                    $ok = 0;
+                }
+                else
+                {
+                    foreach my $view ( @rrviews )
+                    {
+                        if( not $config_tree->viewExists( $view ) )
+                        {
+                            my $path = $config_tree->path( $token );
+                            Error("Non-existent view ($view) is defined in " .
+                                  "rrgraph-views for $path");
+                            $ok = 0;
+                        }
+                        elsif( $config_tree->getParam($view, 'view-type') ne
+                               'rrgraph' )
+                        {
+                            my $path = $config_tree->path( $token );
+                            Error("View $view is not of type rrgraph in " .
+                                  "rrgraph-views for $path");
+                            $ok = 0;
+                        }
+                    }
+                }
+
+                if( $ok )
+                {
+                    # Store the cache
+                    $config_tree->{'validator'}{'graphviews'}{$rrviewslist}=1;
+                }
+            }
+        }
+
+        # Verify monitor references
+        my $mlist = $config_tree->getNodeParam( $token, 'monitor' );
+        if( defined $mlist )
+        {
+            foreach my $param ( 'monitor-period', 'monitor-timeoffset' )
+            {
+                if( not defined( $config_tree->getNodeParam( $token,
+                                                             $param ) ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error('Mandatory parameter ' . $param .
+                          ' is not defined in ' . $path);
+                    $ok = 0;
+                }
+            }
+            
+            foreach my $monitor ( split(',', $mlist) )
+            {
+                if( not $config_tree->{'validator'}{'monitorExists'}{$monitor}
+                    and
+                    not $config_tree->monitorExists( $monitor ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error("Non-existent monitor: $monitor in $path");
+                    $ok = 0;
+                }
+                else
+                {
+                    $config_tree->{'validator'}{'monitorExists'}{$monitor} = 1;
+                }
+            }
+            
+            my $varstring =
+                $config_tree->getNodeParam( $token, 'monitor-vars' );
+            if( defined $varstring )
+            {
+                foreach my $pair ( split( '\s*;\s*', $varstring ) )
+                {
+                    if( $pair !~ /^\w+\s*\=\s*[0-9\-+.eU]+$/o )
+                    {
+                        Error("Syntax error in monitor variables: $pair");
+                        $ok = 0;
+                    }
+                }
+            }
+
+            my $action_target =
+                $config_tree->getNodeParam($token, 'monitor-action-target');
+            if( defined( $action_target ) )
+            {
+                my $target = $config_tree->getRelative($token, $action_target);
+                if( not defined( $target ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error('monitor-action-target points to an invalid path: ' .
+                          $action_target . ' in ' . $path);
+                    $ok = 0;
+                }
+                elsif( not $config_tree->isLeaf( $target ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error('monitor-action-target must point to a leaf: ' .
+                          $action_target . ' in ' . $path);
+                    $ok = 0;
+                }
+            }
+        }
+
+        # Verify if the data-dir exists
+        my $datadir = $config_tree->getNodeParam( $token, 'data-dir' );
+        if( defined $datadir )
+        {
+            if( not $config_tree->{'validator'}{'dirExists'}{$datadir} and
+                not ( -d $datadir ) and
+                not $Torrus::ConfigTree::Validator::reportedErrors{$datadir} )
+            {
+                my $path = $config_tree->path( $token );
+                Error("Directory does not exist: $datadir in $path");
+                $ok = 0;
+                $Torrus::ConfigTree::Validator::reportedErrors{$datadir} = 1;
+            }
+            else
+            {
+                # Store the cache
+                $config_tree->{'validator'}{'dirExists'}{$datadir} = 1;
+            }
+        }
+
+        # Verify type-specific parameters
+        my $dsType = $config_tree->getNodeParam( $token, 'ds-type' );
+        if( not defined( $dsType ) )
+        {
+            # Writer has already complained
+            return 0;
+        }
+
+        if( $dsType eq 'rrd-multigraph' )
+        {
+            my @dsNames =
+                split(',', $config_tree->getNodeParam( $token, 'ds-names' ) );
+
+            if( scalar(@dsNames) == 0 )
+            {
+                my $path = $config_tree->path( $token );
+                Error("ds-names list is empty in $path");
+                $ok = 0;
+            }
+            foreach my $dname ( @dsNames )
+            {
+                my $param = 'ds-expr-' . $dname;
+                my $expr = $config_tree->getNodeParam( $token, $param );
+                if( not defined( $expr ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error("Parameter $param is not defined in $path");
+                    $ok = 0;
+                }
+                else
+                {
+                    $ok = validateRPN( $token, $expr, $config_tree ) ? $ok : 0;
+                }
+
+                foreach my $paramprefix ( 'graph-legend-', 'line-style-',
+                                          'line-color-', 'line-order-' )
+                {
+                    my $param = $paramprefix.$dname;
+                    my $value = $config_tree->getNodeParam($token, $param);
+                    if( not defined( $value ) )
+                    {
+                        my $path = $config_tree->path( $token );
+                        Error('Parameter ' . $param .
+                              ' is not defined in ' . $path);
+                        $ok = 0;
+                    }
+                    elsif( $param eq 'line-style-' and
+                           not validateLine( $value ) )
+                    {
+                        my $path = $config_tree->path( $token );
+                        Error('Parameter ' . $param .
+                              ' is defined incorrectly in ' . $path);
+                        $ok = 0;
+                    }
+                    elsif( $param eq 'line-color-' and
+                           not validateColor( $value ) )
+                    {
+                        my $path = $config_tree->path( $token );
+                        Error('Parameter ' . $param .
+                              ' is defined incorrectly in ' . $path);
+                        $ok = 0;
+                    }
+                }
+            }
+        }
+        elsif( $dsType eq 'rrd-file' and
+               $config_tree->getNodeParam( $token, 'leaf-type' ) eq 'rrd-cdef')
+        {
+            my $expr = $config_tree->getNodeParam( $token, 'rpn-expr' );
+            if( defined( $expr ) )
+            {
+                $ok = validateRPN( $token, $expr, $config_tree ) ? $ok : 0;
+            }
+            # Otherwise already reported by  validateInstanceParams()
+        }
+        elsif($dsType eq 'collector' and
+              $config_tree->getNodeParam( $token, 'collector-type' ) eq 'snmp')
+        {
+            # Check the OID syntax
+            my $oid = $config_tree->getNodeParam( $token, 'snmp-object' );
+            if( defined($oid) and $oid =~ /^\./o )
+            {
+                my $path = $config_tree->path( $token );
+                Error("Invalid syntax for snmp-object in " .
+                      $path . ": OID must not start with dot");
+                $ok = 0;
+            }
+        }
+    }
+    else
+    {
+        # This is subtree
+        my $view = $config_tree->getNodeParam( $token,
+                                               'default-subtree-view' );
+
+        if( not defined( $view ) )
+        {
+            my $path = $config_tree->path( $token );
+            Error("Default view is not defined for subtree $path");
+            $ok = 0;
+        }
+        elsif( not $config_tree->{'validator'}{'viewExists'}{$view} and
+               not $config_tree->viewExists( $view ) )
+        {
+            my $path = $config_tree->path( $token );
+            Error("Non-existent view is defined as default for subtree $path");
+            $ok = 0;
+        }
+        else
+        {
+            # Store the cache
+            $config_tree->{'validator'}{'viewExists'}{$view} = 1;
+        }
+
+        foreach my $ctoken ( $config_tree->getChildren($token) )
+        {
+            if( not $config_tree->isAlias($ctoken) )
+            {
+                $ok = validateNode($config_tree, $ctoken)
+                    ? $ok:0;
+            }
+        }
+    }
+    return $ok;
+}
+
+my %validFuntcionNames =
+    ( 'AVERAGE' => 1,
+      'MIN'     => 1,
+      'MAX'     => 1,
+      'LAST'    => 1,
+      'T'       => 1 );
+
+
+sub validateRPN
+{
+    my $token = shift;
+    my $expr  = shift;
+    my $config_tree = shift;
+    my $timeoffset_supported = shift;
+
+    &Torrus::DB::checkInterrupted();
+    
+    my $ok = 1;
+
+    # There must be at least one DS reference
+    my $ds_couter = 0;
+
+    my $rpn = new Torrus::RPN;
+
+    # The callback for RPN translation
+    my $callback = sub
+    {
+        my ($noderef, $timeoffset) = @_;
+
+        my $function;
+        if( $noderef =~ s/^(.+)\@//o )
+        {
+            $function = $1;
+        }
+
+        if( defined( $function ) and not $validFuntcionNames{$function} )
+        {
+            my $path = $config_tree->path($token);
+            Error('Invalid function name ' . $function .
+                  ' in node reference at ' . $path);
+            $ok = 0;
+            return undef;
+        }            
+        
+        my $leaf = length($noderef) > 0 ?
+            $config_tree->getRelative($token, $noderef) : $token;
+
+        if( not defined $leaf )
+        {
+            my $path = $config_tree->path($token);
+            Error("Cannot find relative reference $noderef at $path");
+            $ok = 0;
+            return undef;
+        }
+        if( not $config_tree->isLeaf( $leaf ) )
+        {
+            my $path = $config_tree->path($token);
+            Error("Relative reference $noderef at $path is not a leaf");
+            $ok = 0;
+            return undef;
+        }
+        if( $config_tree->getNodeParam($leaf, 'leaf-type') ne 'rrd-def' )
+        {
+            my $path = $config_tree->path($token);
+            Error("Relative reference $noderef at $path must point to a ".
+                  "leaf of type rrd-def");
+            $ok = 0;
+            return undef;
+        }
+        if( defined( $timeoffset ) and not $timeoffset_supported )
+        {
+            my $path = $config_tree->path($token);
+            Error("Time offsets are not supported at $path");
+            $ok = 0;
+            return undef;
+        }
+
+        $ds_couter++;
+        return 'TESTED';
+    };
+
+    $rpn->translate( $expr, $callback );
+    if( $ok and $ds_couter == 0 )
+    {
+        my $path = $config_tree->path($token);
+        Error("RPN must contain at least one DS reference at $path");
+        $ok = 0;
+    }
+    return $ok;
+}
+
+
+
+sub validateViews
+{
+    my $config_tree = shift;
+    my $ok = 1;
+
+    foreach my $view ($config_tree->getViewNames())
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        $ok = validateInstanceParams($config_tree, $view,
+                                     'view', \%view_params) ? $ok:0;
+        if( $ok and $config_tree->getParam($view, 'view-type') eq 'rrgraph' )
+        {
+            my $hrulesList = $config_tree->getParam($view, 'hrules');
+            if( defined( $hrulesList ) )
+            {
+                foreach my $hrule ( split(',', $hrulesList ) )
+                {
+                    my $valueParam =
+                        $config_tree->getParam($view, 'hrule-value-' . $hrule);
+                    if( not defined( $valueParam ) or $valueParam !~ /^\S+$/o )
+                    {
+                        Error('Mandatory parameter hrule-value-' . $hrule .
+                              ' is not defined or incorrect for view ' .
+                              $view);
+                        $ok = 0;
+                    }
+                    my $color =
+                        $config_tree->getParam($view, 'hrule-color-'.$hrule);
+                    if( not defined( $color ) )
+                    {
+                        Error('Mandatory parameter hrule-color-' . $hrule .
+                              ' is not defined for view ' . $view);
+                        $ok = 0;
+                    }
+                    else
+                    {
+                        $ok = validateColor( $color ) ? $ok:0;
+                    }
+                }
+            }
+
+            my $decorList = $config_tree->getParam($view, 'decorations');
+            if( defined( $decorList ) )
+            {
+                foreach my $decorName ( split(',', $decorList ) )
+                {
+                    foreach my $paramName ( qw(order style color expr) )
+                    {
+                        my $param = 'dec-' . $paramName . '-' . $decorName;
+                        if( not defined( $config_tree->
+                                         getParam($view, $param) ) )
+                        {
+                            Error('Missing parameter: ' . $param .
+                                  ' in view ' . $view);
+                            $ok = 0;
+                        }
+                    }
+
+                    $ok = validateLine( $config_tree->
+                                        getParam($view,
+                                                 'dec-style-' . $decorName) )
+                        ? $ok:0;
+                    $ok = validateColor( $config_tree->
+                                         getParam($view,
+                                                  'dec-color-' . $decorName) )
+                        ? $ok:0;
+                }
+            }
+
+            $ok = validateColor( $config_tree->getParam($view, 'line-color') )
+                ? $ok:0;
+            $ok = validateLine( $config_tree->getParam($view, 'line-style') )
+                ? $ok:0;
+
+            my $gprintValues = $config_tree->getParam($view, 'gprint-values');
+            if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
+            {
+                foreach my $gprintVal ( split(',', $gprintValues ) )
+                {
+                    my $format =
+                        $config_tree->getParam($view,
+                                               'gprint-format-' . $gprintVal);
+                    if( not defined( $format ) or length( $format ) == 0 )
+                    {
+                        Error('GPRINT format for ' . $gprintVal .
+                              ' is not defined for view ' .  $view);
+                        $ok = 0;
+                    }
+                }
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub validateColor
+{
+    my $color = shift;
+    my $ok = 1;
+
+    if( $color !~ /^\#[0-9a-fA-F]{6}$/o )
+    {
+        if( $color =~ /^\#\#(\S+)$/o )
+        {
+            if( not $Torrus::Renderer::graphStyles{$1}{'color'} )
+            {
+                Error('Incorrect color reference: ' . $color);
+                $ok = 0;
+            }
+        }
+        else
+        {
+            Error('Incorrect color syntax: ' . $color);
+            $ok = 0;
+        }
+    }
+
+    return $ok;
+}
+
+
+sub validateLine
+{
+    my $line = shift;
+    my $ok = 1;
+
+    if( $line =~ /^\#\#(\S+)$/o )
+    {
+        if( not $Torrus::Renderer::graphStyles{$1}{'line'} )
+        {
+            Error('Incorrect line style reference: ' . $line);
+            $ok = 0;
+        }
+    }
+    elsif( not $Torrus::SiteConfig::validLineStyles{$line} )
+    {
+        Error('Incorrect line syntax: ' . $line);
+        $ok = 0;
+    }
+
+    return $ok;
+}
+
+
+sub validateMonitors
+{
+    my $config_tree = shift;
+    my $ok = 1;
+
+    foreach my $action ($config_tree->getActionNames())
+    {        
+        $ok = validateInstanceParams($config_tree, $action,
+                                     'action', \%action_params) ? $ok:0;
+        my $atype = $config_tree->getParam($action, 'action-type');
+        if( $atype eq 'tset' )
+        {
+            my $tset = $config_tree->getParam($action, 'tset-name');
+            if( defined $tset )
+            {
+                $tset = 'S'.$tset;
+                if( not $config_tree->tsetExists( $tset ) )
+                {
+                    Error("Token-set does not exist: $tset in action $action");
+                    $ok = 0;
+                }
+            }
+            # Otherwise the error is already reported by validateInstanceParams
+        }
+        elsif( $atype eq 'exec' )
+        {
+            my $launch_when = $config_tree->getParam($action, 'launch-when');
+            if( defined $launch_when )
+            {
+                foreach my $when ( split(',', $launch_when) )
+                {
+                    my $matched = 0;
+                    foreach my $event ('set', 'repeat', 'clear', 'forget')
+                    {
+                        if( $when eq $event )
+                        {
+                            $matched = 1;
+                        }
+                    }
+                    if( not $matched )
+                    {
+                        if( $when eq 'throw' )
+                        {
+                            Error('Event type "throw" is no longer ' .
+                                  'supported. Replace with "set".');
+                        }
+                        else
+                        {
+                            Error("Invalid value in parameter launch-when " .
+                                  "in action $action: $when");
+                        }
+                        $ok = 0;
+                    }
+                }
+            }
+
+            my $setenv_dataexpr =
+                $config_tree->getParam( $action, 'setenv-dataexpr' );
+
+            if( defined( $setenv_dataexpr ) )
+            {
+                # <param name="setenv_dataexpr"
+                #        value="ENV1=expr1, ENV2=expr2"/>
+
+                foreach my $pair ( split( ',', $setenv_dataexpr ) )
+                {
+                    my ($env, $param) = split( '=', $pair );
+                    if( not $param )
+                    {
+                        Error("Syntax error in setenv-dataexpr in action " .
+                              $action . ": \"" . $pair . "\"");
+                        $ok = 0;
+                    }
+                    elsif( $env =~ /\W/o )
+                    {
+                        Error("Illegal characters in environment variable ".
+                              "name in setenv-dataexpr in action " . $action .
+                              ": \"" . $env . "\"");
+                        $ok = 0;
+                    }
+                    elsif( not defined ($config_tree->getParam( $action,
+                                                                $param ) ) )
+                    {
+                        Error("Parameter referenced in setenv-dataexpr is " .
+                              "not defined in action " .
+                              $action . ": " . $param);
+                        $ok = 0;
+                    }
+                }
+            }
+        }
+    }
+
+    foreach my $monitor ($config_tree->getMonitorNames())
+    {
+        $ok = validateInstanceParams($config_tree, $monitor,
+                                     'monitor', \%monitor_params) ? $ok:0;
+        my $alist = $config_tree->getParam( $monitor, 'action' );
+        foreach my $action ( split(',', $alist ) )
+        {
+            if( not $config_tree->actionExists( $action ) )
+            {
+                Error("Non-existent action: $action in monitor $monitor");
+                $ok = 0;
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub validateTokensets
+{
+    my $config_tree = shift;
+    my $ok = 1;
+
+    my $view = $config_tree->getParam( 'SS', 'default-tsetlist-view' );
+    if( not defined( $view ) )
+    {
+        Error("View is not defined for tokensets list");
+        $ok = 0;
+    }
+    elsif( not $config_tree->viewExists( $view ) )
+    {
+        Error("Non-existent view is defined for tokensets list");
+        $ok = 0;
+    }
+
+    foreach my $tset ($config_tree->getTsets())
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        $view = $config_tree->getParam($tset, 'default-tset-view');
+        if( not defined( $view ) )
+        {
+            $view = $config_tree->getParam('SS', 'default-tset-view');
+        }
+
+        if( not defined( $view ) )
+        {
+            Error("Default view is not defined for tokenset $tset");
+            $ok = 0;
+        }
+        elsif( not $config_tree->viewExists( $view ) )
+        {
+            Error("Non-existent view is defined for tokenset $tset");
+            $ok = 0;
+        }
+    }
+    return $ok;
+}
+
+
+
+
+sub validateInstanceParams
+{
+    my $config_tree = shift;
+    my $inst_name = shift;
+    my $inst_type = shift;
+    my $mapref = shift;
+
+    &Torrus::DB::checkInterrupted();
+    
+    # Debug("Validating $inst_type $inst_name");
+
+    my $ok = 1;
+    my @namemaps = ($mapref);
+
+    while( $ok and scalar(@namemaps) > 0 )
+    {
+        my @next_namemaps = ();
+
+        foreach my $namemap (@namemaps)
+        {
+            foreach my $paramkey (keys %{$namemap})
+            {
+                # Debug("Checking param: $pname");
+
+                my $pname = $paramkey;
+                my $mandatory = 1;
+                if( $pname =~ s/^\+//o )
+                {
+                    $mandatory = 0;
+                }
+
+                my $listval = 0;
+                if( $pname =~ s/^\@//o )
+                {
+                    $listval = 1;
+                }
+                
+                my $pvalue =
+                    $config_tree->getInstanceParam($inst_type,
+                                                   $inst_name, $pname);
+
+                my @pvalues;
+                if( $listval )
+                {
+                    @pvalues = split(',', $pvalue);
+                }
+                else
+                {
+                    @pvalues = ( $pvalue );
+                }
+                
+                if( not defined( $pvalue ) )
+                {
+                    if( $mandatory )
+                    {
+                        my $msg;
+                        if( $inst_type eq 'node' )
+                        {
+                            $msg = $config_tree->path( $inst_name );
+                        }
+                        else
+                        {
+                            $msg = "$inst_type $inst_name";
+                        }
+                        Error("Mandatory parameter $pname is not ".
+                              "defined for $msg");
+                        $ok = 0;
+                    }
+                }
+                else
+                {
+                    if( ref( $namemap->{$paramkey} ) )
+                    {
+                        foreach my $pval ( @pvalues )
+                        {
+                            if( exists $namemap->{$paramkey}->{$pval} )
+                            {
+                                if( defined $namemap->{$paramkey}->{$pval} )
+                                {
+                                    push( @next_namemaps,
+                                          $namemap->{$paramkey}->{$pval} );
+                                }
+                            }
+                            else
+                            {
+                                my $msg;
+                                if( $inst_type eq 'node' )
+                                {
+                                    $msg = $config_tree->path( $inst_name );
+                                }
+                                else
+                                {
+                                    $msg = "$inst_type $inst_name";
+                                }
+                                Error("Parameter $pname has ".
+                                      "unknown value: $pval for $msg");
+                                $ok = 0;
+                            }
+                        }
+                    }
+                }
+            }
+        }
+        @namemaps = @next_namemaps;
+    }
+    return $ok;
+}
+
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ConfigTree/Writer.pm b/torrus/perllib/Torrus/ConfigTree/Writer.pm
new file mode 100644
index 000000000..9c1af8f86
--- /dev/null
+++ b/torrus/perllib/Torrus/ConfigTree/Writer.pm
@@ -0,0 +1,755 @@
+#  Copyright (C) 2002-2007  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Writer.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+#
+# Write access for ConfigTree
+#
+
+package Torrus::ConfigTree::Writer;
+
+use Torrus::ConfigTree;
+our @ISA=qw(Torrus::ConfigTree);
+
+use Torrus::Log;
+use Torrus::TimeStamp;
+use Torrus::SiteConfig;
+use Torrus::ServiceID;
+    
+use strict;
+use Digest::MD5 qw(md5); # needed as hash function
+
+
+our %multigraph_remove_space =
+    ('ds-expr-' => 1,
+     'graph-legend-' => 0);
+
+
+# instance of Torrus::ServiceID object, if needed
+my $srvIdParams;
+
+# tree names where we initialized service IDs
+my %srvIdInitialized;
+
+
+sub new
+{
+    my $proto = shift;
+    my %options = @_;
+    my $class = ref($proto) || $proto;
+    $options{'-WriteAccess'} = 1;
+    my $self  = $class->SUPER::new( %options );
+    if( not defined( $self ) )
+    {
+        return undef;
+    }
+    
+    bless $self, $class;
+
+    $self->{'viewparent'} = {};
+    $self->{'mayRunCollector'} =
+        Torrus::SiteConfig::mayRunCollector( $self->treeName() );
+
+    $self->{'collectorInstances'} =
+        Torrus::SiteConfig::collectorInstances( $self->treeName() );
+
+    $self->{'db_collectortokens'} = [];
+    foreach my $instance ( 0 .. ($self->{'collectorInstances'} - 1) )
+    {
+        $self->{'db_collectortokens'}->[$instance] =
+            new Torrus::DB( 'collector_tokens' . '_' .
+                            $instance . '_' . $self->{'ds_config_instance'},
+                            -Subdir => $self->treeName(),
+                            -WriteAccess => 1,
+                            -Truncate    => 1 );
+    }
+
+    # delay writing of frequently changed values
+    $self->{'db_dsconfig'}->delay();
+    $self->{'db_otherconfig'}->delay();    
+    return $self;
+}
+
+
+sub newToken
+{
+    my $self = shift;
+    my $token = $self->{'next_free_token'};
+    $token = 1 unless defined( $token );
+    $self->{'next_free_token'} = $token + 1;
+    return sprintf('T%.4d', $token);
+}
+
+
+sub setParam
+{
+    my $self  = shift;
+    my $name  = shift;
+    my $param = shift;
+    my $value = shift;
+
+    if( $self->getParamProperty( $param, 'remspace' ) )
+    {
+        $value =~ s/\s+//go;
+    }
+
+    $self->{'paramcache'}{$name}{$param} = $value;
+    $self->{'db_otherconfig'}->put( 'P:'.$name.':'.$param, $value );
+    $self->{'db_otherconfig'}->addToList('Pl:'.$name, $param);
+}
+
+sub setNodeParam
+{
+    my $self  = shift;
+    my $name  = shift;
+    my $param = shift;
+    my $value = shift;
+
+    if( $self->getParamProperty( $param, 'remspace' ) )
+    {
+        $value =~ s/\s+//go;
+    }
+
+    $self->{'paramcache'}{$name}{$param} = $value;
+    $self->{'db_dsconfig'}->put( 'P:'.$name.':'.$param, $value );
+    $self->{'db_dsconfig'}->addToList('Pl:'.$name, $param);
+}
+
+
+sub setParamProperty
+{
+    my $self = shift;
+    my $param = shift;
+    my $prop = shift;
+    my $value = shift;
+
+    $self->{'paramprop'}{$prop}{$param} = $value;
+    $self->{'db_paramprops'}->put( $param . ':' . $prop, $value );
+}
+
+
+sub initRoot
+{
+    my $self  = shift;
+    if( not defined( $self->token('/') ) )
+    {
+        my $token = $self->newToken();
+        $self->{'db_dsconfig'}->put( 'pt:/', $token );
+        $self->{'db_dsconfig'}->put( 'tp:'.$token, '/' );
+        $self->{'db_dsconfig'}->put( 'n:'.$token, 0 );
+        $self->{'nodetype_cache'}{$token} = 0;
+    }
+}
+
+sub addChild
+{
+    my $self = shift;
+    my $token = shift;
+    my $childname = shift;
+    my $isAlias = shift;
+
+    if( not $self->isSubtree( $token ) )
+    {
+        Error('Cannot add a child to a non-subtree node: ' .
+              $self->path($token));
+        return undef;
+    }
+
+    my $path = $self->path($token) . $childname;
+
+    # If the child already exists, do nothing
+
+    my $ctoken = $self->token($path);
+    if( not defined($ctoken) )
+    {
+        $ctoken = $self->newToken();
+
+        $self->{'db_dsconfig'}->put( 'pt:'.$path, $ctoken );
+        $self->{'db_dsconfig'}->put( 'tp:'.$ctoken, $path );
+
+        $self->{'db_dsconfig'}->addToList( 'c:'.$token, $ctoken );
+        $self->{'db_dsconfig'}->put( 'p:'.$ctoken, $token );
+        $self->{'parentcache'}{$ctoken} = $token;
+
+        my $nodeType;
+        if( $isAlias )
+        {
+            $nodeType = 2; # alias
+        }
+        elsif( $childname =~ /\/$/o )
+        {
+            $nodeType = 0; # subtree
+        }
+        else
+        {
+            $nodeType = 1; # leaf
+        }
+        $self->{'db_dsconfig'}->put( 'n:'.$ctoken, $nodeType );
+        $self->{'nodetype_cache'}{$ctoken} = $nodeType;
+    }
+    return $ctoken;
+}
+
+sub setAlias
+{
+    my $self = shift;
+    my $token = shift;
+    my $apath = shift;
+
+    my $ok = 1;
+
+    my $iamLeaf = $self->isLeaf($token);
+
+    # TODO: Add more verification here
+    if( not defined($apath) or $apath !~ /^\//o or
+        ( not $iamLeaf and $apath !~ /\/$/o ) or
+        ( $iamLeaf and $apath =~ /\/$/o ) )
+    {
+        my $path = $self->path($token);
+        Error("Incorrect alias at $path: $apath"); $ok = 0;
+    }
+    elsif( $self->token( $apath ) )
+    {
+        my $path = $self->path($token);
+        Error("Alias already exists: $apath at $path"); $ok = 0;
+    }
+    else
+    {
+        # Go through the alias and create subtrees if neccessary
+
+        my @pathelements = $self->splitPath($apath);
+        my $aliasChildName = pop @pathelements;
+
+        my $nodepath = '';
+        my $parent_token = $self->token('/');
+
+        foreach my $nodename ( @pathelements )
+        {
+            $nodepath .= $nodename;
+            my $child_token = $self->token( $nodepath );
+            if( not defined( $child_token ) )
+            {
+                $child_token = $self->addChild( $parent_token, $nodename );
+                if( not defined( $child_token ) )
+                {
+                    return 0;
+                }
+            }
+            $parent_token = $child_token;
+        }
+
+        my $alias_token = $self->addChild( $parent_token, $aliasChildName, 1 );
+        if( not defined( $alias_token ) )
+        {
+            return 0;
+        }
+
+        $self->{'db_dsconfig'}->put( 'a:'.$alias_token, $token );
+        $self->{'db_dsconfig'}->addToList( 'ar:'.$token, $alias_token );
+        $self->{'db_aliases'}->put( $apath, $token );
+    }
+    return $ok;
+}
+
+sub addView
+{
+    my $self = shift;
+    my $vname = shift;
+    my $parent = shift;
+    $self->{'db_otherconfig'}->addToList('V:', $vname);
+    if( defined( $parent ) )
+    {
+        $self->{'viewparent'}{$vname} = $parent;
+    }
+}
+
+
+sub addMonitor
+{
+    my $self = shift;
+    my $mname = shift;
+    $self->{'db_otherconfig'}->addToList('M:', $mname);
+}
+
+
+sub addAction
+{
+    my $self = shift;
+    my $aname = shift;
+    $self->{'db_otherconfig'}->addToList('A:', $aname);
+}
+
+
+sub addDefinition
+{
+    my $self = shift;
+    my $name = shift;
+    my $value = shift;
+    $self->{'db_dsconfig'}->put( 'd:'.$name, $value );
+    $self->{'db_dsconfig'}->addToList('D:', $name);
+}
+
+
+sub setVar
+{
+    my $self = shift;
+    my $token = shift;
+    my $name = shift;
+    my $value = shift;
+    
+    $self->{'setvar'}{$token}{$name} = $value;
+}
+
+
+sub isTrueVar
+{
+    my $self = shift;
+    my $token = shift;
+    my $name = shift;
+
+    my $ret = 0;
+
+    while( defined( $token ) and
+           not defined( $self->{'setvar'}{$token}{$name} ) )
+    {
+        $token = $self->getParent( $token );
+    }
+
+    if( defined( $token ) )
+    {
+        my $value = $self->{'setvar'}{$token}{$name};
+        if( defined( $value ) )
+        {
+            if( $value eq 'true' or
+                $value =~ /^\d+$/o and $value )
+            {
+                $ret = 1;
+            }
+        }
+    }
+    
+    return $ret;
+}
+
+sub finalize
+{
+    my $self = shift;
+    my $status = shift;
+
+    if( $status )
+    {
+        # write delayed data
+        $self->{'db_dsconfig'}->commit();
+        $self->{'db_otherconfig'}->commit();    
+        
+        Verbose('Configuration has compiled successfully. Switching over to ' .
+             'DS config instance ' . $self->{'ds_config_instance'} .
+             ' and Other config instance ' .
+             $self->{'other_config_instance'} );
+
+        $self->setReady(1);
+        if( not $self->{'-NoDSRebuild'} )
+        {
+            $self->{'db_config_instances'}->
+                put( 'ds:' . $self->treeName(),
+                     $self->{'ds_config_instance'} );
+        }
+
+        $self->{'db_config_instances'}->
+            put( 'other:' . $self->treeName(),
+                 $self->{'other_config_instance'} );
+
+        Torrus::TimeStamp::init();
+        Torrus::TimeStamp::setNow($self->treeName() . ':configuration');
+        Torrus::TimeStamp::release();
+    }
+}
+
+
+sub postProcess
+{
+    my $self = shift;
+
+    my $ok = $self->postProcessNodes();
+
+    # Propagate view inherited parameters
+    $self->{'viewParamsProcessed'} = {};
+    foreach my $vname ( $self->getViewNames() )
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        $self->propagateViewParams( $vname );
+    }
+    return $ok;
+}
+
+
+
+sub postProcessNodes
+{
+    my $self = shift;
+    my $token = shift;
+
+    &Torrus::DB::checkInterrupted();
+
+    my $ok = 1;
+
+    if( not defined( $token ) )
+    {
+        $token = $self->token('/');
+    }
+
+    my $nodeid = $self->getNodeParam( $token, 'nodeid', 1 );
+    if( defined( $nodeid ) )
+    {
+        # verify the uniqueness of nodeid
+        
+        my $oldToken = $self->{'db_nodeid'}->get($nodeid);
+        if( defined($oldToken) )
+        {
+            Error('Non-unique nodeid ' . $nodeid .
+                  ' in ' . $self->path($token) .
+                  ' and ' . $self->path($oldToken));
+            $ok = 0;
+        }
+        else
+        {
+            $self->{'db_nodeid'}->put($nodeid, $token);
+        }
+    }
+
+    
+    if( $self->isLeaf($token) )
+    {
+        # Process static tokenset members
+
+        my $tsets = $self->getNodeParam( $token, 'tokenset-member' );
+        if( defined( $tsets ) )
+        {
+            foreach my $tset ( split(/,/o, $tsets) )
+            {
+                my $tsetName = 'S'.$tset;
+                if( not $self->tsetExists( $tsetName ) )
+                {
+                    my $path = $self->path( $token );
+                    Error("Referenced undefined token set $tset in $path");
+                    $ok = 0;
+                }
+                else
+                {
+                    $self->tsetAddMember( $tsetName, $token, 'static' );
+                }
+            }
+        }
+
+        my $dsType = $self->getNodeParam( $token, 'ds-type' );
+        if( defined( $dsType ) )
+        {
+            if( $dsType eq 'rrd-multigraph' )
+            {
+                # Expand parameter substitutions in multigraph leaves
+                
+                my @dsNames =
+                    split(/,/o, $self->getNodeParam($token, 'ds-names') );
+                
+                foreach my $dname ( @dsNames )
+                {
+                    foreach my $param ( 'ds-expr-', 'graph-legend-' )
+                    {
+                        my $dsParam = $param . $dname;
+                        my $value = $self->getNodeParam( $token, $dsParam );
+                        if( defined( $value ) )
+                        {
+                            my $newValue = $value;
+                            if( $multigraph_remove_space{$param} )
+                            {
+                                $newValue =~ s/\s+//go;
+                            }
+                            $newValue =
+                                $self->expandSubstitutions( $token, $dsParam,
+                                                            $newValue );
+                            if( $newValue ne $value )
+                            {
+                                $self->setNodeParam( $token, $dsParam,
+                                                     $newValue );
+                            }
+                        }
+                    }
+                }
+            }
+            elsif( $dsType eq 'collector' and $self->{'mayRunCollector'} )
+            {
+                # Split the collecting job between collector instances
+                my $instance = 0;
+                my $nInstances = $self->{'collectorInstances'};
+
+                my $oldOffset =
+                    $self->getNodeParam($token, 'collector-timeoffset');
+                my $newOffset = $oldOffset;
+                
+                my $period =
+                    $self->getNodeParam($token, 'collector-period');
+                
+                if( $nInstances > 1 )
+                {
+                    my $hashString =
+                        $self->getNodeParam($token,
+                                            'collector-instance-hashstring');
+                    if( not defined( $hashString ) )
+                    {
+                        Error('collector-instance-hashstring is not defined ' .
+                              'in ' . $self->path( $token ));
+                        $hashString = '';
+                    }
+                    
+                    $instance =
+                        unpack( 'N', md5( $hashString ) ) % $nInstances;
+                }          
+
+                $self->setNodeParam( $token,
+                                     'collector-instance',
+                                     $instance );
+                
+                my $dispersed =
+                    $self->getNodeParam($token,
+                                        'collector-dispersed-timeoffset');
+                if( defined( $dispersed ) and $dispersed eq 'yes' )
+                {
+                    # Process dispersed collector offsets
+                    
+                    my %p;
+                    foreach my $param ( 'collector-timeoffset-min',
+                                        'collector-timeoffset-max',
+                                        'collector-timeoffset-step',
+                                        'collector-timeoffset-hashstring' )
+                    {
+                        my $val = $self->getNodeParam( $token, $param );
+                        if( not defined( $val ) )
+                        {
+                            Error('Mandatory parameter ' . $param . ' is not '.
+                                  ' defined in ' . $self->path( $token ));
+                            $ok = 0;
+                        }
+                        else
+                        {
+                            $p{$param} = $val;
+                        }
+                    }
+
+                    if( $ok )
+                    {
+                        my $min = $p{'collector-timeoffset-min'};
+                        my $max = $p{'collector-timeoffset-max'};
+                        if( $max < $min )
+                        {
+                            Error('collector-timeoffset-max is less than ' .
+                                  'collector-timeoffset-min in ' .
+                                  $self->path( $token ));
+                            $ok = 0;
+                        }
+                        else
+                        {
+                            my $step = $p{'collector-timeoffset-step'};
+                            my $hashString =
+                                $p{'collector-timeoffset-hashstring'};
+                            
+                            my $bucketSize = int( ($max - $min) / $step );
+                            $newOffset =
+                                $min
+                                +
+                                $step * ( unpack( 'N', md5( $hashString ) ) %
+                                          $bucketSize )
+                                +
+                                $instance * int( $step / $nInstances );
+                        }
+                    }
+                }
+                else
+                {
+                    $newOffset += $instance * int( $period / $nInstances ); 
+                } 
+
+                $newOffset %= $period;
+                
+                if( $newOffset != $oldOffset )
+                {
+                    $self->setNodeParam( $token,
+                                         'collector-timeoffset',
+                                         $newOffset );
+                }
+
+                $self->{'db_collectortokens'}->[$instance]->put
+                    ( $token, sprintf('%d:%d', $period, $newOffset) );
+
+                my $storagetypes =
+                    $self->getNodeParam( $token, 'storage-type' );
+                foreach my $stype ( split(/,/o, $storagetypes) )
+                {
+                    if( $stype eq 'ext' )
+                    {
+                        if( not defined( $srvIdParams ) )
+                        {
+                            $srvIdParams =
+                                new Torrus::ServiceID( -WriteAccess => 1 );
+                        }
+
+                        my $srvTrees =
+                            $self->getNodeParam($token, 'ext-service-trees');
+
+                        if( not defined( $srvTrees ) or
+                            length( $srvTrees ) == 0 )
+                        {
+                            $srvTrees = $self->treeName();
+                        }
+                                                
+                        my $serviceid =
+                            $self->getNodeParam($token, 'ext-service-id');
+
+                        foreach my $srvTree (split(/\s*,\s*/o, $srvTrees))
+                        {
+                            if( not Torrus::SiteConfig::treeExists($srvTree) )
+                            {
+                                Error
+                                    ('Error processing ext-service-trees' .
+                                     'for ' . $self->path( $token ) .
+                                     ': tree ' . $srvTree .
+                                     ' does not exist');
+                                $ok = 0;
+                            }
+                            else
+                            {
+                                if( not $srvIdInitialized{$srvTree} )
+                                {
+                                    $srvIdParams->cleanAllForTree
+                                        ( $srvTree );
+                                    $srvIdInitialized{$srvTree} = 1;
+                                }
+                                else
+                                {
+                                    if( $srvIdParams->idExists( $serviceid,
+                                                                $srvTree ) )
+                                    {
+                                        Error('Duplicate ServiceID: ' .
+                                              $serviceid . ' in tree ' .
+                                              $srvTree);
+                                        $ok = 0;
+                                    }
+                                }
+                            }
+                        }
+
+                        if( $ok )
+                        {
+                            # sorry for ackward Emacs auto-indent
+                            my $params = {
+                                'trees' => $srvTrees,
+                                'token' => $token,
+                                'dstype' =>
+                                    $self->getNodeParam($token,
+                                                        'ext-dstype'),
+                                    'units' =>
+                                    $self->getNodeParam
+                                    ($token, 'ext-service-units')
+                                };
+                            
+                            $srvIdParams->add( $serviceid, $params );
+                        }
+                    }
+                }
+            }
+        }
+        else
+        {
+            my $path = $self->path( $token );
+            Error("Mandatory parameter 'ds-type' is not defined for $path");
+            $ok = 0;
+        }            
+    }
+    else
+    {
+        foreach my $ctoken ( $self->getChildren( $token ) )
+        {
+            if( not $self->isAlias( $ctoken ) )
+            {
+                $ok = $self->postProcessNodes( $ctoken ) ? $ok:0;
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub propagateViewParams
+{
+    my $self = shift;
+    my $vname = shift;
+
+    # Avoid processing the same view twice
+    if( $self->{'viewParamsProcessed'}{$vname} )
+    {
+        return;
+    }
+
+    # First we do the same for parent
+    my $parent = $self->{'viewparent'}{$vname};
+    if( defined( $parent ) )
+    {
+        $self->propagateViewParams( $parent );
+
+        my $parentParams = $self->getParams( $parent );
+        foreach my $param ( keys %{$parentParams} )
+        {
+            if( not defined( $self->getParam( $vname, $param ) ) )
+            {
+                $self->setParam( $vname, $param, $parentParams->{$param} );
+            }
+        }
+    }
+
+    # mark this view as processed
+    $self->{'viewParamsProcessed'}{$vname} = 1;
+}
+
+
+sub validate
+{
+    my $self = shift;
+
+    my $ok = 1;
+
+    $self->{'is_writing'} = undef;
+
+    if( not $self->{'-NoDSRebuild'} )
+    {
+        $ok = Torrus::ConfigTree::Validator::validateNodes($self);
+    }
+    $ok = Torrus::ConfigTree::Validator::validateViews($self) ? $ok:0;
+    $ok = Torrus::ConfigTree::Validator::validateMonitors($self) ? $ok:0;
+    $ok = Torrus::ConfigTree::Validator::validateTokensets($self) ? $ok:0;
+
+    return $ok;
+}
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm b/torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm
new file mode 100644
index 000000000..0874270da
--- /dev/null
+++ b/torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm
@@ -0,0 +1,548 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: XMLCompiler.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ConfigTree::XMLCompiler;
+
+use Torrus::ConfigTree::Writer;
+our @ISA=qw(Torrus::ConfigTree::Writer);
+
+use Torrus::ConfigTree;
+use Torrus::ConfigTree::Validator;
+use Torrus::SiteConfig;
+use Torrus::Log;
+use Torrus::TimeStamp;
+
+use XML::LibXML;
+use strict;
+
+sub new
+{
+    my $proto = shift;
+    my %options = @_;
+    my $class = ref($proto) || $proto;
+
+    $options{'-Rebuild'} = 1;
+
+    my $self  = $class->SUPER::new( %options );
+    if( not defined( $self ) )
+    {
+        return undef;
+    }
+
+    bless $self, $class;
+
+    if( $options{'-NoDSRebuild'} )
+    {
+        $self->{'-NoDSRebuild'} = 1;
+    }
+
+    $self->{'files_processed'} = {};
+
+    return $self;
+}
+
+
+sub compile
+{
+    my $self = shift;
+    my $filename = shift;
+
+    &Torrus::DB::checkInterrupted();
+    
+    $filename = Torrus::SiteConfig::findXMLFile($filename);
+    if( not defined( $filename ) )
+    {
+        return 0;
+    }
+                    
+    # Make sure we process each file only once
+    if( $self->{'files_processed'}{$filename} )
+    {
+        return 1;
+    }
+    else
+    {
+        $self->{'files_processed'}{$filename} = 1;
+    }
+
+    Verbose('Compiling ' . $filename);
+
+    my $ok = 1;
+    my $parser = new XML::LibXML;
+    my $doc;
+    eval { $doc = $parser->parse_file( $filename );  };
+    if( $@ )
+    {
+        Error("Failed to parse $filename: $@");
+        return 0;
+    }
+
+    my $root = $doc->documentElement();
+
+    # Initialize the '/' element
+    $self->initRoot();
+
+    my $node;
+
+    # First of all process all pre-required files
+    foreach $node ( $root->getElementsByTagName('include') )
+    {
+        my $incfile = $node->getAttribute('filename');
+        if( not $incfile )
+        {
+            Error("No filename given in include statement in $filename");
+            $ok = 0;
+        }
+        else
+        {
+            $ok = $self->compile( $incfile ) ? $ok:0;
+        }
+    }
+
+    foreach $node ( $root->getElementsByTagName('param-properties') )
+    {
+        $ok = $self->compile_paramprops( $node ) ? $ok:0;
+    }
+
+    if( not $self->{'-NoDSRebuild'} )
+    {
+        foreach $node ( $root->getElementsByTagName('definitions') )
+        {
+            $ok = $self->compile_definitions( $node ) ? $ok:0;
+        }
+
+        foreach $node ( $root->getElementsByTagName('datasources') )
+        {
+            $ok = $self->compile_ds( $node ) ? $ok:0;
+        }
+    }
+
+    foreach $node ( $root->getElementsByTagName('monitors') )
+    {
+        $ok = $self->compile_monitors( $node ) ? $ok:0;
+    }
+
+    foreach $node ( $root->getElementsByTagName('token-sets') )
+    {
+        $ok = $self->compile_tokensets( $node ) ? $ok:0;
+    }
+
+    foreach $node ( $root->getElementsByTagName('views') )
+    {
+        $ok = $self->compile_views( $node ) ? $ok:0;
+    }
+
+    return $ok;
+}
+
+
+sub compile_definitions
+{
+    my $self = shift;
+    my $node = shift;
+    my $ok = 1;
+
+    foreach my $def ( $node->getChildrenByTagName('def') )
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        my $name = $def->getAttribute('name');
+        my $value = $def->getAttribute('value');
+        if( not $name )
+        {
+            Error("Definition without a name"); $ok = 0;
+        }
+        elsif( not $value )
+        {
+            Error("Definition without value: $name"); $ok = 0;
+        }
+        elsif( defined $self->getDefinition($name) )
+        {
+            Error("Duplicate definition: $name"); $ok = 0;
+        }
+        else
+        {
+            $self->addDefinition($name, $value);
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_paramprops
+{
+    my $self = shift;
+    my $node = shift;
+    my $ok = 1;
+
+    foreach my $def ( $node->getChildrenByTagName('prop') )
+    {
+        &Torrus::DB::checkInterrupted();
+          
+        my $param = $def->getAttribute('param'); 
+        my $prop = $def->getAttribute('prop');
+        my $value = $def->getAttribute('value');
+        if( not $param or not $prop or not defined($value) )
+        {
+            Error("Property definition error"); $ok = 0;
+        }
+        else
+        {
+            $self->setParamProperty($param, $prop, $value);
+        }
+    }
+    return $ok;
+}
+
+
+
+# Process <param name="name" value="value"/> and put them into DB.
+# Usage: $self->compile_params($node, $name);
+
+sub compile_params
+{
+    my $self = shift;
+    my $node = shift;
+    my $name = shift;
+    my $isDS = shift;
+
+    &Torrus::DB::checkInterrupted();
+          
+    my $ok = 1;
+    foreach my $p_node ( $node->getChildrenByTagName('param') )
+    {
+        my $param = $p_node->getAttribute('name');
+        my $value = $p_node->getAttribute('value');
+        if( not defined($value) )
+        {
+            $value = $p_node->textContent();
+        }
+        if( not $param )
+        {
+            Error("Parameter without name in $name"); $ok = 0;
+        }
+        else
+        {
+            # Remove spaces in the head and tail.
+            $value =~ s/^\s+//om;
+            $value =~ s/\s+$//om;
+
+            if( $isDS )
+            {
+                $self->setNodeParam($name, $param, $value);
+            }
+            else
+            {
+                $self->setParam($name, $param, $value);
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_ds
+{
+    my $self = shift;
+    my $ds_node = shift;
+    my $ok = 1;
+
+    # First, process templates. We expect them to be direct children of
+    # <datasources>
+
+    foreach my $template ( $ds_node->getChildrenByTagName('template') )
+    {
+        my $name = $template->getAttribute('name');
+        if( not $name )
+        {
+            Error("Template without a name"); $ok = 0;
+        }
+        elsif( defined $self->{'Templates'}->{$name} )
+        {
+            Error("Duplicate template names: $name"); $ok = 0;
+        }
+        else
+        {
+            $self->{'Templates'}->{$name} = $template;
+        }
+    }
+
+    # Recursively traverse the tree
+    $ok = $self->compile_subtrees( $ds_node, $self->token('/') ) ? $ok:0;
+
+    return $ok;
+}
+
+
+
+
+sub validate_nodename
+{
+    my $self = shift;
+    my $name = shift;
+
+    return ( $name =~ /^[0-9A-Za-z_\-\.\:]+$/o and
+             $name !~ /\.\./o );
+}
+
+sub compile_subtrees
+{
+    my $self = shift;
+    my $node = shift;
+    my $token = shift;
+    my $iamLeaf = shift;
+    
+    my $ok = 1;
+
+    # Apply templates
+
+    foreach my $templateapp ( $node->getChildrenByTagName('apply-template') )
+    {
+        my $name = $templateapp->getAttribute('name');
+        if( not $name )
+        {
+            my $path = $self->path($token);
+            Error("Template application without a name at $path"); $ok = 0;
+        }
+        else
+        {
+            my $template = $self->{'Templates'}->{$name};
+            if( not defined $template )
+            {
+                my $path = $self->path($token);
+                Error("Cannot find template named $name at $path"); $ok = 0;
+            }
+            else
+            {
+                $ok = $self->compile_subtrees
+                    ($template, $token, $iamLeaf) ? $ok:0;
+            }
+        }
+    }
+
+    $ok = $self->compile_params($node, $token, 1);
+
+    # Handle aliases -- we are still in compile_subtrees()
+
+    foreach my $alias ( $node->getChildrenByTagName('alias') )
+    {
+        my $apath = $alias->textContent();
+        $apath =~ s/\s+//mgo;
+        $ok = $self->setAlias($token, $apath) ? $ok:0;
+    }
+
+    foreach my $setvar ( $node->getChildrenByTagName('setvar') )        
+    {
+        my $name = $setvar->getAttribute('name');
+        my $value = $setvar->getAttribute('value');
+        if( not defined( $name ) or not defined( $value ) )
+        {
+            my $path = $self->path($token);
+            Error("Setvar statement without name or value in $path"); $ok = 0;
+        }
+        else
+        {
+            $self->setVar( $token, $name, $value );
+        }
+    }
+
+    # Compile-time variables
+    
+    foreach my $iftrue ( $node->getChildrenByTagName('iftrue') )        
+    {
+        my $var = $iftrue->getAttribute('var');
+        if( not defined( $var ) )
+        {
+            my $path = $self->path($token);
+            Error("Iftrue statement without variable name in $path"); $ok = 0;
+        }
+        elsif( $self->isTrueVar( $token, $var ) )
+        {
+            $ok = $self->compile_subtrees( $iftrue, $token, $iamLeaf ) ? $ok:0;
+        }
+    }
+
+    foreach my $iffalse ( $node->getChildrenByTagName('iffalse') )        
+    {
+        my $var = $iffalse->getAttribute('var');
+        if( not defined( $var ) )
+        {
+            my $path = $self->path($token);
+            Error("Iffalse statement without variable name in $path"); $ok = 0;
+        }
+        elsif( not $self->isTrueVar( $token, $var ) )
+        {
+            $ok = $self->compile_subtrees
+                ( $iffalse, $token, $iamLeaf ) ? $ok:0;
+        }
+    }
+
+    
+    # Compile child nodes -- the last part of compile_subtrees()
+
+    if( not $iamLeaf )
+    {
+        foreach my $subtree ( $node->getChildrenByTagName('subtree') )
+        {
+            my $name = $subtree->getAttribute('name');
+            if( not defined( $name ) or length( $name ) == 0 )
+            {
+                my $path = $self->path($token);
+                Error("Subtree without a name at $path"); $ok = 0;
+            }
+            else
+            {
+                if( $self->validate_nodename( $name ) )
+                {
+                    my $stoken = $self->addChild($token, $name.'/');
+                    $ok = $self->compile_subtrees( $subtree, $stoken ) ? $ok:0;
+                }
+                else
+                {
+                    my $path = $self->path($token);
+                    Error("Invalid subtree name: $name at $path"); $ok = 0;
+                }
+            }
+        }
+
+        foreach my $leaf ( $node->getChildrenByTagName('leaf') )
+        {
+            my $name = $leaf->getAttribute('name');
+            if( not defined( $name ) or length( $name ) == 0 )
+            {
+                my $path = $self->path($token);
+                Error("Leaf without a name at $path"); $ok = 0;
+            }
+            else
+            {
+                if( $self->validate_nodename( $name ) )
+                {
+                    my $ltoken = $self->addChild($token, $name);
+                    $ok = $self->compile_subtrees( $leaf, $ltoken, 1 ) ? $ok:0;
+                }
+                else
+                {
+                    my $path = $self->path($token);
+                    Error("Invalid leaf name: $name at $path"); $ok = 0;
+                }
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_monitors
+{
+    my $self = shift;
+    my $mon_node = shift;
+    my $ok = 1;
+
+    foreach my $monitor ( $mon_node->getChildrenByTagName('monitor') )
+    {
+        my $mname = $monitor->getAttribute('name');
+        if( not $mname )
+        {
+            Error("Monitor without a name"); $ok = 0;
+        }
+        else
+        {
+            $ok = $self->addMonitor( $mname );
+            $ok = $self->compile_params($monitor, $mname) ? $ok:0;
+        }
+    }
+
+    foreach my $action ( $mon_node->getChildrenByTagName('action') )
+    {
+        my $aname = $action->getAttribute('name');
+        if( not $aname )
+        {
+            Error("Action without a name"); $ok = 0;
+        }
+        else
+        {
+            $self->addAction( $aname );
+            $ok = $self->compile_params($action, $aname);
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_tokensets
+{
+    my $self = shift;
+    my $tsets_node = shift;
+    my $ok = 1;
+
+    $ok = $self->compile_params($tsets_node, 'SS') ? $ok:0;
+
+    foreach my $tokenset ( $tsets_node->getChildrenByTagName('token-set') )
+    {
+        my $sname = $tokenset->getAttribute('name');
+        if( not $sname )
+        {
+            Error("Token-set without a name"); $ok = 0;
+        }
+        else
+        {
+            $sname = 'S'. $sname;
+            $ok = $self->addTset( $sname );
+            $ok = $self->compile_params($tokenset, $sname) ? $ok:0;
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_views
+{
+    my $self = shift;
+    my $vw_node = shift;
+    my $parentname = shift;
+    my $ok = 1;
+
+    foreach my $view ( $vw_node->getChildrenByTagName('view') )
+    {
+        my $vname = $view->getAttribute('name');
+        if( not $vname )
+        {
+            Error("View without a name"); $ok = 0;
+        }
+        else
+        {
+            $self->addView( $vname, $parentname );
+            $ok = $self->compile_params( $view, $vname ) ? $ok:0;
+            # Process child views
+            $ok = $self->compile_views( $view, $vname ) ? $ok:0;
+        }
+    }
+    return $ok;
+}
+
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DB.pm b/torrus/perllib/Torrus/DB.pm
new file mode 100644
index 000000000..4d600f966
--- /dev/null
+++ b/torrus/perllib/Torrus/DB.pm
@@ -0,0 +1,703 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: DB.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::DB;
+
+use Torrus::Log;
+use BerkeleyDB;
+use strict;
+
+
+# This is an abstraction layer for BerkeleyDB database operations
+#
+# Database opening:
+#    my $db = new Torrus::DB('db_name',
+#                          [ -Btree => 1, ]
+#                          [ -WriteAccess => 1, ]
+#                          [ -Truncate    => 1, ]
+#                          [ -Subdir      => 'dirname' ]);
+#    Defaults: Hash, read-only, no truncate.
+#
+# Database closing:
+#    undef $db;
+#
+# Database cleaning:
+#    $status = $db->trunc();
+#
+
+END
+{
+    &Torrus::DB::cleanupEnvironment();
+}
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my $dbname = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    if( not defined($Torrus::DB::env) )
+    {
+        if( not defined $Torrus::Global::dbHome )
+        {
+            Error('$Torrus::Global::dbHome must be defined ' .
+                  'in torrus_config.pl');
+            return undef;
+        }
+        elsif( not -d $Torrus::Global::dbHome )
+        {
+            Error("No such directory: $Torrus::Global::dbHome" );
+            return undef;
+        }
+        else
+        {
+            $Torrus::DB::dbEnvErrFile =
+                $Torrus::Global::logDir . '/dbenv_errlog_' . $$;
+            
+            Debug("Creating BerkeleyDB::Env");
+            umask 0002;
+            $Torrus::DB::env =
+                new BerkeleyDB::Env(-Home  => $Torrus::Global::dbHome,
+                                    -Flags => (DB_CREATE |
+                                               DB_INIT_CDB | DB_INIT_MPOOL),
+                                    -Mode  => 0664,
+                                    -ErrFile => $Torrus::DB::dbEnvErrFile);
+            if( not defined($Torrus::DB::env) )
+            {
+                Error("Cannot create BerkeleyDB Environment: ".
+                      $BerkeleyDB::Error);
+                return undef;
+            }
+        }
+    }
+
+    my $filename = $dbname.'.db';
+
+    if( $options{'-Subdir'} )
+    {
+        my $dirname = $Torrus::Global::dbHome . '/' . $Torrus::DB::dbSub;
+        if( not -d $dirname and not mkdir( $dirname ) )
+        {
+            Error("Cannot create directory $dirname: $!");
+            return undef;
+        }
+        $dirname .= '/' . $options{'-Subdir'};
+        if( not -d $dirname and not mkdir( $dirname ) )
+        {
+            Error("Cannot create directory $dirname: $!");
+            return undef;
+        }
+        $filename =
+            $Torrus::DB::dbSub . '/' . $options{'-Subdir'} . '/' . $filename;
+    }
+
+    # we need this in DESTROY debug message
+    $self->{'dbname'} = $filename;
+
+    my %hash;
+
+    my $accmethod = $options{'-Btree'} ?
+        'BerkeleyDB::Btree':'BerkeleyDB::Hash';
+
+    my $flags = DB_RDONLY;
+
+    if( $options{'-WriteAccess'} )
+    {
+        $flags = DB_CREATE;
+    }
+
+    my $property = 0;
+    if( $options{'-Duplicates'} )
+    {
+        $property = DB_DUP | DB_DUPSORT;
+    }
+        
+    if( not exists( $Torrus::DB::dbPool{$filename} ) )
+    {
+        Debug('Opening ' . $self->{'dbname'});
+
+        my $dbh = new $accmethod (
+                                  -Filename => $filename,
+                                  -Flags    => $flags,
+                                  -Property => $property,
+                                  -Mode     => 0664,
+                                  -Env      => $Torrus::DB::env );
+        if( not $dbh )
+        {
+            Error("Cannot open database $filename: $! $BerkeleyDB::Error");
+            return undef;
+        }
+
+        $Torrus::DB::dbPool{$filename} = { 'dbh'        => $dbh,
+                                           'accmethod'  => $accmethod,
+                                           'flags'      => $flags };
+
+        $self->{'dbh'} = $dbh;
+    }
+    else
+    {
+        my $ref = $Torrus::DB::dbPool{$filename};
+        if( $ref->{'accmethod'} eq $accmethod and $ref->{'flags'} eq $flags )
+        {
+            $self->{'dbh'} = $ref->{'dbh'};
+        }
+        else
+        {
+            Error('Database in dbPool has different flags: ' .
+                  $self->{'dbname'});
+            return undef;
+        }
+    }
+
+    if( $options{'-Truncate'} )
+    {
+        $self->trunc();
+    }
+
+    if( $options{'-Delayed'} )
+    {
+        $self->{'delay_list_commit'} = 1;
+    }
+
+    return $self;
+}
+
+
+# It is strongly inadvisable to do anything inside a signal handler when DB
+# operation is in progress
+
+our $interrupted = 0;
+
+my $signalHandlersSet = 0;
+my $safeSignals = 0;
+
+
+
+
+
+sub setSignalHandlers
+{
+    if( $signalHandlersSet )
+    {
+        return;
+    }
+    
+    $SIG{'TERM'} = sub {
+        if( $safeSignals )
+        {
+            Warn('Received SIGTERM. Scheduling to exit.');
+            $interrupted = 1;
+        }
+        else
+        {
+            Warn('Received SIGTERM. Stopping the process.');
+            exit(1);
+        }            
+    };
+
+    $SIG{'INT'} = sub {
+        if( $safeSignals )
+        {
+            Warn('Received SIGINT. Scheduling to exit.');
+            $interrupted = 1;
+        }
+        else
+        {
+            Warn('Received SIGINT. Stopping the process');
+            exit(1);
+        }            
+    };
+    
+
+    $SIG{'PIPE'} = sub {
+        if( $safeSignals )
+        {
+            Warn('Received SIGPIPE. Scheduling to exit.');
+            $interrupted = 1;
+        }
+        else
+        {
+            Warn('Received SIGPIPE. Stopping the process');
+            exit(1);
+        }            
+    };
+    
+    $SIG{'QUIT'} = sub {
+        if( $safeSignals )
+        {
+            Warn('Received SIGQUIT. Scheduling to exit.');
+            $interrupted = 1;
+        }
+        else
+        {
+            Warn('Received SIGQUIT. Stopping the process');
+            exit(1);
+        }            
+    };
+
+    $signalHandlersSet = 1;
+}
+
+
+sub setSafeSignalHandlers
+{
+    setSignalHandlers();
+    $safeSignals = 1;
+}
+
+
+sub setUnsafeSignalHandlers
+{
+    setSignalHandlers();
+    $safeSignals = 0;
+}
+    
+
+# If we were previously interrupted, gracefully exit now
+
+sub checkInterrupted
+{
+    if( $interrupted )
+    {
+        Warn('Stopping the process');
+        exit(1);
+    }
+}
+
+
+
+sub closeNow
+{
+    my $self = shift;
+
+    my $filename = $self->{'dbname'};
+    Debug('Explicitly closing ' . $filename);
+    delete $Torrus::DB::dbPool{$filename};
+    $self->{'dbh'}->db_close();
+    delete $self->{'dbh'};
+}
+
+sub cleanupEnvironment
+{
+    if( defined( $Torrus::DB::env ) )
+    {
+        foreach my $filename ( sort keys %Torrus::DB::dbPool )
+        {
+            Debug('Closing ' . $filename);
+            $Torrus::DB::dbPool{$filename}->{'dbh'}->db_close();
+            delete $Torrus::DB::dbPool{$filename};
+        }
+        
+        Debug("Destroying BerkeleyDB::Env");
+        $Torrus::DB::env->close();
+        $Torrus::DB::env = undef;
+
+        if( -z $Torrus::DB::dbEnvErrFile )
+        {
+            unlink $Torrus::DB::dbEnvErrFile;
+        }
+    }
+}
+
+
+sub delay
+{
+    my $self = shift;
+    $self->{'delay_list_commit'} = 1;
+}
+
+    
+
+sub trunc
+{
+    my $self = shift;
+
+    Debug('Truncating ' . $self->{'dbname'});
+    my $count = 0;
+    return $self->{'dbh'}->truncate($count) == 0;
+}
+
+
+sub put
+{
+    my $self = shift;
+    my $key = shift;
+    my $val = shift;
+
+    ref( $self->{'dbh'} ) or die( 'Fatal error: ' . $self->{'dbname'} );
+    return $self->{'dbh'}->db_put($key, $val) == 0;
+}
+
+sub get
+{
+    my $self = shift;
+    my $key = shift;
+    my $val = undef;
+
+    $self->{'dbh'}->db_get($key, $val);
+    return $val;
+}
+
+
+sub del
+{
+    my $self = shift;
+    my $key = shift;
+    my $val = undef;
+
+    return $self->{'dbh'}->db_del($key) == 0;
+}
+
+
+sub cursor
+{
+    my $self = shift;
+    my %options = @_;
+    
+    return $self->{'dbh'}->db_cursor( $options{'-Write'} ? DB_WRITECURSOR:0 );
+}
+
+
+sub next
+{
+    my $self = shift;
+    my $cursor = shift;
+    my $key = '';
+    my $val = '';
+
+    if( $cursor->c_get($key, $val, DB_NEXT) == 0 )
+    {
+        return ($key, $val);
+    }
+    else
+    {
+        return ();
+    }
+}
+
+sub c_del
+{
+    my $self = shift;
+    my $cursor = shift;
+
+    my $cnt = 0;
+    $cursor->c_del( $cnt );
+}
+
+
+sub c_get
+{
+    my $self = shift;
+    my $cursor = shift;
+    my $key = shift;
+    my $val = undef;
+
+    if( $cursor->c_get( $key, $val, DB_SET ) == 0 )
+    {
+        return $val;
+    }
+    else
+    {
+        return undef;
+    }
+}
+
+sub c_put
+{
+    my $self = shift;
+    my $cursor = shift;
+    my $key = shift;
+    my $val = shift;
+
+    return ( $cursor->c_put( $key, $val, DB_KEYFIRST ) == 0 );
+}
+
+
+
+# Btree best match. We assume that the searchKey is longer or equal
+# than the matched key in the database.
+#
+# If none found, returns undef.
+# If found, returns a hash with keys
+# "exact" => true when exact match found
+# "key"   => key as is stored in the database
+# "value" => value from the matched database entry
+# The found key is shorter or equal than searchKey, and is a prefix
+# of the searchKey
+
+sub getBestMatch
+{
+    my $self = shift;
+    my $searchKey = shift;
+
+    my $key = $searchKey;
+    my $searchLen = length( $searchKey );
+    my $val = '';
+    my $ret = {};
+    my $ok = 0;
+
+    my $cursor = $self->{'dbh'}->db_cursor();
+
+    if( $cursor->c_get( $key, $val, DB_SET_RANGE ) == 0 )
+    {
+        if( $key eq $searchKey )
+        {
+            $ok = 1;
+            $ret->{'exact'} = 1;
+        }
+        else
+        {
+            # the returned key/data pair is the smallest data item greater
+            # than or equal to the specified data item.
+            # The previous entry should be what we search for.
+            if( $cursor->c_get( $key, $val, DB_PREV ) == 0 )
+            {
+                if( length( $key ) < $searchLen and
+                    index( $searchKey, $key ) == 0 )
+                {
+                    $ok = 1;
+                    $ret->{'key'} = $key;
+                    $ret->{'value'} = $val;
+                }
+            }
+        }
+    }
+    else
+    {
+        if ( $cursor->c_get( $key, $val, DB_LAST ) == 0 )
+        {
+            if( length( $key ) < $searchLen and
+                index( $searchKey, $key ) == 0 )
+            {
+                $ok = 1;
+                $ret->{'key'} = $key;
+                $ret->{'value'} = $val;
+            }
+        }
+    }
+
+    return( $ok ? $ret : undef );
+}
+
+
+# Search the keys that match the specified prefix.
+# Return value is an array of [key,val] pairs or undef
+# Returned keys may be duplicated if the DB is created with -Duplicates
+
+sub searchPrefix
+{
+    my $self = shift;
+    my $prefix = shift;
+
+    my $ret = [];
+    my $ok = 0;
+
+    my $key = $prefix;
+    my $val = '';
+
+    my $cursor = $self->{'dbh'}->db_cursor();
+
+    if( $cursor->c_get( $key, $val, DB_SET_RANGE ) == 0 )
+    {
+        # the returned key/data pair is the smallest data item greater
+        # than or equal to the specified data item.
+        my $finished = 0;
+        while( not $finished )
+        {
+            if( index( $key, $prefix ) == 0 )
+            {
+                $ok = 1;
+                push( @{$ret}, [ $key, $val ] );
+
+                if( $cursor->c_get($key, $val, DB_NEXT) != 0 )
+                {
+                    $finished = 1;
+                }
+            }
+            else
+            {
+                $finished = 1;
+            }
+        }
+    }
+
+    undef $cursor;
+
+    return( $ok ? $ret : undef );    
+}
+    
+
+# Search the keys that match the specified substring.
+# Return value is an array of [key,val] pairs or undef
+# Returned keys may be duplicated if the DB is created with -Duplicates
+
+sub searchSubstring
+{
+    my $self = shift;
+    my $substring = shift;
+
+    my $ret = [];
+    my $ok = 0;
+
+    my $key = '';
+    my $val = '';
+
+    my $cursor = $self->{'dbh'}->db_cursor();
+
+    while( $cursor->c_get($key, $val, DB_NEXT) == 0 )
+    {
+        if( index( $key, $substring ) >= 0 )
+        {
+            $ok = 1;
+            push( @{$ret}, [ $key, $val ] );
+        }
+    }
+    
+    undef $cursor;
+    
+    return( $ok ? $ret : undef );    
+}
+    
+
+
+
+
+# Comma-separated list manipulation
+
+sub _populateListCache
+{
+    my $self = shift;
+    my $key = shift;
+
+    if( not exists( $self->{'listcache'}{$key} ) )
+    {
+        my $ref = {};        
+        my $values = $self->get($key);
+        if( defined( $values ) )
+        {
+            foreach my $val (split(/,/o, $values))
+            {
+                $ref->{$val} = 1;
+            }
+        }
+        $self->{'listcache'}{$key} = $ref;
+    }
+}
+
+
+sub _storeListCache
+{
+    my $self = shift;
+    my $key = shift;
+
+    if( not $self->{'delay_list_commit'} )
+    {
+        $self->put($key, join(',', keys %{$self->{'listcache'}{$key}}));
+    }
+}
+
+    
+sub addToList
+{
+    my $self = shift;
+    my $key = shift;
+    my $newval = shift;
+
+    $self->_populateListCache($key);
+    
+    $self->{'listcache'}{$key}{$newval} = 1;
+    
+    $self->_storeListCache($key);
+}
+
+
+sub searchList
+{
+    my $self = shift;
+    my $key = shift;
+    my $name = shift;
+
+    $self->_populateListCache($key);
+    return $self->{'listcache'}{$key}{$name};
+}
+
+
+sub delFromList
+{
+    my $self = shift;
+    my $key = shift;
+    my $name = shift;
+
+    $self->_populateListCache($key);
+    if( $self->{'listcache'}{$key}{$name} )
+    {
+        delete $self->{'listcache'}{$key}{$name};
+    }
+    
+    $self->_storeListCache($key);
+}
+
+
+sub getListItems
+{
+    my $self = shift;
+    my $key = shift;
+
+    $self->_populateListCache($key);
+    return keys %{$self->{'listcache'}{$key}};
+}
+
+    
+
+sub deleteList
+{
+    my $self = shift;
+    my $key = shift;
+
+    delete $self->{'listcache'}{$key};
+    $self->del($key);
+}
+
+
+sub commit
+{
+    my $self = shift;
+    
+    if( $self->{'delay_list_commit'} and
+        defined( $self->{'listcache'} ) )
+    {
+        while( my($key, $list) = each %{$self->{'listcache'}} )
+        {
+            $self->put($key, join(',', keys %{$list}));
+        }
+    }
+}
+            
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DataAccess.pm b/torrus/perllib/Torrus/DataAccess.pm
new file mode 100644
index 000000000..e03fda10b
--- /dev/null
+++ b/torrus/perllib/Torrus/DataAccess.pm
@@ -0,0 +1,317 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: DataAccess.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::DataAccess;
+
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::RPN;
+
+use strict;
+use RRDs;
+
+# The Torrus::DataAccess object contains cached values, and it does not
+# check the cache validity. We assume that a Torrus::DataAccess object
+# lifetime is within a short period of time, such as one monitor cycle.
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    bless $self, $class;
+    return $self;
+}
+
+# Read the data from datasource file, depending on its type.
+# If time is not specified, reads the latest available data.
+# In case of rrd-cdef leaf type, the returned timestamp is the
+# earliest timestamp of the data sources involved.
+#
+# ($value, $timestamp) = $da->read( $config_tree, $leaf_token )
+#
+# ($value, $timestamp) = $da->read( $config_tree, $leaf_token, $end_time )
+#
+# ($value, $timestamp) = $da->read( $config_tree, $leaf_token,
+#                                   $end_time, $start_time )
+
+
+sub read
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $t_end = shift;
+    my $t_start = shift;
+
+    my $cachekey = $token .
+        ':' . (defined($t_end)?$t_end:'') .
+        ':' . (defined($t_start)?$t_start:'');
+    
+    if( exists( $self->{'cache_read'}{$cachekey} ) )
+    {
+        return @{$self->{'cache_read'}{$cachekey}};
+    }
+    
+    if( not $config_tree->isLeaf( $token ) )
+    {
+        my $path = $config_tree->path( $token );
+        Error("Torrus::DataAccess::readLast: $path is not a leaf");
+        return undef;
+    }
+
+    my $ret_val;
+    my $ret_time;
+    
+    my $ds_type = $config_tree->getNodeParam( $token, 'ds-type' );
+    if( $ds_type eq 'rrd-file' or
+        $ds_type eq 'collector' )
+    {
+        my $leaf_type = $config_tree->getNodeParam( $token, 'leaf-type' );
+
+        if( $leaf_type eq 'rrd-def' )
+        {
+            my $file = $config_tree->getNodeParam( $token, 'data-file' );
+            my $dir = $config_tree->getNodeParam( $token, 'data-dir' );
+            my $ds = $config_tree->getNodeParam( $token, 'rrd-ds' );
+            my $cf = $config_tree->getNodeParam( $token, 'rrd-cf' );
+            ( $ret_val, $ret_time ) =
+                $self->read_RRD_DS( $dir.'/'.$file,
+                                    $cf, $ds, $t_end, $t_start );
+        }
+        elsif( $leaf_type eq 'rrd-cdef' )
+        {
+            my $expr = $config_tree->getNodeParam( $token, 'rpn-expr' );
+            ( $ret_val, $ret_time ) =
+                $self->read_RPN( $config_tree, $token, $expr,
+                                 $t_end, $t_start );
+
+        }
+        else
+        {
+            my $path = $config_tree->path( $token );
+            Error("$path: leaf-type $leaf_type is not supported ".
+                  "for data access");
+        }
+    }
+    else
+    {
+        my $path = $config_tree->path( $token );
+        Error("$path: ds-type $ds_type is not supported ".
+              "for data access");
+    }
+    
+    $self->{'cache_read'}{$cachekey} = [ $ret_val, $ret_time ];
+    return ( $ret_val, $ret_time );
+}
+
+
+sub read_RRD_DS
+{
+    my $self = shift;
+    my $filename = shift;
+    my $cf = shift;
+    my $ds = shift;
+    my $t_end = shift;
+    my $t_start = shift;
+
+    my $cachekey = $filename . ':' . $cf .
+        ':' . (defined($t_end)?$t_end:'') .
+        ':' . (defined($t_start)?$t_start:'');
+
+    if( exists( $self->{'cache_RRD'}{$cachekey}{$ds} ) )
+    {
+        return @{$self->{'cache_RRD'}{$cachekey}{$ds}};
+    }
+                                         
+    my $rrdinfo = RRDs::info( $filename );
+    my $ERR = RRDs::error;
+    if( $ERR )
+    {
+        Error("Error during RRD info for $filename: $ERR");
+        return undef;
+
+    }
+    my $step = $rrdinfo->{'step'};
+    my $last_available = $rrdinfo->{'last_update'};
+    $last_available -= $last_available % $step;
+
+    if( not defined $t_end )
+    {
+        $t_end = $last_available;
+    }
+    elsif( index( $t_end, 'LAST' ) >= 0 )
+    {
+        $t_end =~ s/LAST/$last_available/g;
+    }
+
+    if( not defined $t_start )
+    {
+        $t_start = $t_end . '-' . int($step * 3);
+    }
+    elsif( index( $t_start, 'LAST' ) >= 0 )
+    {
+        $t_start =~ s/LAST/$last_available/g;
+    }
+
+    # From here on, f_ prefix means fetch results
+    my( $f_start, $f_step, $f_names, $f_data ) =
+        RRDs::fetch( $filename, $cf, '--start', $t_start, '--end', $t_end );
+    $ERR = RRDs::error;
+    if( $ERR )
+    {
+        Error("Error during RRD fetch for $filename: $ERR");
+        return undef;
+
+    }
+
+    # Memorize the DS names in cache
+    
+    for( my $i = 0; $i < @{$f_names}; $i++ )
+    {
+        $self->{'cache_RRD'}{$cachekey}{$f_names->[$i]} = [];
+    }
+    
+    # Get the last available data and store in cache
+    
+    foreach my $f_line ( @{$f_data} )
+    {
+        for( my $i = 0; $i < @{$f_names}; $i++ )
+        {
+            if( defined $f_line->[$i] )
+            {
+                $self->{'cache_RRD'}{$cachekey}{$f_names->[$i]} =
+                    [ $f_line->[$i], $f_start ];
+            }
+        }
+        $f_start += $f_step;
+    }
+    
+    if( not exists( $self->{'cache_RRD'}{$cachekey}{$ds} ) )
+    {
+        Error("DS name $ds is not found in $filename");
+        return undef;
+    }
+    else
+    {
+        if( scalar( @{$self->{'cache_RRD'}{$cachekey}{$ds}} ) == 0 )
+        {
+            Warn("Value undefined for ",
+                 "DS=$ds, CF=$cf, start=$t_start, end=$t_end in $filename");
+            return undef;
+        }
+        else
+        {
+            return @{$self->{'cache_RRD'}{$cachekey}{$ds}};
+        }
+    }
+}
+
+
+
+# Data access for other CF than defined for the leaf doesn't make much
+# sense. So we ignore the CF in DataAccess and leave it for the
+# sake of Renderer compatibility
+my %cfNames =
+    ( 'AVERAGE' => 1,
+      'MIN'     => 1,
+      'MAX'     => 1,
+      'LAST'    => 1 );
+
+
+sub read_RPN
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $expr = shift;
+    my $t_end = shift;
+    my $t_start = shift;
+
+    my @expr_list = split(',', $expr);
+    my @eval_expr;
+    my $timestamp = $t_end > 0 ? $t_end : time();
+
+    my $rpn = new Torrus::RPN;
+
+    my $callback = sub
+    {
+        my ($noderef, $timeoffset) = @_;
+
+        my $function;
+        if( $noderef =~ s/^(.)\@// )
+        {
+            $function = $1;
+        }
+
+        my $leaf = length($noderef) > 0 ?
+            $config_tree->getRelative($token, $noderef) : $token;
+
+        if( not defined $leaf )
+        {
+            my $path = $config_tree->path($token);
+            Error("Cannot find relative reference $noderef at $path");
+            return undef;
+        }
+
+        my ($rval, $var_tstamp) = $self->read($config_tree,
+                                              $leaf,
+                                              $timeoffset,
+                                              $t_start);
+        if( defined $rval )
+        {
+            if( $var_tstamp == 0 )
+            {
+                Warn("Torrus::DataAccess::read retirned zero timestamp ".
+                     "for $leaf");
+            }
+
+            if( $var_tstamp < $timestamp )
+            {
+                $timestamp = $var_tstamp;
+            }
+        }
+
+        if( defined( $function ) )
+        {
+            if( $function eq 'T' )
+            {
+                return $var_tstamp;
+            }
+            elsif( not $cfNames{$function} )
+            {
+                Error("Function not supported in RPN: $function");
+                return undef;
+            }
+        }
+        return $rval;
+    };
+
+    my $result = $rpn->run( $expr, $callback );
+
+    return ( $result, $timestamp );
+}
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover.pm b/torrus/perllib/Torrus/DevDiscover.pm
new file mode 100644
index 000000000..b6ee8eef8
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover.pm
@@ -0,0 +1,1106 @@
+#  Copyright (C) 2002-2010  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: DevDiscover.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Core SNMP device discovery module
+
+package Torrus::DevDiscover::DevDetails;
+
+package Torrus::DevDiscover;
+
+use strict;
+use POSIX qw(strftime);
+use Net::SNMP qw(:snmp :asn1);
+use Digest::MD5 qw(md5);
+
+use Torrus::Log;
+
+BEGIN
+{
+    foreach my $mod ( @Torrus::DevDiscover::loadModules )
+    {
+        eval( 'require ' . $mod );
+        die( $@ ) if $@;
+    }
+}
+
+# Custom overlays for templates
+# overlayName ->
+#     'Module::templateName' -> { 'name' => 'templateName',
+#                                 'source' => 'filename.xml' }
+our %templateOverlays;
+
+our @requiredParams =
+    (
+     'snmp-port',
+     'snmp-version',
+     'snmp-timeout',
+     'snmp-retries',
+     'data-dir',
+     'snmp-host'
+     );
+
+our %defaultParams;
+
+$defaultParams{'rrd-hwpredict'} = 'no';
+$defaultParams{'domain-name'} = '';
+$defaultParams{'host-subtree'} = '';
+$defaultParams{'snmp-check-sysuptime'} = 'yes';
+$defaultParams{'show-recursive'} = 'yes';
+$defaultParams{'snmp-ipversion'} = '4';
+$defaultParams{'snmp-transport'} = 'udp';
+
+our @copyParams =
+    ( 'collector-period',
+      'collector-timeoffset',
+      'collector-dispersed-timeoffset',
+      'collector-timeoffset-min',
+      'collector-timeoffset-max',
+      'collector-timeoffset-step',
+      'comment',
+      'domain-name',
+      'monitor-period',
+      'monitor-timeoffset',
+      'nodeid-device',
+      'show-recursive',
+      'snmp-host',
+      'snmp-port',
+      'snmp-localaddr',
+      'snmp-localport',
+      'snmp-ipversion',
+      'snmp-transport',
+      'snmp-community',
+      'snmp-version',
+      'snmp-username',
+      'snmp-authkey',
+      'snmp-authpassword',
+      'snmp-authprotocol',
+      'snmp-privkey',
+      'snmp-privpassword',
+      'snmp-privprotocol',
+      'snmp-timeout',
+      'snmp-retries',
+      'snmp-oids-per-pdu',
+      'snmp-check-sysuptime',
+      'snmp-max-msg-size',
+      'system-id' );
+
+
+%Torrus::DevDiscover::oiddef =
+    (
+     'system'         => '1.3.6.1.2.1.1',
+     'sysDescr'       => '1.3.6.1.2.1.1.1.0',
+     'sysObjectID'    => '1.3.6.1.2.1.1.2.0',
+     'sysUpTime'      => '1.3.6.1.2.1.1.3.0',
+     'sysContact'     => '1.3.6.1.2.1.1.4.0',
+     'sysName'        => '1.3.6.1.2.1.1.5.0',
+     'sysLocation'    => '1.3.6.1.2.1.1.6.0'
+     );
+
+my @systemOIDs = ('sysDescr', 'sysObjectID', 'sysUpTime', 'sysContact',
+                  'sysName', 'sysLocation');
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    $self->{'oiddef'} = {};
+    $self->{'oidrev'} = {};
+
+    # Combine all %MODULE::oiddef hashes into one
+    foreach my $module ( 'Torrus::DevDiscover',
+                         @Torrus::DevDiscover::loadModules )
+    {
+        while( my($name, $oid) = each %{eval('\%'.$module.'::oiddef')} )
+        {
+            die( $@ ) if $@;
+            $self->{'oiddef'}->{$name} = $oid;
+            $self->{'oidrev'}->{$oid} = $name;
+        }
+    }
+
+    $self->{'datadirs'} = {};
+    $self->{'globalData'} = {};
+
+    return $self;
+}
+
+
+
+sub globalData
+{
+    my $self = shift;
+    return $self->{'globalData'};
+}
+
+
+sub discover
+{
+    my $self = shift;
+    my @paramhashes = @_;
+
+    my $devdetails = new Torrus::DevDiscover::DevDetails();
+
+    foreach my $params ( \%defaultParams, @paramhashes )
+    {
+        $devdetails->setParams( $params );
+    }
+
+    foreach my $param ( @requiredParams )
+    {
+        if( not defined( $devdetails->param( $param ) ) )
+        {
+            Error('Required parameter not defined: ' . $param);
+            return 0;
+        }
+    }
+
+    my %snmpargs;
+    my $community;
+    
+    my $version = $devdetails->param( 'snmp-version' );
+    $snmpargs{'-version'} = $version;    
+
+    foreach my $arg ( qw(-port -localaddr -localport -timeout -retries) )
+    {
+        if( defined( $devdetails->param( 'snmp' . $arg ) ) )
+        {
+            $snmpargs{$arg} = $devdetails->param( 'snmp' . $arg );
+        }
+    }
+    
+    $snmpargs{'-domain'} = $devdetails->param('snmp-transport') . '/ipv' .
+        $devdetails->param('snmp-ipversion');
+
+    if( $version eq '1' or $version eq '2c' )
+    {
+        $community = $devdetails->param( 'snmp-community' );
+        if( not defined( $community ) )
+        {
+            Error('Required parameter not defined: snmp-community');
+            return 0;
+        }
+        $snmpargs{'-community'} = $community;
+
+        # set maxMsgSize to a maximum value for better compatibility
+        
+        my $maxmsgsize = $devdetails->param('snmp-max-msg-size');
+        if( defined( $maxmsgsize ) )
+        {
+            $devdetails->setParam('snmp-max-msg-size', $maxmsgsize);
+            $snmpargs{'-maxmsgsize'} = $maxmsgsize;
+        }        
+    }
+    elsif( $version eq '3' )        
+    {
+        foreach my $arg ( qw(-username -authkey -authpassword -authprotocol
+                             -privkey -privpassword -privprotocol) )
+        {
+            if( defined $devdetails->param( 'snmp' . $arg ) )
+            {
+                $snmpargs{$arg} = $devdetails->param( 'snmp' . $arg );
+            }
+        }
+        $community = $snmpargs{'-username'};
+        if( not defined( $community ) )
+        {
+            Error('Required parameter not defined: snmp-user');
+            return 0;
+        }        
+    }
+    else
+    {
+        Error('Illegal value for snmp-version parameter: ' . $version);
+        return 0;
+    }
+
+    my $hostname = $devdetails->param('snmp-host');
+    my $domain = $devdetails->param('domain-name');
+
+    if( $domain and index($hostname, '.') < 0 and index($hostname, ':') < 0 )
+    {
+         $hostname .= '.' . $domain;
+    }
+    $snmpargs{'-hostname'} = $hostname;
+
+    my $port = $snmpargs{'-port'};
+    Debug('Discovering host: ' . $hostname . ':' . $port . ':' . $community);
+
+    my ($session, $error) =
+        Net::SNMP->session( %snmpargs,
+                            -nonblocking => 0,
+                            -translate   => ['-all', 0, '-octetstring', 1] );
+    if( not defined($session) )
+    {
+        Error('Cannot create SNMP session: ' . $error);
+        return undef;
+    }
+    
+    my @oids = ();
+    foreach my $var ( @systemOIDs )
+    {
+        push( @oids, $self->oiddef( $var ) );
+    }
+
+    # This is the only checking if the remote agent is alive
+
+    my $result = $session->get_request( -varbindlist => \@oids );
+    if( defined $result )
+    {
+        $devdetails->storeSnmpVars( $result );
+    }
+    else
+    {
+        # When the remote agent is reacheable, but system objecs are
+        # not implemented, we get a positive error_status
+        if( $session->error_status() == 0 )
+        {
+            Error("Unable to communicate with SNMP agent on " . $hostname .
+                  ':' . $port . ':' . $community . " - " . $session->error());
+            return undef;
+        }
+    }
+
+    my $data = $devdetails->data();
+    $data->{'param'} = {};
+
+    $data->{'templates'} = [];
+    my $customTmpl = $devdetails->param('custom-host-templates');
+    if( length( $customTmpl ) > 0 )
+    {
+        push( @{$data->{'templates'}}, split( /\s*,\s*/, $customTmpl ) );
+    }
+    
+    # Build host-level legend
+    my %legendValues =
+        (
+         10 => {
+             'name'  => 'Location',
+             'value' => $devdetails->snmpVar($self->oiddef('sysLocation'))
+             },
+         20 => {
+             'name'  => 'Contact',
+             'value' => $devdetails->snmpVar($self->oiddef('sysContact'))
+             },
+         30 => {
+             'name'  => 'System ID',
+             'value' => $devdetails->param('system-id')
+             },
+         50 => {
+             'name'  => 'Description',
+             'value' => $devdetails->snmpVar($self->oiddef('sysDescr'))
+             }
+         );
+
+    if( defined( $devdetails->snmpVar($self->oiddef('sysUpTime')) ) )
+    {
+        $legendValues{40}{'name'} = 'Uptime';
+        $legendValues{40}{'value'} =
+            sprintf("%d days since %s",
+                    $devdetails->snmpVar($self->oiddef('sysUpTime')) /
+                    (100*3600*24),
+                    strftime($Torrus::DevDiscover::timeFormat,
+                             localtime(time())));
+    }
+     
+    my $legend = '';
+    foreach my $key ( sort keys %legendValues )
+    {
+        my $text = $legendValues{$key}{'value'};
+        if( length( $text ) > 0 )
+        {
+            $text = $devdetails->screenSpecialChars( $text );
+            $legend .= $legendValues{$key}{'name'} . ':' . $text . ';';
+        }
+    }
+    
+    if( $devdetails->param('suppress-legend') ne 'yes' )
+    {
+        $data->{'param'}{'legend'} = $legend;
+    }
+
+    # some parameters need just one-to-one copying
+
+    my @hostCopyParams =
+        split('\s*,\s*', $devdetails->param('host-copy-params'));
+    
+    foreach my $param ( @copyParams, @hostCopyParams )
+    {
+        my $val = $devdetails->param( $param );
+        if( length( $val ) > 0 )
+        {
+            $data->{'param'}{$param} = $val;
+        }
+    }
+
+    # If snmp-host is ipv6 address, system-id needs to be adapted to
+    # remove colons
+    
+    if( not defined( $data->{'param'}{'system-id'} ) and
+        index($data->{'param'}{'snmp-host'}, ':') >= 0 )
+    {
+        my $systemid = $data->{'param'}{'snmp-host'};
+        $systemid =~ s/:/_/g;
+        $data->{'param'}{'system-id'} = $systemid;
+    }
+
+    if( not defined( $devdetails->snmpVar($self->oiddef('sysUpTime')) ) )
+    {
+        Debug('Agent does not support sysUpTime');
+        $data->{'param'}{'snmp-check-sysuptime'} = 'no';
+    }
+
+    $data->{'param'}{'data-dir'} =
+        $self->genDataDir( $devdetails->param('data-dir'), $hostname );
+
+    # Register the directory for listDataDirs()
+    $self->{'datadirs'}{$devdetails->param('data-dir')} = 1;
+
+    $self->{'session'} = $session;
+
+    # some discovery modules need to be disabled on per-device basis
+
+    my %onlyDevtypes;
+    my $useOnlyDevtypes = 0;
+    foreach my $devtype ( split('\s*,\s*',
+                                $devdetails->param('only-devtypes') ) )
+    {
+        $onlyDevtypes{$devtype} = 1;
+        $useOnlyDevtypes = 1;
+    }
+
+    my %disabledDevtypes;
+    foreach my $devtype ( split('\s*,\s*',
+                                $devdetails->param('disable-devtypes') ) )
+    {
+        $disabledDevtypes{$devtype} = 1;
+    }
+
+    # 'checkdevtype' procedures for each known device type return true
+    # when it's their device. They also research the device capabilities.
+    my $reg = \%Torrus::DevDiscover::registry;
+    foreach my $devtype
+        ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}}
+          keys %{$reg} )
+    {
+        if( ( not $useOnlyDevtypes or $onlyDevtypes{$devtype} ) and
+            not $disabledDevtypes{$devtype} and
+            &{$reg->{$devtype}{'checkdevtype'}}($self, $devdetails) )
+        {
+            $devdetails->setDevType( $devtype );
+            Debug('Found device type: ' . $devtype);
+        }
+    }
+
+    my @devtypes = sort {
+        $reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}
+    } $devdetails->getDevTypes();
+    $data->{'param'}{'devdiscover-devtypes'} = join(',', @devtypes);
+
+    $data->{'param'}{'devdiscover-nodetype'} = '::device';
+
+    # Do the detailed discovery and prepare data
+    my $ok = 1;
+    foreach my $devtype ( @devtypes )
+    {
+        $ok = &{$reg->{$devtype}{'discover'}}($self, $devdetails) ? $ok:0;
+    }
+
+    delete $self->{'session'};
+    $session->close();
+
+    $devdetails->applySelectors();
+        
+    my $subtree = $devdetails->param('host-subtree');
+    if( not defined( $self->{'devdetails'}{$subtree} ) )
+    {
+        $self->{'devdetails'}{$subtree} = [];
+    }
+    push( @{$self->{'devdetails'}{$subtree}}, $devdetails );
+
+    my $define_tokensets = $devdetails->param('define-tokensets');
+    if( defined( $define_tokensets ) and length( $define_tokensets ) > 0 )
+    {
+        foreach my $pair ( split(/\s*;\s*/, $define_tokensets ) )
+        {
+            my( $tset, $description ) = split( /\s*:\s*/, $pair );
+            if( $tset !~ /^[a-z][a-z0-9-_]*$/ )
+            {
+                Error('Invalid name for tokenset: ' . $tset);
+                $ok = 0;
+            }
+            elsif( length( $description ) == 0 )
+            {
+                Error('Missing description for tokenset: ' . $tset);
+                $ok = 0;
+            }
+            else
+            {
+                $self->{'define-tokensets'}{$tset} = $description;
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub buildConfig
+{
+    my $self = shift;
+    my $cb = shift;
+
+    my $reg = \%Torrus::DevDiscover::registry;
+        
+    foreach my $subtree ( sort keys %{$self->{'devdetails'}} )
+    {
+        # Chop the first and last slashes
+        my $path = $subtree;
+        $path =~ s/^\///;
+        $path =~ s/\/$//;
+
+        # generate subtree path XML
+        my $subtreeNode = undef;
+        foreach my $subtreeName ( split( '/', $path ) )
+        {
+            $subtreeNode = $cb->addSubtree( $subtreeNode, $subtreeName );
+        }
+
+        foreach my $devdetails
+            ( sort {$a->param('snmp-host') cmp $b->param('snmp-host')}
+              @{$self->{'devdetails'}{$subtree}} )
+        {
+
+            my $data = $devdetails->data();
+
+            my @registryOverlays = ();
+            if( defined( $devdetails->param('template-registry-overlays' ) ) )
+            {
+                my @overlayNames = 
+                    split(/\s*,\s*/,
+                          $devdetails->param('template-registry-overlays' ));
+                foreach my $overlayName ( @overlayNames )
+                {
+                    if( defined( $templateOverlays{$overlayName}) )
+                    {
+                        push( @registryOverlays,
+                              $templateOverlays{$overlayName} );
+                    }
+                    else
+                    {
+                        Error('Cannot find the template overlay named ' .
+                              $overlayName);
+                    }
+                }
+            }
+
+            # we should call this anyway, in order to flush the overlays
+            # set by previous host
+            $cb->setRegistryOverlays( @registryOverlays );            
+            
+            if( $devdetails->param('disable-snmpcollector' ) eq 'yes' )
+            {
+                push( @{$data->{'templates'}}, '::viewonly-defaults' );
+            }
+            else
+            {
+                push( @{$data->{'templates'}}, '::snmp-defaults' );
+            }
+
+            if( $devdetails->param('rrd-hwpredict' ) eq 'yes' )
+            {
+                push( @{$data->{'templates'}}, '::holt-winters-defaults' );
+            }
+
+            
+            my $devNodeName = $devdetails->param('symbolic-name');
+            if( length( $devNodeName ) == 0 )
+            {
+                $devNodeName = $devdetails->param('system-id');
+                if( length( $devNodeName ) == 0 )
+                {
+                    $devNodeName = $devdetails->param('snmp-host');
+                }
+            }                
+                
+            my $devNode = $cb->addSubtree( $subtreeNode, $devNodeName,
+                                           $data->{'param'},
+                                           $data->{'templates'} );
+
+            my $aliases = $devdetails->param('host-aliases');
+            if( length( $aliases ) > 0 )
+            {
+                foreach my $alias ( split( '\s*,\s*', $aliases ) )
+                {
+                    $cb->addAlias( $devNode, $alias );
+                }
+            }
+
+            my $includeFiles = $devdetails->param('include-files');
+            if( length( $includeFiles ) > 0 )
+            {
+                foreach my $file ( split( '\s*,\s*', $includeFiles ) )
+                {
+                    $cb->addFileInclusion( $file );
+                }
+            }
+                    
+
+            # Let the device type-specific modules add children
+            # to the subtree
+            foreach my $devtype
+                ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}}
+                  $devdetails->getDevTypes() )
+            {
+                &{$reg->{$devtype}{'buildConfig'}}
+                ( $devdetails, $cb, $devNode, $self->{'globalData'} );
+            }
+
+            $cb->{'statistics'}{'hosts'}++;
+        }
+    }
+
+    foreach my $devtype
+        ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}}
+          keys %{$reg} )
+    {
+        if( defined( $reg->{$devtype}{'buildGlobalConfig'} ) )
+        {
+            &{$reg->{$devtype}{'buildGlobalConfig'}}($cb,
+                                                     $self->{'globalData'});
+        }
+    }
+    
+    if( defined( $self->{'define-tokensets'} ) )
+    {
+        my $tsetsNode = $cb->startTokensets();
+        foreach my $tset ( sort keys %{$self->{'define-tokensets'}} )
+        {
+            $cb->addTokenset( $tsetsNode, $tset, {
+                'comment' => $self->{'define-tokensets'}{$tset} } );
+        }
+    }
+}
+
+
+
+sub session
+{
+    my $self = shift;
+    return $self->{'session'};
+}
+
+sub oiddef
+{
+    my $self = shift;
+    my $var = shift;
+
+    my $ret = $self->{'oiddef'}->{$var};
+    if( not $ret )
+    {
+        Error('Undefined OID definition: ' . $var);
+    }
+    return $ret;
+}
+
+
+sub oidref
+{
+    my $self = shift;
+    my $oid = shift;
+    return $self->{'oidref'}->{$oid};
+}
+
+
+sub genDataDir
+{
+    my $self = shift;
+    my $basedir = shift;
+    my $hostname = shift;
+
+    if( $Torrus::DevDiscover::hashDataDirEnabled )
+    {
+        return $basedir . '/' .
+            sprintf( $Torrus::DevDiscover::hashDataDirFormat,
+                     unpack('N', md5($hostname)) %
+                     $Torrus::DevDiscover::hashDataDirBucketSize );
+    }
+    else
+    {
+        return $basedir;
+    }
+}
+
+
+sub listDataDirs
+{
+    my $self = shift;
+
+    my @basedirs = keys %{$self->{'datadirs'}};
+    my @ret = @basedirs;
+
+    if( $Torrus::DevDiscover::hashDataDirEnabled )
+    {
+        foreach my $basedir ( @basedirs )
+        {
+            for( my $i = 0;
+                 $i < $Torrus::DevDiscover::hashDataDirBucketSize;
+                 $i++ )
+            {
+                push( @ret, $basedir . '/' .
+                      sprintf( $Torrus::DevDiscover::hashDataDirFormat, $i ) );
+            }
+        }
+    }
+    return @ret;
+}
+
+##
+# Check if SNMP table is present, without retrieving the whole table
+
+sub checkSnmpTable
+{
+    my $self = shift;
+    my $oidname = shift;
+
+    my $session = $self->session();
+    my $oid = $self->oiddef( $oidname );
+
+    my $result = $session->get_next_request( -varbindlist => [ $oid ] );
+    if( defined( $result ) )
+    {
+        # check if the returned oid shares the base of the query
+        my $firstOid = (keys %{$result})[0];
+        if( Net::SNMP::oid_base_match( $oid, $firstOid ) and
+            length( $result->{$firstOid} ) > 0 )
+        {
+            return 1;
+        }
+    }
+    return 0;
+}
+
+
+##
+# Check if given OID is present
+
+sub checkSnmpOID
+{
+    my $self = shift;
+    my $oidname = shift;
+
+    my $session = $self->session();
+    my $oid = $self->oiddef( $oidname );
+
+    my $result = $session->get_request( -varbindlist => [ $oid ] );
+    if( $session->error_status() == 0 and
+        defined($result) and
+        defined($result->{$oid}) and
+        length($result->{$oid}) > 0 )
+    {
+        return 1;
+    }
+    return 0;
+}
+
+
+##
+# retrieve the given OIDs by names and return hash with values
+
+sub retrieveSnmpOIDs
+{
+    my $self = shift;
+    my @oidnames = @_;
+
+    my $session = $self->session();
+    my $oids = [];
+    foreach my $oidname ( @oidnames )
+    {
+        push( @{$oids}, $self->oiddef( $oidname ) );
+    }                   
+
+    my $result = $session->get_request( -varbindlist => $oids );
+    if( $session->error_status() == 0 and defined( $result ) )
+    {
+        my $ret = {};
+        foreach my $oidname ( @oidnames )
+        {
+            $ret->{$oidname} = $result->{$self->oiddef( $oidname )};
+        }
+        return $ret;
+    }
+    return undef;
+}
+
+##
+# Simple wrapper for Net::SNMP::oid_base_match
+
+sub oidBaseMatch
+{
+    my $self = shift;
+    my $base_oid = shift;
+    my $oid = shift;
+
+    if( $base_oid =~ /^\D/ )
+    {
+        $base_oid = $self->oiddef( $base_oid );
+    }
+    return Net::SNMP::oid_base_match( $base_oid, $oid );
+}
+
+##
+# some discovery modules need to adjust max-msg-size
+
+sub setMaxMsgSize
+{
+    my $self = shift;
+    my $devdetails = shift;
+    my $msgsize = shift;
+    my $opt = shift;
+
+    $opt = {} unless defined($opt);
+
+    if( (not $opt->{'only_v1_and_v2'}) or $self->session()->version() != 3 )
+    {
+        $self->session()->max_msg_size($msgsize);
+        $devdetails->data()->{'param'}{'snmp-max-msg-size'} = $msgsize;
+    }
+}
+
+    
+
+
+###########################################################################
+####  Torrus::DevDiscover::DevDetails: the information container for a device
+####
+
+package Torrus::DevDiscover::DevDetails;
+
+use strict;
+use Torrus::RPN;
+use Torrus::Log;
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    bless $self, $class;
+
+    $self->{'params'}   = {};
+    $self->{'snmpvars'} = {}; # SNMP results stored here
+    $self->{'devtype'}  = {}; # Device types
+    $self->{'caps'}     = {}; # Device capabilities
+    $self->{'data'}     = {}; # Discovery data
+
+    return $self;
+}
+
+
+sub setParams
+{
+    my $self = shift;
+    my $params = shift;
+
+    while( my ($param, $value) = each %{$params} )
+    {
+        $self->{'params'}->{$param} = $value;
+    }
+}
+
+
+sub setParam
+{
+    my $self = shift;
+    my $param = shift;
+    my $value = shift;
+
+    $self->{'params'}->{$param} = $value;
+}
+
+
+sub param
+{
+    my $self = shift;
+    my $name = shift;
+    return $self->{'params'}->{$name};
+}
+
+
+##
+# store the query results for later use
+
+sub storeSnmpVars
+{
+    my $self = shift;
+    my $vars = shift;
+
+    while( my( $oid, $value ) = each %{$vars} )
+    {
+        if( $oid !~ /^\d[0-9.]+\d$/o )
+        {
+            Error("Invalid OID syntax: '$oid'");
+        }
+        else
+        {
+            $self->{'snmpvars'}{$oid} = $value;
+            
+            while( length( $oid ) > 0 )
+            {
+                $oid =~ s/\d+$//o;
+                $oid =~ s/\.$//o;
+                if( not exists( $self->{'snmpvars'}{$oid} ) )
+                {
+                    $self->{'snmpvars'}{$oid} = undef;
+                }
+            }
+        }
+    }
+
+    # Clean the cache of sorted OIDs
+    $self->{'sortedoids'} = undef;
+}
+
+##
+# check if the stored query results have such OID prefix
+
+sub hasOID
+{
+    my $self = shift;
+    my $oid = shift;
+
+    my $found = 0;
+    if( exists( $self->{'snmpvars'}{$oid} ) )
+    {
+        $found = 1;
+    }
+    return $found;
+}
+
+##
+# get the value of stored SNMP variable
+
+sub snmpVar
+{
+    my $self = shift;
+    my $oid = shift;
+    return $self->{'snmpvars'}{$oid};
+}
+
+##
+# get the list of table indices for the specified prefix
+
+sub getSnmpIndices
+{
+    my $self = shift;
+    my $prefix = shift;
+
+    # Remember the sorted OIDs, as sorting is quite expensive for large
+    # arrays.
+    
+    if( not defined( $self->{'sortedoids'} ) )
+    {
+        $self->{'sortedoids'} = [];
+        push( @{$self->{'sortedoids'}},
+              Net::SNMP::oid_lex_sort( keys %{$self->{'snmpvars'}} ) );
+    }
+        
+    my @ret;
+    my $prefixLen = length( $prefix ) + 1;
+    my $matched = 0;
+
+    foreach my $oid ( @{$self->{'sortedoids'}} )
+    {
+        if( defined($self->{'snmpvars'}{$oid} ) )
+        {
+            if( Net::SNMP::oid_base_match( $prefix, $oid ) )
+            {
+                # Extract the index from OID
+                my $index = substr( $oid, $prefixLen );
+                push( @ret, $index );
+                $matched = 1;
+            }
+            elsif( $matched )
+            {
+                last;
+            }
+        }
+    }
+    return @ret;
+}
+
+
+##
+# device type is the registered discovery module name
+
+sub setDevType
+{
+    my $self = shift;
+    my $type = shift;
+    $self->{'devtype'}{$type} = 1;
+}
+
+sub isDevType
+{
+    my $self = shift;
+    my $type = shift;
+    return $self->{'devtype'}{$type};
+}
+
+sub getDevTypes
+{
+    my $self = shift;
+    return keys %{$self->{'devtype'}};
+}
+
+##
+# device capabilities. Each discovery module may define its own set of
+# capabilities and use them for information exchange between checkdevtype(),
+# discover(), and buildConfig() of its own and dependant modules
+
+sub setCap
+{
+    my $self = shift;
+    my $cap = shift;
+    Debug('Device capability: ' . $cap);
+    $self->{'caps'}{$cap} = 1;
+}
+
+sub hasCap
+{
+    my $self = shift;
+    my $cap = shift;
+    return $self->{'caps'}{$cap};
+}
+
+sub clearCap
+{
+    my $self = shift;
+    my $cap = shift;
+    Debug('Clearing device capability: ' . $cap);
+    if( exists( $self->{'caps'}{$cap} ) )
+    {
+        delete $self->{'caps'}{$cap};
+    }
+}
+
+
+
+sub data
+{
+    my $self = shift;
+    return $self->{'data'};
+}
+
+
+sub screenSpecialChars
+{
+    my $self = shift;
+    my $txt = shift;
+
+    $txt =~ s/:/{COLON}/gm;
+    $txt =~ s/;/{SEMICOL}/gm;
+    $txt =~ s/%/{PERCENT}/gm;
+
+    return $txt;
+}
+
+
+sub applySelectors
+{
+    my $self = shift;
+
+    my $selList = $self->param('selectors');
+    return if not defined( $selList );
+
+    my $reg = \%Torrus::DevDiscover::selectorsRegistry;
+    
+    foreach my $sel ( split('\s*,\s*', $selList) )
+    {
+        my $type = $self->param( $sel . '-selector-type' );
+        if( not defined( $type ) )
+        {
+            Error('Parameter ' . $sel . '-selector-type must be defined ' .
+                  'for ' . $self->param('snmp-host'));
+        }
+        elsif( not exists( $reg->{$type} ) )
+        {
+            Error('Unknown selector type: ' . $type .
+                  ' for ' . $self->param('snmp-host'));
+        }
+        else
+        {
+            Debug('Initializing selector: ' . $sel);
+            
+            my $treg = $reg->{$type};
+            my @objects = &{$treg->{'getObjects'}}( $self, $type );
+
+            foreach my $object ( @objects )
+            {
+                Debug('Checking object: ' .
+                      &{$treg->{'getObjectName'}}( $self, $object, $type ));
+
+                my $expr = $self->param( $sel . '-selector-expr' );
+                $expr = '1' if length( $expr ) == 0;
+
+                my $callback = sub
+                {
+                    my $attr = shift;
+                    my $checkval = $self->param( $sel . '-' . $attr );
+                    
+                    Debug('Checking attribute: ' . $attr .
+                          ' and value: ' . $checkval);
+                    my $ret = &{$treg->{'checkAttribute'}}( $self,
+                                                            $object, $type,
+                                                            $attr, $checkval );
+                    Debug(sprintf('Returned value: %d', $ret));
+                    return $ret;                    
+                };
+                
+                my $rpn = new Torrus::RPN;
+                my $result = $rpn->run( $expr, $callback );
+                Debug('Selector result: ' . $result);
+                if( $result )
+                {
+                    my $actions = $self->param( $sel . '-selector-actions' );
+                    foreach my $action ( split('\s*,\s*', $actions) )
+                    {
+                        my $arg =
+                            $self->param( $sel . '-' . $action . '-arg' );
+                        $arg = 1 if not defined( $arg );
+                        
+                        Debug('Applying action: ' . $action .
+                              ' with argument: ' . $arg);
+                        &{$treg->{'applyAction'}}( $self, $object, $type,
+                                                   $action, $arg );
+                    }
+                }
+            }
+        }
+    }
+}    
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/ALU_Timetra.pm b/torrus/perllib/Torrus/DevDiscover/ALU_Timetra.pm
new file mode 100644
index 000000000..d1bba7502
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/ALU_Timetra.pm
@@ -0,0 +1,567 @@
+#
+#  Discovery module for Alcatel-Lucent ESS and SR routers
+#
+#  Copyright (C) 2009 Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ALU_Timetra.pm,v 1.1 2010-12-27 00:03:49 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+#
+
+# Currently tested with following Alcatel-Lucent devices:
+#  * ESS 7450
+
+
+package Torrus::DevDiscover::ALU_Timetra;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'ALU_Timetra'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+
+our %oiddef =
+    (
+     # TIMETRA-CHASSIS-MIB
+     'tmnxChassisTotalNumber'     => '1.3.6.1.4.1.6527.3.1.2.2.1.1.0',
+     
+     # TIMETRA-GLOBAL-MIB
+     'timetraReg'                 => '1.3.6.1.4.1.6527.1',
+     'timetraServiceRouters'      => '1.3.6.1.4.1.6527.1.3',
+     'timetraServiceSwitches'     => '1.3.6.1.4.1.6527.1.6',
+     'alcatel7710ServiceRouters'  => '1.3.6.1.4.1.6527.1.9',
+
+     # TIMETRA-SERV-MIB
+     'custDescription'  => '1.3.6.1.4.1.6527.3.1.2.4.1.3.1.3',
+     'svcCustId'        => '1.3.6.1.4.1.6527.3.1.2.4.2.2.1.4',
+     'svcDescription'   => '1.3.6.1.4.1.6527.3.1.2.4.2.2.1.6',
+     'sapDescription'   => '1.3.6.1.4.1.6527.3.1.2.4.3.2.1.5',
+
+     # TIMETRA-PORT-MIB (chassis ID hardcoded to 1)
+     'tmnxPortDescription' => '1.3.6.1.4.1.6527.3.1.2.2.4.2.1.5.1',
+     'tmnxPortEncapType'   => '1.3.6.1.4.1.6527.3.1.2.2.4.2.1.12.1',     
+     );
+
+
+my %essInterfaceFilter =
+    (
+     'system'  => {
+         'ifType'  => 24,                     # softwareLoopback
+         'ifName' => '^system'
+         },
+     );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $objectID = $devdetails->snmpVar( $dd->oiddef('sysObjectID') );
+    
+    if( $dd->oidBaseMatch( 'timetraReg', $objectID ) )
+    {
+        my $session = $dd->session();
+        my $oid = $dd->oiddef('tmnxChassisTotalNumber');
+        my $result = $session->get_request( $oid );
+        if( $result->{$oid} != 1 )
+        {
+            Error('Multi-chassis ALU 7x50 equipment is not yet supported');
+            return 0;
+        }
+            
+        if( $dd->oidBaseMatch( 'timetraServiceSwitches', $objectID ) )
+        {
+            $devdetails->setCap('ALU_ESS7450');
+            
+            $devdetails->setCap('interfaceIndexingManaged');
+            $devdetails->setCap('interfaceIndexingPersistent');
+            
+            &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+                ($devdetails, \%essInterfaceFilter);
+
+            $dd->setMaxMsgSize($devdetails, 65535, {'only_v1_and_v2' => 1});
+            
+            return 1;
+        }
+        else
+        {
+            # placeholder for future developments
+            Error('This model of Alcatel-Lucent equipment ' .
+                  'is not yet supported');
+            return 0;
+        }
+    }
+    
+    return 0;
+}
+
+
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # WARNING: This code is tested only with ESS7450
+
+    # Get port descriptions
+    {
+        my $oid = $dd->oiddef('tmnxPortDescription');
+        
+        my $portDescrTable = $session->get_table( -baseoid => $oid );        
+        my $prefixLen = length( $oid ) + 1;
+
+        while( my( $oid, $descr ) = each %{$portDescrTable} )
+        {
+            my $ifIndex = substr( $oid, $prefixLen );
+            if( defined( $data->{'interfaces'}{$ifIndex} ) )
+            {
+                $data->{'interfaces'}{$ifIndex}{'tmnxPortDescription'} =
+                    $descr;
+            }
+        }
+    }
+    
+    # Amend RFC2863_IF_MIB references
+    $data->{'nameref'}{'ifSubtreeName'}    = 'ifNameT';
+    $data->{'nameref'}{'ifReferenceName'}  = 'ifName';
+    $data->{'nameref'}{'ifNick'} = 'ifNameT';
+    $data->{'nameref'}{'ifComment'} = 'tmnxPortDescription';
+    
+    # Get customers
+    {
+        my $oid = $dd->oiddef('custDescription');
+        my $custDescrTable = $session->get_table( -baseoid => $oid );        
+        my $prefixLen = length( $oid ) + 1;
+        
+        while( my( $oid, $descr ) = each %{$custDescrTable} )
+        {
+            my $custId = substr( $oid, $prefixLen );
+            $data->{'timetraCustDescr'}{$custId} = $descr;
+        }
+    }
+        
+    
+    # Get Service Descriptions
+    {
+        my $oid = $dd->oiddef('svcDescription');
+        my $svcDescrTable = $session->get_table( -baseoid => $oid );        
+        my $prefixLen = length( $oid ) + 1;
+
+        while( my( $oid, $descr ) = each %{$svcDescrTable} )
+        {
+            my $svcId = substr( $oid, $prefixLen );
+            $data->{'timetraSvc'}{$svcId} = {
+                'description' => $descr,
+                'sap' => [],
+            };
+        }
+    }
+
+    # Get mapping of Services to Customers
+    {
+        my $oid = $dd->oiddef('svcCustId');
+        my $svcCustIdTable = $session->get_table( -baseoid => $oid );        
+        my $prefixLen = length( $oid ) + 1;
+        
+        while( my( $oid, $custId ) = each %{$svcCustIdTable} )
+        {
+            my $svcId = substr( $oid, $prefixLen );
+            
+            $data->{'timetraCustSvc'}{$custId}{$svcId} = 1;
+            $data->{'timetraSvcCust'}{$svcId} = $custId;
+        }
+    }
+
+    
+    # Get port encapsulations
+    {
+        my $oid = $dd->oiddef('tmnxPortEncapType');
+        
+        my $portEncapTable = $session->get_table( -baseoid => $oid );        
+        my $prefixLen = length( $oid ) + 1;
+
+        while( my( $oid, $encap ) = each %{$portEncapTable} )
+        {
+            my $ifIndex = substr( $oid, $prefixLen );
+            if( defined( $data->{'interfaces'}{$ifIndex} ) )
+            {
+                $data->{'interfaces'}{$ifIndex}{'tmnxPortEncapType'} = $encap;
+            }
+        }
+    }
+
+    
+    # Get SAP information
+    {
+        my $oid = $dd->oiddef('sapDescription');
+        
+        my $sapDescrTable = $session->get_table( -baseoid => $oid );        
+        my $prefixLen = length( $oid ) + 1;
+
+        while( my( $oid, $descr ) = each %{$sapDescrTable} )
+        {
+            my $sapFullID = substr( $oid, $prefixLen );
+
+            my ($svcId, $ifIndex, $sapEncapValue) =
+                split(/\./o, $sapFullID);
+
+            my $svcSaps = $data->{'timetraSvc'}{$svcId}{'sap'};
+            if( not defined( $svcSaps ) )
+            {
+                Error('Cannot find Service ID ' . $svcId);
+                next;
+            }
+
+            if( not defined( $data->{'interfaces'}{$ifIndex} ) )
+            {
+                Warn('IfIndex ' . $ifIndex . ' is not in interfaces table, ' .
+                     'skipping SAP');
+                next;
+            }
+            
+            my $encap = $data->{'interfaces'}{$ifIndex}{'tmnxPortEncapType'};
+
+            # Compose the SAP name depending on port encapsulation.
+            
+            my $sapName = $data->{'interfaces'}{$ifIndex}{'ifName'};
+
+            if( $encap == 1 )  # nullEncap
+            {
+                # do nothing
+            }
+            elsif( $encap == 2 )  # qEncap
+            {
+                # sapEncapValue is equal to VLAN ID
+                $sapName .= ':' . $sapEncapValue;
+            }
+            elsif( $encap == 10 )  # qinqEncap
+            {
+                # sapEncapValue contains inner and outer VLAN IDs
+                
+                my $outer = $sapEncapValue & 0xffff;
+                my $inner = $sapEncapValue >> 16;
+                if( $inner == 4095 )
+                {
+                    # default SAP
+                    $inner = '*';
+                }
+
+                $sapName .= ':' . $outer . '.' . $inner;
+            }
+            elsif( $encap == 3 ) # mplsEncap
+            {
+                # sapEncapValue contains the 20-bit LSP ID
+                # we should probably do something more here
+                $sapName .= ':' . $sapEncapValue;
+            }
+            else
+            {
+                Warn('Encapsulation type ' . $encap . ' is not supported yet');
+                $sapName .= ':' . $sapEncapValue;
+            }
+
+            $data->{'timetraSap'}{$sapFullID} =  {
+                'description' => $descr,
+                'port' => $ifIndex,
+                'name' => $sapName,
+                'encval' => $sapEncapValue,
+                'svc' => $svcId,
+            };
+
+            push( @{$svcSaps}, $sapFullID );
+        }
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+
+    if( defined( $data->{'timetraSvc'} ) )
+    {
+        my $customersNode = $cb->addSubtree( $devNode, 'Customers' );
+
+        foreach my $custId (sort {$a <=> $b} keys %{$data->{'timetraCustSvc'}})
+        {
+            # count the number of SAPs
+            my $nSaps = 0;
+            foreach my $svcId ( keys %{$data->{'timetraCustSvc'}{$custId}} )
+            {
+                my $svcSaps = $data->{'timetraSvc'}{$svcId}{'sap'};
+                if( defined( $svcSaps ) )
+                {
+                    foreach my $sapID ( @{$svcSaps} )
+                    {
+                        if( not $data->{'timetraSap'}{$sapID}{'excluded'} )
+                        {               
+                            $nSaps++;
+                        }
+                    }
+                }
+            }
+
+            if( $nSaps == 0 )
+            {
+                next;
+            }
+            
+            my $param = {
+                'precedence' => 100000 - $custId,
+                'comment'    => $data->{'timetraCustDescr'}{$custId},
+                'timetra-customer-id' => $custId,
+            };
+            
+            my $custNode =
+                $cb->addSubtree( $customersNode, $custId, $param,
+                                 ['ALU_Timetra::alu-timetra-customer']);
+            
+            my $precedence = 10000;
+            
+            foreach my $svcId
+                ( keys %{$data->{'timetraCustSvc'}{$custId}} )
+            {
+                my $svcSaps = $data->{'timetraSvc'}{$svcId}{'sap'};
+                
+                if( defined($svcSaps ) )
+                {                    
+                    foreach my $sapID
+                        ( sort {sapCompare($data->{'timetraSap'}{$a},
+                                           $data->{'timetraSap'}{$b})}
+                          @{$svcSaps} )
+                    {
+                        my $sap = $data->{'timetraSap'}{$sapID};
+
+                        if( $sap->{'excluded'} )
+                        {
+                            next;
+                        }
+                        
+                        my $sapDescr = $sap->{'description'};
+                        if( length( $sapDescr ) == 0 )
+                        {
+                            $sapDescr = $data->{'timetraSvc'}{$svcId}->{
+                                'description'};
+                        }
+
+                        my $subtreeName = $sap->{'name'};
+                        $subtreeName =~ s/\W/_/go;
+
+                        my $comment = '';
+                        if( length( $sapDescr ) > 0 )
+                        {
+                            $comment = $sapDescr;
+                        }
+
+                        my $legend = '';                        
+                        
+                        if( length($data->{'timetraCustDescr'}{$custId}) > 0 )
+                        {
+                            $legend .= 'Customer:' .
+                                $devdetails->screenSpecialChars
+                                ( $data->{'timetraCustDescr'}{$custId} ) . ';';
+                        }
+                        
+                        if( length($data->{'timetraSvc'}{$svcId}->{
+                            'description'}) > 0 )
+                        {
+                            $legend .= 'Service:' .
+                                $devdetails->screenSpecialChars
+                                ( $data->{'timetraSvc'}{$svcId}->{
+                                    'description'} ) . ';';
+                        }
+                        
+                        $legend .= 'SAP: ' .
+                            $devdetails->screenSpecialChars( $sap->{'name'} );
+                        
+                        
+                        my $param = {
+                            'comment'          => $comment,
+                            'timetra-sap-id'   => $sapID,
+                            'timetra-sap-name' => $sap->{'name'},
+                            'node-display-name' => $sap->{'name'},
+                            'precedence'       => $precedence--,
+                            'legend'           => $legend,
+                        };
+
+                        $cb->addSubtree( $custNode, $subtreeName, $param,
+                                         ['ALU_Timetra::alu-timetra-sap']);
+                    }
+                }
+            }                            
+        }
+    }    
+}
+
+
+sub sapCompare
+{
+    my $a = shift;
+    my $b = shift;
+
+    if( $a->{'port'} == $b->{'port'} )
+    {
+        return ( $a->{'encval'} <=> $b->{'encval'} );
+    }
+    else
+    {
+        return ( $a->{'port'} <=> $b->{'port'} );
+    }
+}
+      
+
+
+#######################################
+# Selectors interface
+#
+
+
+$Torrus::DevDiscover::selectorsRegistry{'ALU_SAP'} = {
+    'getObjects'      => \&getSelectorObjects,
+    'getObjectName'   => \&getSelectorObjectName,
+    'checkAttribute'  => \&checkSelectorAttribute,
+    'applyAction'     => \&applySelectorAction,
+};
+
+## Objects are full SAP indexes: svcId.sapPortId.sapEncapValue
+
+sub getSelectorObjects
+{
+    my $devdetails = shift;
+    my $objType = shift;
+
+    my $data = $devdetails->data();
+    my @ret = keys %{$data->{'timetraSap'}};
+
+    return( sort {$a<=>$b} @ret );
+}
+
+
+sub checkSelectorAttribute
+{
+    my $devdetails = shift;
+    my $object = shift;
+    my $objType = shift;
+    my $attr = shift;
+    my $checkval = shift;
+
+    my $data = $devdetails->data();
+    
+    my $value;
+    my $operator = '=~';
+    
+    my $sap = $data->{'timetraSap'}{$object};
+    
+    if( $attr eq 'sapDescr' )
+    {
+        $value = $sap->{'description'};
+    }
+    elsif( $attr eq 'custDescr' )
+    {
+        my $svcId = $sap->{'svc'};
+        my $custId = $data->{'timetraSvcCust'}{$svcId};
+        $value = $data->{'timetraCustDescr'}{$custId};
+    }
+    elsif( $attr eq 'sapName' )
+    {
+        $value = $sap->{'name'};
+        $operator = 'eq';
+    }
+    elsif( $attr eq 'sapPort' )
+    {
+        my $ifIndex = $sap->{'port'};
+        $value = $data->{'interfaces'}{$ifIndex}{'ifName'};
+        $operator = 'eq';
+    }    
+    else
+    {
+        Error('Unknown ALU_SAP selector attribute: ' . $attr);
+        $value = '';
+    }        
+        
+    
+    return eval( '$value' . ' ' . $operator . '$checkval' ) ? 1:0;
+}
+
+
+sub getSelectorObjectName
+{
+    my $devdetails = shift;
+    my $object = shift;
+    my $objType = shift;
+    
+    my $data = $devdetails->data();
+
+    return $data->{'timetraSap'}{$object}{'name'};
+}
+
+
+my %knownSelectorActions =
+    (
+     'RemoveSAP' => 1,
+     );
+
+                            
+sub applySelectorAction
+{
+    my $devdetails = shift;
+    my $object = shift;
+    my $objType = shift;
+    my $action = shift;
+    my $arg = shift;
+
+    my $data = $devdetails->data();
+    my $objref;
+    
+    if( not $knownSelectorActions{$action} )
+    {
+        Error('Unknown ALU_SAP selector action: ' . $action);
+        return;
+    }
+
+    if( $action eq 'RemoveSAP' )
+    {
+        $data->{'timetraSap'}{$object}{'excluded'} = 1;
+    }
+}   
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/ATMEL.pm b/torrus/perllib/Torrus/DevDiscover/ATMEL.pm
new file mode 100644
index 000000000..e45c7eb4e
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/ATMEL.pm
@@ -0,0 +1,167 @@
+#  Copyright (C) 2004  Scott Brooks
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# Scott Brooks <sbrooks@binary-solutions.net>
+
+# ATMEL based access points/bridges
+
+package Torrus::DevDiscover::ATMEL;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'ATMEL'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # Check to see if we can get the list of running WSS ports
+     'sysDeviceInfo'           => '1.3.6.1.4.1.410.1.1.1.5.0',
+     'bridgeOperationalMode'   => '1.3.6.1.4.1.410.1.1.4.1.0',
+     'operAccessPointName'     => '1.3.6.1.4.1.410.1.2.1.10.0',
+     'bridgeRemoteBridgeBSSID' => '1.3.6.1.4.1.410.1.1.4.2.0'
+     );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->checkSnmpOID('sysDeviceInfo') )
+    {
+        return 0;
+    }
+       
+    return 1;
+}
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+
+    my $info = $dd->retrieveSnmpOIDs('sysDeviceInfo',
+                                     'operAccessPointName',
+                                     'bridgeOperationalMode',
+                                     'bridgeRemoteBridgeBSSID',
+                                     );
+
+    my $deviceInfo = substr($info->{'sysDeviceInfo'},2);    
+    my $bridgeName = $info->{'operAccessPointName'};
+    
+    #Get rid of all the nulls returned.
+    $bridgeName =~ s/\000//g;
+    
+    $data->{'param'}{'comment'} = $bridgeName;
+
+    my $bridgeMode = $info->{'bridgeOperationalMode'};
+
+    my $remoteMac = substr($info->{'bridgeRemoteBridgeBSSID'},2);
+    
+    $remoteMac =~ s/(\w\w)/$1-/g;
+    $remoteMac = substr($remoteMac,0,-1);
+
+    my $bridge=0;
+
+    my ($version,$macaddr,$reserved,$regdomain,$producttype,$oemname,$oemid,
+        $productname,$hardwarerev) = unpack("LH12SLLA32LA32L",
+                                            pack("H*", $deviceInfo));
+    
+    $macaddr =~ s/(\w\w)/$1-/g;
+    $macaddr = substr($macaddr,0,-1);
+    
+    $data->{'param'}{'comment'} = $bridgeName;
+    
+    if ($productname =~ m/airPoint/)
+    {
+        #we have an access point
+        if ($bridgeMode == 3)
+        {
+            #we have an access point in client bridge mode.
+            $bridge=1;
+        }
+    }
+    else
+    {
+        #we have a bridge
+        $bridge=1;
+    }
+    if (!$bridge)
+    {
+        $devdetails->setCap('ATMEL::accessPoint');
+        my $legend =
+            "AP: " . $bridgeName .";" .
+            "Mac: " . $macaddr.";";
+        $data->{'param'}{'legend'} .= $legend;
+
+    }
+    else
+    {
+        my $legend =
+            "Bridge: " . $bridgeName .";" .
+            "Mac: " . $macaddr.";";
+        $data->{'param'}{'legend'} .= $legend;
+
+        $data->{'param'}{'legend'} .= "AP Mac: " . $remoteMac . ";";
+    }
+    #disable SNMP uptime check
+    $data->{'param'}{'snmp-check-sysuptime'} = 'no';
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my @templates = ('ATMEL::atmel-device-subtree');
+
+    if( $devdetails->hasCap('ATMEL::accessPoint') )
+    {
+        push (@templates, 'ATMEL::atmel-accesspoint-stats');
+    }
+    else
+    {
+        push (@templates, 'ATMEL::atmel-client-stats');
+    }
+
+    foreach my $tmpl ( @templates )
+    {
+        $cb->addTemplateApplication( $devNode, $tmpl );
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/AlliedTelesyn_PBC18.pm b/torrus/perllib/Torrus/DevDiscover/AlliedTelesyn_PBC18.pm
new file mode 100644
index 000000000..4da186276
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/AlliedTelesyn_PBC18.pm
@@ -0,0 +1,284 @@
+#  Copyright (C) 2004 Marc Haber
+#  Copyright (C) 2005 Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# $Id: AlliedTelesyn_PBC18.pm,v 1.1 2010-12-27 00:03:49 ivan Exp $
+# Marc Haber <mh+torrus-devel@zugschlus.de>
+# Redesigned by Stanislav Sinyagin
+
+# Allied Telesyn 18-Slot Media Converter Chassis
+
+package Torrus::DevDiscover::AlliedTelesyn_PBC18;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'AlliedTelesyn_PBC18'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     'ATMCCommon-MIB::mediaconverter'    => '1.3.6.1.4.1.207.1.12',
+     'ATMCCommon-MIB::mcModuleName'      => '1.3.6.1.4.1.207.8.41.1.1.1.1.1.2',
+     'ATMCCommon-MIB::mcModuleType'      => '1.3.6.1.4.1.207.8.41.1.1.1.1.1.3',
+     'ATMCCommon-MIB::mcModuleState'     => '1.3.6.1.4.1.207.8.41.1.1.1.1.1.4',
+     'ATMCCommon-MIB::mcModuleAportLinkState' =>
+     '1.3.6.1.4.1.207.8.41.1.1.1.1.1.10',
+     'ATMCCommon-MIB::mcModuleBportLinkState' =>
+     '1.3.6.1.4.1.207.8.41.1.1.1.1.1.11',
+     'ATMCCommon-MIB::mcModuleCportLinkState' =>
+     '1.3.6.1.4.1.207.8.41.1.1.1.1.1.12',
+     'ATMCCommon-MIB::mcModuleDportLinkState' =>
+     '1.3.6.1.4.1.207.8.41.1.1.1.1.1.13',
+     
+     );
+
+
+our %knownModuleTypes =
+    (
+     8 => 'AT-PB103/1 (1x100Base-TX, 1x100Base-FX Single-Mode Fibre SC, 15km)',
+     );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'ATMCCommon-MIB::mediaconverter',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+    
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+    
+    # Modules table
+
+    my $oid = $dd->oiddef('ATMCCommon-MIB::mcModuleType');
+    
+    my $table = $session->get_table( -baseoid => $oid );    
+    if( not defined( $table ) )
+    {
+        return 0;
+    }
+    
+    $devdetails->storeSnmpVars( $table );
+    
+    foreach my $INDEX ( $devdetails->getSnmpIndices($oid) )
+    {
+        my $moduleType = $devdetails->snmpVar( $oid . '.' . $INDEX );
+        if( $moduleType == 0 )
+        {
+            next;
+        }
+
+        $data->{'PBC18'}{$INDEX} = {};
+        if( defined( $knownModuleTypes{$moduleType} ) )
+        {
+            $data->{'PBC18'}{$INDEX}{'moduleDesc'} =
+                $knownModuleTypes{$moduleType};
+        }
+        else
+        {
+            Warn('Unknown PBC18 module type: ' . $moduleType);
+        }
+    }
+
+    foreach my $INDEX ( keys %{$data->{'PBC18'}} )
+    {
+        my $oids = [];
+        foreach my $oidname ( 'ATMCCommon-MIB::mcModuleName',
+                              'ATMCCommon-MIB::mcModuleState',
+                              'ATMCCommon-MIB::mcModuleAportLinkState',
+                              'ATMCCommon-MIB::mcModuleBportLinkState',
+                              'ATMCCommon-MIB::mcModuleCportLinkState',
+                              'ATMCCommon-MIB::mcModuleDportLinkState' )
+        {
+            push( @{$oids}, $dd->oiddef( $oidname ) . '.' . $INDEX );
+        }
+    
+        my $result = $session->get_request( -varbindlist => $oids );
+        if( $session->error_status() == 0 and defined( $result ) )
+        {
+            $devdetails->storeSnmpVars( $result );
+        }
+        else
+        {
+            Error('Error retrieving PBC18 module information');
+            return 0;
+        }
+    }
+
+    foreach my $INDEX ( keys %{$data->{'PBC18'}} )
+    {
+        if( $devdetails->snmpVar
+            ( $dd->oiddef('ATMCCommon-MIB::mcModuleState') .'.'.$INDEX )
+            != 1 )
+        {
+            delete $data->{'PBC18'}{$INDEX};
+            next;
+        }
+
+        my $name = $devdetails->snmpVar
+            ( $dd->oiddef('ATMCCommon-MIB::mcModuleName') .'.'.$INDEX );
+
+        if( length( $name ) > 0 )
+        {
+            $data->{'PBC18'}{$INDEX}{'moduleName'} = $name;
+        }
+
+        foreach my $portName ('A', 'B', 'C', 'D')
+        {
+            my $oid = $dd->oiddef
+                ('ATMCCommon-MIB::mcModule'.$portName.'portLinkState').
+                '.'.$INDEX;
+            
+            my $portState = $devdetails->snmpVar ( $oid );
+            if( $portState == 1 or $portState == 2 )
+            {
+                $data->{'PBC18'}{$INDEX}{'portAvailable'}{$portName} = $oid;
+            }
+        }        
+    }
+
+    return 1;
+}           
+
+
+our %portLineColors =
+    (
+     'A' => '##green',
+     'B' => '##blue',
+     'C' => '##red',
+     'D' => '##gold'
+     );
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    my $param = {
+        'data-file' => '%system-id%_pbc18_%pbc-module-index%.rrd',
+        'collector-scale' => '-1,*,2,+',
+        'graph-lower-limit' => 0,
+        'graph-upper-limit' => 1,
+        'rrd-cf' => 'MAX',
+        'rrd-create-dstype' => 'GAUGE',
+        'rrd-create-rra' =>
+            'RRA:MAX:0:1:4032 RRA:MAX:0.17:6:2016 RRA:MAX:0.042:288:732',
+
+            'has-overview-shortcuts' => 'yes',
+            'overview-shortcuts' => 'links',
+            'overview-subleave-name-links' => 'AllPorts',
+            'overview-shortcut-text-links' => 'All modules',
+            'overview-shortcut-title-links' => 'All converter modules',
+            'overview-page-title-links' => 'All converter modules',            
+        };
+
+    $cb->addParams( $devNode, $param );
+        
+    foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'PBC18'}} )
+    {
+        my $param = { 'pbc-module-index' => $INDEX };
+        
+        if( defined( $data->{'PBC18'}{$INDEX}{'moduleDesc'} ) )
+        {
+            $param->{'legend'} =
+                'Module type: ' . $data->{'PBC18'}{$INDEX}{'moduleDesc'};
+        }
+
+        if( defined( $data->{'PBC18'}{$INDEX}{'moduleName'} ) )
+        {
+            $param->{'comment'} =
+                $data->{'PBC18'}{$INDEX}{'moduleName'};
+        }
+        
+        my $modNode = $cb->addSubtree( $devNode, 'Module_' . $INDEX, $param );
+
+        my $mgParam = {
+            'ds-type'              => 'rrd-multigraph',
+            'ds-names'             => '',
+            'graph-lower-limit'    => '0',
+            'precedence'           => '1000',
+            'comment'              => 'Ports status',                
+            'vertical-label'       => 'Status',                
+        };
+        
+        my $n = 1;
+        foreach my $portName
+            ( sort keys %{$data->{'PBC18'}{$INDEX}{'portAvailable'}} )
+        {
+            if( $n > 1 )
+            {
+                $mgParam->{'ds-names'} .= ',';
+            }
+
+            my $dsname = 'port' . $portName;
+            $mgParam->{'ds-names'} .= $dsname;
+
+            $mgParam->{'graph-legend-' . $dsname} = 'Port ' . $portName;
+            $mgParam->{'line-style-' . $dsname} = 'LINE2';
+            $mgParam->{'line-color-' . $dsname} = $portLineColors{$portName};
+            $mgParam->{'line-order-' . $dsname} = $n;
+            $mgParam->{'ds-expr-' . $dsname} = '{Port_' . $portName . '}';
+            
+            my $param = {
+                'rrd-ds' => 'Port' . $portName,
+                'snmp-object' =>
+                    $data->{'PBC18'}{$INDEX}{'portAvailable'}{$portName},
+                };
+
+            $cb->addLeaf( $modNode, 'Port_' . $portName, $param );
+            $n++;
+        }
+
+        $cb->addLeaf( $modNode, 'AllPorts', $mgParam );        
+    }
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/Alteon.pm b/torrus/perllib/Torrus/DevDiscover/Alteon.pm
new file mode 100644
index 000000000..d8ea6edc7
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Alteon.pm
@@ -0,0 +1,169 @@
+#
+#  Discovery module for Alteon devices
+#
+#  Copyright (C) 2007 Jon Nistor
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Alteon.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+# Jon Nistor <nistor at snickers dot org>
+#
+
+
+package Torrus::DevDiscover::Alteon;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'Alteon'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+# pmodule-dependend OIDs are presented for module #1 only.
+# currently devices with more than one module do not exist
+
+our %oiddef =
+    (
+     # ALTEON-PRIVATE-MIBS
+     'alteonOID'                 => '1.3.6.1.4.1.1872.1',
+     'hwPartNumber'              => '1.3.6.1.4.1.1872.2.1.1.1.0',
+     'hwRevision'                => '1.3.6.1.4.1.1872.2.1.1.2.0',
+     'agSoftwareVersion'         => '1.3.6.1.4.1.1872.2.1.2.1.7.0',
+     'agEnabledSwFeatures'       => '1.3.6.1.4.1.1872.2.1.2.1.25.0',
+     'slbCurCfgRealServerName'   => '1.3.6.1.4.1.1872.2.1.5.2.1.12',
+     'slbNewCfgRealServerName'   => '1.3.6.1.4.1.1872.2.1.5.3.1.13',
+     'slbCurCfgGroupName'        => '1.3.6.1.4.1.1872.2.1.5.10.1.7',
+     'slbNewCfgGroupName'        => '1.3.6.1.4.1.1872.2.1.5.11.1.10',
+     'slbStatPortMaintPortIndex' => '1.3.6.1.4.1.1872.2.1.8.2.1.1.1',
+     'slbStatVServerIndex'       => '1.3.6.1.4.1.1872.2.1.8.2.7.1.3',
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'alteonOID',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+    
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # Get the system info and display it in the comment
+    my $alteonInfo = $dd->retrieveSnmpOIDs
+        ( 'hwPartNumber', 'hwRevision', 'agSoftwareVersion',
+          'agEnabledSwFeatures', 'sysDescr' );
+
+    $data->{'param'}{'comment'} =
+        $alteonInfo->{'sysDescr'} . ", Hw Serial#: " .
+        $alteonInfo->{'hwPartNumber'} . ", Hw Revision: " .
+        $alteonInfo->{'hwRevision'} .  ", " .
+        $alteonInfo->{'agEnabledSwFeatures'} . ", Version: " .
+        $alteonInfo->{'agSoftwareVersion'};
+
+    # PROG: Discover slbStatVServerIndex (Virtual Server index)
+    my $virtTable = $session->get_table ( -baseoid =>
+                                          $dd->oiddef('slbStatVServerIndex') );
+    $devdetails->storeSnmpVars( $virtTable ); 
+    foreach my $virtIndex
+        ( $devdetails->getSnmpIndices( $dd->oiddef('slbStatVServerIndex') ) )
+    {
+        Debug("Alteon::vserver  Found index $virtIndex");
+        $data->{'VSERVER'}{$virtIndex} = 1;
+    }
+
+    # PROG: SLB Port Maintenance Statistics Table
+    my $maintTable =
+        $session->get_table ( -baseoid =>
+                              $dd->oiddef('slbStatPortMaintPortIndex') );
+    $devdetails->storeSnmpVars( $maintTable );
+    
+    foreach my $mIndex
+        ( $devdetails->getSnmpIndices
+          ( $dd->oiddef('slbStatPortMaintPortIndex') ) )
+    {
+        Debug("Alteon::maintTable  Index: $mIndex");
+        $data->{'MAINT'}{$mIndex} = 1;
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    $cb->addTemplateApplication($devNode, 'Alteon::alteon-cpu');
+    $cb->addTemplateApplication($devNode, 'Alteon::alteon-mem');
+    $cb->addTemplateApplication($devNode, 'Alteon::alteon-packets');
+    $cb->addTemplateApplication($devNode, 'Alteon::alteon-sensor');
+
+    # PROG: Virtual Server information
+    my $virtNode =
+        $cb->addSubtree( $devNode, 'VirtualServer_Stats',
+                         { 'comment' => 'Stats per Virtual Server' },
+                         [ 'Alteon::alteon-vserver-subtree'] );
+
+    foreach my $virtIndex ( sort {$a <=> $b } keys %{$data->{'VSERVER'}} )
+    {
+        $cb->addSubtree( $virtNode, 'VirtualHost_' . $virtIndex,
+                         { 'alteon-vserver-index' => $virtIndex },
+                         [ 'Alteon::alteon-vserver'] ); 
+    } 
+
+    # PROG: SLB Port Maintenance Statistics Table
+    my $maintNode =
+        $cb->addSubtree( $devNode, 'Port_Maintenance_Stats',
+                         { 'comment' => 'SLB port maintenance statistics' },
+                         [ 'Alteon::alteon-maint-subtree'] );
+    
+    foreach my $mIndex ( sort {$a <=> $b } keys %{$data->{'MAINT'}} )
+    {
+        $cb->addSubtree( $maintNode, 'Port_' . $mIndex,
+                         { 'alteon-maint-index' => $mIndex },
+                         [ 'Alteon::alteon-maint'] ); 
+    }
+
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/Apple_AE.pm b/torrus/perllib/Torrus/DevDiscover/Apple_AE.pm
new file mode 100644
index 000000000..ab5fe087d
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Apple_AE.pm
@@ -0,0 +1,180 @@
+#
+#  Copyright (C) 2007  Jon Nistor
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Apple_AE.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+# Jon Nistor <nistor at snickers.org>
+
+# Apple Airport Extreme Discovery Module
+#
+# NOTE: Options for this module:
+#       Apple_AE::disable-clients
+
+package Torrus::DevDiscover::Apple_AE;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'Apple_AE'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+};
+
+
+our %oiddef =
+    (
+     # Apple Airport Extreme
+     'airportObject'        => '1.3.6.1.4.1.63.501',
+     'baseStation3'         => '1.3.6.1.4.1.63.501.3',
+
+     # Airport Information
+     'sysConfName'            => '1.3.6.1.4.1.63.501.3.1.1.0',
+     'sysConfContact'         => '1.3.6.1.4.1.63.501.3.1.2.0',
+     'sysConfLocation'        => '1.3.6.1.4.1.63.501.3.1.3.0',
+     'sysConfFirmwareVersion' => '1.3.6.1.4.1.63.501.3.1.5.0',
+
+     'wirelessNumber'         => '1.3.6.1.4.1.63.501.3.2.1.0',
+     'wirelessPhysAddress'    => '1.3.6.1.4.1.63.501.3.2.2.1.1'
+    );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    # PROG: Standard sysObject does not work on Airport devices
+    #       So we will match on the specific OID
+    if( not $dd->checkSnmpOID('sysConfName') )
+    {
+        return 0;
+    }
+
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # NOTE: Comments and Serial number of device
+    my $chassisInfo =
+        $dd->retrieveSnmpOIDs( 'sysConfName', 'sysConfLocation',
+                               'sysConfFirmwareVersion' );
+
+    if( defined( $chassisInfo ) )
+    {
+        if( not $chassisInfo->{'sysConfLocation'} )
+        {
+            $chassisInfo->{'sysConfLocation'} = "unknown";
+        }
+
+        $data->{'param'}{'comment'} = "Apple Airport Extreme, " .
+            "Fw#: " . $chassisInfo->{'sysConfFirmwareVersion'} . ", " .
+            $chassisInfo->{'sysConfName'} . " located at " .
+            $chassisInfo->{'sysConfLocation'};
+    } else {
+        $data->{'param'}{'comment'} = "Apple Airport Extreme";
+    }
+
+
+    # PROG: Find wireless clients
+    if( $devdetails->param('Apple_AE::disable-clients') ne 'yes' )
+    {
+        my $numWireless = $dd->retrieveSnmpOIDs('wirelessNumber');
+
+        my $tableClients =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('wirelessPhysAddress') );
+        $devdetails->storeSnmpVars( $tableClients );
+
+        if( $tableClients && ($numWireless->{'wirelessNumber'} > 0) )
+        {
+            # PROG: setCap that we actually have clients ...
+            $devdetails->setCap('AE_clients');
+
+            foreach my $wClient ( $devdetails->getSnmpIndices
+                                  ($dd->oiddef('wirelessPhysAddress')) )
+            {
+                my $wMAC = $devdetails->snmpVar(
+                    $dd->oiddef('wirelessPhysAddress') . "." . $wClient);
+
+                # Construct data
+                $data->{'Apple_AE'}{'wClients'}{$wClient} = undef;
+                $data->{'Apple_AE'}{'wClients'}{$wClient}{'wMAC'} = $wMAC;
+
+                Debug("Apple_AE::  Client $wMAC / $wClient");
+            }
+        } 
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+
+    # Wireless Client information
+    if( $devdetails->hasCap('AE_clients') )
+    {
+        my $nodeTop =
+            $cb->addSubtree( $devNode, 'Wireless_Clients', undef,
+                             [ 'Apple_AE::ae-wireless-clients-subtree'] );
+
+        foreach my $wClient ( keys %{$data->{'Apple_AE'}{'wClients'}} )
+        {
+            my $airport = $data->{'Apple_AE'}{'wClients'}{$wClient};
+            my $wMAC    = $airport->{'wMAC'};
+            my $wMACfix = $wMAC;
+            $wMACfix =~ s/:/_/g;
+
+            my $nodeWireless =
+                $cb->addSubtree( $nodeTop, $wMACfix,
+                                 { 'wireless-mac'    => $wMAC,
+                                   'wireless-macFix' => $wMACfix,
+                                   'wireless-macOid' => $wClient },
+                                 [ 'Apple_AE::ae-wireless-clients-leaf' ] );
+        }
+    }
+
+    # PROG: Adding global statistics
+    $cb->addTemplateApplication( $devNode, 'Apple_AE::ae-global-stats');
+}
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/Arbor_E.pm b/torrus/perllib/Torrus/DevDiscover/Arbor_E.pm
new file mode 100644
index 000000000..076d79867
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Arbor_E.pm
@@ -0,0 +1,1150 @@
+#
+#  Discovery module for Arbor|e Series devices
+#  Formerly Ellacoya Networks
+#
+#  Copyright (C) 2008 Jon Nistor
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+# $Id: Arbor_E.pm,v 1.1 2010-12-27 00:03:52 ivan Exp $
+# Jon Nistor <nistor at snickers.org>
+#
+# NOTE: This module has been tested against v7.5.x, v7.6.x, v9.0.x, v9.1.x
+#
+# -- Common
+#      Arbor_E::disable-bundle-offer
+#      Arbor_E::disable-bundle-offer-deny
+#      Arbor_E::disable-bundle-offer-pktsize
+#      Arbor_E::disable-bundle-offer-rate
+#      Arbor_E::disable-bundle-offer-subcount
+#      Arbor_E::enable-bundle-name-rrd
+#      Arbor_E::disable-flowdev
+#
+# -- e30 specific
+#      Arbor_E::disable-e30-buffers
+#      Arbor_E::disable-e30-bundle
+#      Arbor_E::disable-e30-cpu
+#      Arbor_E::disable-e30-fwdTable
+#      Arbor_E::disable-e30-fwdTable-login
+#      Arbor_E::disable-e30-hdd
+#      Arbor_E::enable-e30-hdd-errors
+#      Arbor_E::disable-e30-hdd-logs
+#      Arbor_E::disable-e30-l2tp
+#      Arbor_E::disable-e30-mem
+#      Arbor_E::enable-e30-mempool
+#      Arbor_E::disable-e30-bundle
+#      Arbor_E::disable-e30-bundle-deny
+#      Arbor_E::disable-e30-bundle-rate
+#      Arbor_E::disable-e30-slowpath 
+#
+# -- e100 specific
+#      Arbor_E::disable-e100-cpu
+#      Arbor_E::disable-e100-hdd
+#      Arbor_E::disable-e100-mem
+#      Arbor_E::disable-e100-policymgmt
+#      Arbor_E::disable-e100-submgmt
+#
+
+# Arbor_E devices discovery
+package Torrus::DevDiscover::Arbor_E;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'Arbor_E'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef =
+    (
+     # ELLACOYA-MIB
+     'eProducts'	     => '1.3.6.1.4.1.3813.2',
+     'codeVer'               => '1.3.6.1.4.1.3813.1.4.1.1.0',
+     'sysIdSerialNum'	     => '1.3.6.1.4.1.3813.1.4.1.5.2.0',
+     'memPoolNameIndex'      => '1.3.6.1.4.1.3813.1.4.2.5.1.1',
+     'hDriveErrModel'        => '1.3.6.1.4.1.3813.1.4.2.10.16.0',
+     'hDriveErrSerialNum'    => '1.3.6.1.4.1.3813.1.4.2.10.17.0',
+     'partitionName'         => '1.3.6.1.4.1.3813.1.4.2.11.1.2', # e100
+     'cpuSdramIndex'         => '1.3.6.1.4.1.3813.1.4.2.12.1.1', # e100
+     'hDriveDailyLogSize'    => '1.3.6.1.4.1.3813.1.4.2.13.0',
+     'cpuUtilization'	     => '1.3.6.1.4.1.3813.1.4.4.1.0',
+     'cpuUtilTable'          => '1.3.6.1.4.1.3813.1.4.4.2',      # e100
+     'cpuIndex'		     => '1.3.6.1.4.1.3813.1.4.4.2.1.1',  # e100
+     'cpuName'               => '1.3.6.1.4.1.3813.1.4.4.2.1.2',  # e100
+     'loginRespOkStatsIndex' => '1.3.6.1.4.1.3813.1.4.3.15.1.1',
+
+     # ELLACOYA-MIB::cpuCounters, e30 (available in 7.5.x -- slowpath counters)
+     'cpuCounters'           => '1.3.6.1.4.1.3813.1.4.4.10',
+     'slowpathCounters'      => '1.3.6.1.4.1.3813.1.4.4.10.1',
+     'sigCounters'           => '1.3.6.1.4.1.3813.1.4.4.10.2',
+
+     # ELLACOYA-MIB::flow
+     'flowPoolNameD1'        => '1.3.6.1.4.1.3813.1.4.5.1.1.1.2',
+     'flowPoolNameD2'        => '1.3.6.1.4.1.3813.1.4.5.2.1.1.2',
+
+     # ELLACOYA-MIB::bundleStatsTable
+     'bundleName'                    => '1.3.6.1.4.1.3813.1.4.12.1.1.2',
+     'bundleBytesSentDenyPolicyDrop' => '1.3.6.1.4.1.3813.1.4.12.1.1.6',
+     'bundleBytesSentRateLimitDrop'  => '1.3.6.1.4.1.3813.1.4.12.1.1.8',
+     'boBundleID'                    => '1.3.6.1.4.1.3813.1.4.12.2.1.1',
+     'boBundleName'                  => '1.3.6.1.4.1.3813.1.4.12.2.1.3',
+     'boOfferName'                   => '1.3.6.1.4.1.3813.1.4.12.2.1.4',
+     'boBundleSubCount'              => '1.3.6.1.4.1.3813.1.4.12.2.1.7',
+     'boPacketsSent64'               => '1.3.6.1.4.1.3813.1.4.12.2.1.8',
+     'boBundleBytesSentDenyPolicyDrop' => '1.3.6.1.4.1.3813.1.4.12.2.1.22',
+     'boBundleBytesSentRateLimitDrop'  => '1.3.6.1.4.1.3813.1.4.12.2.1.24',
+
+     # ELLACOYA-MIB::policyMgmt, e100
+     'policyMgmt'                    => '1.3.6.1.4.1.3813.1.4.16',
+
+     # ELLACOYA-MIB::subscriberMgmt, e100
+     'subscriberMgmt'                => '1.3.6.1.4.1.3813.1.4.17',
+     'subscriberStateName'           => '1.3.6.1.4.1.3813.1.4.17.7.1.2',
+
+     # ELLACOYA-MIB::l2tp, e30 (available in 7.5.x)
+     'l2tpConfigEnabled'             => '1.3.6.1.4.1.3813.1.4.18.1.1.0',
+     'l2tpSecureEndpointIpAddress'   => '1.3.6.1.4.1.3813.1.4.18.3.2.1.1.1',
+     'l2tpSecureEndpointOverlapping' => '1.3.6.1.4.1.3813.1.4.18.3.2.1.1.3',
+
+     );
+
+our %eChassisName =
+    (
+        '1'  => 'e16k',
+        '2'  => 'e4k',
+        '3'  => 'e30 Revision: R',
+        '4'  => 'e30 Revision: S',
+        '5'  => 'e30 Revision: T',
+        '6'  => 'e30 Revision: U',
+        '7'  => 'e30 Revision: V',
+	'8'  => 'Ellacoya e100',
+        '9'  => 'e100'
+    );
+
+our %eCpuName =
+    (
+        '1'  => 'Control Module',
+        '3'  => 'DPI Module 1 CPU 1',
+        '4'  => 'DPI Module 1 CPU 2',
+        '5'  => 'DPI Module 2 CPU 1',
+        '6'  => 'DPI Module 2 CPU 2',
+        '7'  => 'I/O Module'
+    );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'eProducts', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+   
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # PROG: Grab versions, serials and type of chassis.
+    my $eInfo = $dd->retrieveSnmpOIDs
+                   ( 'codeVer', 'sysIdSerialNum', 'sysObjectID' );
+    $eInfo->{'modelNum'} = $eInfo->{'sysObjectID'};
+    $eInfo->{'modelNum'} =~ s/.*(\d)$/$1/; # Last digit
+
+    # SNMP: System comment
+    $data->{'param'}{'comment'} =
+            "Arbor " . $eChassisName{$eInfo->{'modelNum'}} .
+            ", Hw Serial#: " . $eInfo->{'sysIdSerialNum'} .
+            ", Version: " .  $eInfo->{'codeVer'};
+
+    # ------------------------------------------------------------------------
+    # Arbor_E e30 related material here
+    if( $eInfo->{'modelNum'} < 8 )
+    {
+        Debug("Arbor_E: Found " . $eChassisName{$eInfo->{'modelNum'}} );
+
+        # PROG: Set Capability to be the e30 device
+        $devdetails->setCap('e30');
+
+        # PROG: Check status oids
+        if( $devdetails->param('Arbor_E::disable-e30-buffers') ne 'yes' )
+	{
+            $devdetails->setCap('e30-buffers');
+        }
+
+        if( $devdetails->param('Arbor_E::disable-e30-cpu') ne 'yes' )
+        {
+            $devdetails->setCap('e30-cpu');
+        }
+
+        if( $devdetails->param('Arbor_E::disable-e30-fwdTable') ne 'yes' )
+        {
+            $devdetails->setCap('e30-fwdTable');
+
+            if( $devdetails->param('Arbor_E::disable-e30-fwdTable-login')
+                ne 'yes' )
+            {
+                my $loginTable = $session->get_table(
+                       -baseoid => $dd->oiddef('loginRespOkStatsIndex') );
+                $devdetails->storeSnmpVars( $loginTable );
+
+                if( defined( $loginTable ) )
+                {
+                    $devdetails->setCap('e30-fwdTable-login');
+
+                    foreach my $statsIdx ( $devdetails->getSnmpIndices(
+                                      $dd->oiddef('loginRespOkStatsIndex') ) )
+                    {
+                        push(@{$data->{'e30'}{'loginResp'}}, $statsIdx);
+                    }
+                }
+            } # END hasCap disable-e30-fwdTable-login
+        }
+
+        if( $devdetails->param('Arbor_E::disable-e30-hdd') ne 'yes' )
+        {
+            $devdetails->setCap('e30-hdd');
+
+            # SNMP: Add harddrive comment information
+            $eInfo = $dd->retrieveSnmpOIDs( 'hDriveErrModel',
+                                            'hDriveErrSerialNum' );
+
+            $data->{'e30'}{'hddModel'}  = $eInfo->{'hDriveErrModel'};
+            $data->{'e30'}{'hddSerial'} = $eInfo->{'hDriveErrSerialNum'};
+
+            # PROG: Do we want errors as well?
+            if( $devdetails->param('Arbor_E::enable-e30-hdd-errors') eq 'yes' )
+            {
+                $devdetails->setCap('e30-hdd-errors');
+            }
+
+            # PROG: Do we want to look at daily log files? (New in 7.6)
+            if( $devdetails->param('Arbor_E::disable-e30-hdd-logs') ne 'yes' )
+            {
+                $eInfo = $dd->retrieveSnmpOIDs( 'hDriveDailyLogSize' );
+
+                if( $eInfo->{'hDriveDailyLogSize'} )
+                {
+                    $devdetails->setCap('e30-hdd-logs');
+                }
+            }
+        } # END: if disable-e30-hdd
+
+        if( $devdetails->param('Arbor_E::disable-e30-l2tp') ne 'yes' )
+        {
+            # 1 - disabled, 2 - enabled, 3 - session aware
+            $eInfo = $dd->retrieveSnmpOIDs('l2tpConfigEnabled');
+
+            if( $eInfo->{'l2tpConfigEnabled'} > 1 )
+            {
+                $devdetails->setCap('e30-l2tp');
+
+                my $l2tpSecEndTable = $session->get_table(
+                       -baseoid => $dd->oiddef('l2tpSecureEndpointIpAddress') );
+		$devdetails->storeSnmpVars( $l2tpSecEndTable );
+
+                Debug("e30: L2TP secure endpoints found:");
+                foreach my $SEP ( $devdetails->getSnmpIndices(
+                                  $dd->oiddef('l2tpSecureEndpointIpAddress') ) )
+		{
+			next if( ! $SEP );
+			$data->{'e30'}{'l2tpSEP'}{$SEP} = 0;
+                        Debug("e30:    $SEP");
+		}
+            } # END: if l2tpConfigEnabled
+        }
+
+        # Memory usage on system
+        if( $devdetails->param('Arbor_E::disable-e30-mem') ne 'yes' )
+        {
+            $devdetails->setCap('e30-mem');
+        }
+
+        # Memory usage / individual blocks
+        if( $devdetails->param('Arbor_E::enable-e30-mempool') eq 'yes' )
+        {
+            my $mempoolTable = $session->get_table(
+                                 -baseoid => $dd->oiddef('memPoolNameIndex') );
+            $devdetails->storeSnmpVars( $mempoolTable );
+
+            if( defined( $mempoolTable ) )
+            {
+                $devdetails->setCap('e30-mempool');
+
+                foreach my $memOID (
+                           $devdetails->getSnmpIndices(
+                                $dd->oiddef('memPoolNameIndex') ) )
+                {
+                    my $memName = $mempoolTable->{
+                               $dd->oiddef('memPoolNameIndex') . '.' . $memOID};
+
+                    Debug("e30:  Mempool: $memName");
+                    $data->{'e30'}{'mempool'}{$memOID} = $memName;
+                }
+            }
+        }
+
+        # Traffic statistics per Bundle
+        if( $devdetails->param('Arbor_E::disable-e30-bundle') ne 'yes' )
+        {
+            # Set capability 
+            $devdetails->setCap('e30-bundle');
+
+            # Pull table information
+            my $bundleTable = $session->get_table(
+                                -baseoid => $dd->oiddef('bundleName') );
+            $devdetails->storeSnmpVars( $bundleTable );
+
+            Debug("e30: Bundle Information id:name");
+            foreach my $bundleID (
+                       $devdetails->getSnmpIndices( $dd->oiddef('bundleName') ))
+            {
+                    my $bundleName = $bundleTable->{$dd->oiddef('bundleName') .
+                                        '.' . $bundleID};
+                    $data->{'e30'}{'bundleID'}{$bundleID} = $bundleName;
+	
+                    Debug("e30:    $bundleID $bundleName");
+            } # END foreache my $bundleID
+
+            if( $devdetails->param('Arbor_E::disable-e30-bundle-deny') ne 'yes')
+            {
+                my $bundleDenyTable = $session->get_table(
+                     -baseoid => $dd->oiddef('bundleBytesSentDenyPolicyDrop') );
+                $devdetails->storeSnmpVars( $bundleDenyTable );
+
+                if( $bundleDenyTable )
+                {
+                    $devdetails->setCap('e30-bundle-denyStats');
+                }
+            }
+
+            if( $devdetails->param('Arbor_E::disable-e30-bundle-rate') ne 'yes')
+            {
+                my $bundleRateLimitTable = $session->get_table(
+                     -baseoid => $dd->oiddef('bundleBytesSentRateLimitDrop') );
+                $devdetails->storeSnmpVars( $bundleRateLimitTable );
+
+                if( $bundleRateLimitTable )
+                {
+                    $devdetails->setCap('e30-bundle-rateLimitStats');
+                }
+            }
+
+        } # END if Arbor_E::disable-e30-bundle
+
+        # PROG: Counters
+        if( $devdetails->param('Arbor_E::disable-e30-slowpath') ne 'yes' )
+        {
+            # Slowpath counters are available as of 7.5.x
+            my $counters = $session->get_table(
+                            -baseoid => $dd->oiddef('slowpathCounters') );
+            $devdetails->storeSnmpVars( $counters );
+
+            if( defined( $counters ) )
+            {
+                $devdetails->setCap('e30-slowpath');
+            }
+        }
+    }
+
+
+    # ------------------------------------------------------------------------
+    #
+    # Arbor E100 related material here
+
+    if( $eInfo->{'modelNum'} >= 8 )
+    {
+        Debug("Arbor_E: Found " . $eChassisName{$eInfo->{'modelNum'}} );
+
+        # PROG: Set Capability to be the e100 device
+        $devdetails->setCap('e100');
+
+        # CPU parameters ...
+        if( $devdetails->param('Arbor_E::disable-e100-cpu') ne 'yes' )
+        {
+          my $cpuNameTable = $session->get_table(
+                            -baseoid => $dd->oiddef('cpuName') );
+          $devdetails->storeSnmpVars( $cpuNameTable );
+
+          if( defined( $cpuNameTable ) )
+          {
+            $devdetails->setCap('e100-cpu');
+
+            # PROG: Find all the CPU's ..
+            foreach my $cpuIndex ( $devdetails->getSnmpIndices(
+                                   $dd->oiddef('cpuName') ) )
+            {
+              my $cpuName = $cpuNameTable->{$dd->oiddef('cpuName') .
+                                                   '.' . $cpuIndex};
+
+              Debug("  CPU found: $cpuIndex, $cpuName");
+              $data->{'e100'}{'cpu'}{$cpuIndex} = $cpuName;
+            }
+          }
+        }
+
+        # HDD Parameters
+        if( $devdetails->param('Arbor_E::disable-e100-hdd') ne 'yes' )
+        {
+          my $hddTable = $session->get_table(
+                           -baseoid => $dd->oiddef('partitionName') );
+          $devdetails->storeSnmpVars( $hddTable );
+
+          if( defined( $hddTable ) )
+          {
+            $devdetails->setCap('e100-hdd');
+
+            # PROG: Find all the paritions and names ..
+            foreach my $hddIndex ( $devdetails->getSnmpIndices(
+                                   $dd->oiddef('partitionName') ) )
+            {
+              my $partitionName = $hddTable->{$dd->oiddef('partitionName') .
+                                              '.' . $hddIndex};
+              Debug("HDD Partition: $hddIndex, $partitionName");
+              $data->{'e100'}{'hdd'}{$hddIndex} = $partitionName;
+            }
+          }
+        }
+
+        # MEM Parameters
+        if( $devdetails->param('Arbor_E::disable-e100-mem') ne 'yes' )
+        {
+          my $cpuSdramTable = $session->get_table(
+                             -baseoid => $dd->oiddef('cpuSdramIndex') );
+          $devdetails->storeSnmpVars( $cpuSdramTable );
+
+          if( defined( $cpuSdramTable ) )
+          {
+            $devdetails->setCap('e100-mem');
+
+            # PROG: Find all memory indexes
+            foreach my $memIndex ( $devdetails->getSnmpIndices(
+                                   $dd->oiddef('cpuSdramIndex') ) )
+            {
+              my $memName = $data->{'e100'}{'cpu'}{$memIndex};
+              Debug("MEM found: $memIndex, $memName");
+              $data->{'e100'}{'mem'}{$memIndex} = $memName;
+            }
+          }
+        }
+
+        # Policy Mgmt parameters
+        if( $devdetails->param('Arbor_E::disable-e100-policymgmt') ne 'yes' )
+        {
+          my $policyTable = $session->get_table(
+                              -baseoid => $dd->oiddef('policyMgmt')
+                            );
+          $devdetails->storeSnmpVars( $policyTable );
+
+          if( defined( $policyTable ) )
+          {
+            $devdetails->setCap('e100-policymgmt');
+          }
+        }
+
+        # Subscriber Mgmt parameters
+        if( $devdetails->param('Arbor_E::disable-e100-submgmt') ne 'yes' )
+        {
+          my $subTable = $session->get_table(
+                            -baseoid => $dd->oiddef('subscriberStateName')
+                         );
+          $devdetails->storeSnmpVars( $subTable );
+
+          if( defined( $subTable ) )
+          {
+            $devdetails->setCap('e100-submgmt');
+
+            # Sub: Find state name entries
+            foreach my $stateIDX ( $devdetails->getSnmpIndices( $dd->oiddef(
+					'subscriberStateName') ) )
+            {
+               my $state = $subTable->{
+                              $dd->oiddef('subscriberStateName') .
+                              '.' .  $stateIDX
+                           };
+               
+               Debug("  State index: $stateIDX, name: $state");
+               $data->{'e100'}{'submgmt'}{$stateIDX} = $state;
+            }
+          }
+        }
+    }
+
+
+    # ------------------------------------------------------------------------
+    #
+    # Common information between e30 and e100
+
+    if( $devdetails->param('Arbor_E::disable-flowdev') ne 'yes' )
+    {
+        $devdetails->setCap('arbor-flowLookup');
+
+        # Flow Lookup Device information
+        # Figure out what pools exist for the 2 flow switching modules
+        # ------------------------------------------------------------
+        my $switchingModules = 2;
+
+        foreach my $flowModule (1 .. $switchingModules) {
+            Debug("common:  Flow Lookup Device " . $flowModule);
+
+            my $flowPoolOid  = 'flowPoolNameD' . $flowModule;
+            my $flowModTable = $session->get_table (
+                              -baseoid => $dd->oiddef($flowPoolOid) );
+            $devdetails->storeSnmpVars ( $flowModTable );
+
+            # PROG: Look for pool names and indexes and store them.
+            if( $flowModTable ) {
+                foreach my $flowPoolIDX ( $devdetails->getSnmpIndices(
+                                            $dd->oiddef($flowPoolOid) ) )
+                {
+                    my $flowPoolName = $flowModTable->{
+                           $dd->oiddef($flowPoolOid) . '.' . $flowPoolIDX};
+
+                    $data->{'arbor_e'}{'flowModule'}{$flowModule}{$flowPoolIDX}
+                          = $flowPoolName;
+
+                    Debug("common:    IDX: $flowPoolIDX  Pool: $flowPoolName");
+
+                } # END: foreach my $flowPoolIDX
+            } # END: if $flowModTable
+        } # END: foreach my $flowModule
+    }
+
+
+    if( $devdetails->param('Arbor_E::disable-bundle-offer') ne 'yes' )
+    {
+        my $boOfferNameTable = $session->get_table(
+                            -baseoid => $dd->oiddef('boOfferName') );
+        $devdetails->storeSnmpVars( $boOfferNameTable );
+
+        my $boBundleNameTable = $session->get_table(
+                            -baseoid => $dd->oiddef('boBundleName') );
+        $devdetails->storeSnmpVars( $boBundleNameTable );
+
+        if( defined( $boOfferNameTable ) )
+        {
+            $devdetails->setCap('arbor-bundle');
+
+            foreach my $boOfferNameID ( $devdetails->getSnmpIndices(
+                                $dd->oiddef('boOfferName') ) )
+            {
+		my ($bundleID,$offerNameID) = split( /\./, $boOfferNameID );
+
+                my $offerName = $boOfferNameTable->{
+                                    $dd->oiddef('boOfferName')
+                                    . '.' . $boOfferNameID };
+                my $bundleName = $boBundleNameTable->{
+                                    $dd->oiddef('boBundleName')
+                                    . '.' . $boOfferNameID };
+
+                $data->{'arbor_e'}{'offerName'}{$offerNameID} = $offerName;
+                $data->{'arbor_e'}{'bundleName'}{$bundleID}   = $bundleName;
+
+                push( @{$data->{'arbor_e'}{'boOfferBundle'}{$offerNameID}},
+                      $bundleID );
+            }
+        }
+
+        # PROG: Subscribers using the bundle
+        if( $devdetails->param('Arbor_E::disable-bundle-offer-subcount')
+            ne 'yes' )
+        {
+            my $oidSubcount = $dd->oiddef('boBundleSubCount');
+
+            if( defined $session->get_table( -baseoid => $oidSubcount ) )
+            {
+                $devdetails->setCap('arbor-bundle-subcount');
+            }
+        }
+
+        # PROG: Packets sent on this bundle with a size
+        if( $devdetails->param('Arbor_E::disable-bundle-offer-pktsize')
+            ne 'yes' )
+        {
+            my $oidPktsize = $dd->oiddef('boPacketsSent64');
+
+            if( defined $session->get_table( -baseoid => $oidPktsize ) )
+            {
+                $devdetails->setCap('arbor-bundle-pktsize');
+            }
+        }
+
+        # PROG: Bytes sent on this bundle for deny policy drop
+        if( $devdetails->param('Arbor_E::disable-bundle-offer-deny')
+            ne 'yes' )
+        {
+            my $oidDenypolicy = $dd->oiddef('boBundleBytesSentDenyPolicyDrop');
+
+            if( defined $session->get_table( -baseoid => $oidDenypolicy ) )
+            {
+                $devdetails->setCap('arbor-bundle-deny');
+            }
+        }
+
+        # PROG: Bytes sent on this bundle for rate limit drop
+        if( $devdetails->param('Arbor_E::disable-bundle-offer-rate')
+            ne 'yes' )
+        {
+            my $oidRatelimit = $dd->oiddef('boBundleBytesSentRateLimitDrop');
+
+            if( defined $session->get_table( -baseoid => $oidRatelimit ) )
+            {
+                $devdetails->setCap('arbor-bundle-ratelimit');
+            }
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    # PROG: Lets do e30 first ...
+    if( $devdetails->hasCap('e30') )
+    {
+        # e30 buffer information
+        if( $devdetails->hasCap('e30-buffers') )
+        {
+            $cb->addTemplateApplication($devNode, 'Arbor_E::e30-buffers');
+        }
+
+        if( $devdetails->hasCap('e30-bundle') )
+        {
+            # Create topLevel subtree
+            my $bundleNode = $cb->addSubtree( $devNode, 'Bundle_Stats',
+                                    { 'comment' => 'Bundle statistics' },
+                                    [ 'Arbor_E::e30-bundle-subtree' ] );
+
+            foreach my $bundleID
+                ( sort {$a <=> $b} keys %{$data->{'e30'}{'bundleID'} } )
+            {
+                my $srvName     =  $data->{'e30'}{'bundleID'}{$bundleID};
+                my $subtreeName =  $srvName;
+                   $subtreeName =~ s/\W/_/g; 
+                my $bundleRRD	= $bundleID;
+                my @templates   = ( 'Arbor_E::e30-bundle' );
+
+                if( $devdetails->param('Arbor_E::enable-e30-bundle-name-rrd')
+                    eq 'yes' )
+                {
+                    # Filenames written out as the bundle name
+                    $bundleRRD =  lc($srvName);
+                    $bundleRRD =~ s/\W/_/g;
+                }
+
+                if( $devdetails->hasCap('e30-bundle-denyStats') )
+                {
+                    push( @templates, 'Arbor_E::e30-bundle-deny' );
+                }
+
+                if( $devdetails->hasCap('e30-bundle-rateLimitStats') )
+                {
+                    push( @templates, 'Arbor_E::e30-bundle-ratelimit' );
+                }
+
+                $cb->addSubtree( $bundleNode, $subtreeName,
+                                 { 'comment'          => $srvName,
+                                   'e30-bundle-index' => $bundleID,
+                                   'e30-bundle-name'  => $srvName,
+                                   'e30-bundle-rrd'   => $bundleRRD,
+                                   'precedence'       => 1000 - $bundleID },
+                                 \@templates );
+            } # END foreach my $bundleID
+        }
+
+        # e30 cpu
+        if( $devdetails->hasCap('e30-cpu') )
+        {
+            $cb->addTemplateApplication($devNode, 'Arbor_E::e30-cpu');
+        }
+
+        # e30 forwarding table
+        if( $devdetails->hasCap('e30-fwdTable') )
+        {
+            $cb->addTemplateApplication($devNode, 'Arbor_E::e30-fwdTable');
+
+            if( $devdetails->hasCap('e30-fwdTable-login') )
+            {
+                my $subtree  = "Forwarding_Table_Login_Stats";
+                my $comment  = "Discovery attempts statistics";
+                my $nodeTree = $cb->addSubtree( $devNode, $subtree, 
+                                              { 'comment' => $comment },
+                                                undef );
+
+                my @colors =
+                    ('##one', '##two', '##three', '##four', '##five',
+                     '##six', '##seven', '##eight', '##nine', '##ten'
+                    );
+
+                my $multiParam = {
+                    'precedence'        => 1000,
+                    'comment'           => 'Summary of login attempt responses',
+                    'graph-lower-limit' => 0,
+                    'graph-title'       => 'Summary of login attempt responses',
+                    'rrd-hwpredict'     => 'disabled',
+                    'vertical-label'    => 'Responses',
+                    'ds-type'           => 'rrd-multigraph'
+                    };
+                my $dsList;
+
+                foreach my $sindex ( sort { $a <=> $b } 
+                                     @{$data->{'e30'}{'loginResp'}} )
+                {
+		
+                    $cb->addLeaf( $nodeTree, 'Login_' . $sindex,
+                                { 'comment'    => 'Login attempt #' . $sindex,
+                                  'login-idx'  => $sindex,
+                                  'precedence' => 100 - $sindex },
+                                [ 'Arbor_E::e30-fwdTable-login' ] );
+
+                    # Addition for multi-graph
+                    my $dsName  = "Login_$sindex";
+                    my $color   = shift @colors;
+                       $dsList .= $dsName . ',';
+
+                    $multiParam->{"ds-expr-$dsName"}      = "{$dsName}";
+                    $multiParam->{"graph-legend-$dsName"} = "Attempt $sindex";
+                    $multiParam->{"line-style-$dsName"}   = "LINE1";
+                    $multiParam->{"line-color-$dsName"}   = $color;
+                    $multiParam->{"line-order-$dsName"}   = $sindex;
+
+                    Debug("  loginReps: $sindex, color: $color");
+                } # END: foreach $sindex
+
+                $dsList =~ s/,$//o;	# Remove final comma
+                $multiParam->{'ds-names'} = $dsList;
+
+                $cb->addLeaf($nodeTree, 'Summary', $multiParam, undef );
+
+            } # END: hasCap e30-fwdTable-login
+        } # END: hasCap e30-fwdTable
+
+        # e30 hard drive
+        if( $devdetails->hasCap('e30-hdd') )
+        {
+            my $comment = "Model: "  . $data->{'e30'}{'hddModel'} . ", " .
+                          "Serial: " . $data->{'e30'}{'hddSerial'};
+            my $subtree = "Hard_Drive";
+            my @templates;
+            push( @templates, 'Arbor_E::e30-hdd-subtree' );
+            push( @templates, 'Arbor_E::e30-hdd' );
+
+            # PROG: Process hdd errors
+            if( $devdetails->hasCap('e30-hdd-errors') )
+            {
+                push( @templates, 'Arbor_E::e30-hdd-errors' );
+            }
+
+            # PROG: Process hdd daily logs
+            if( $devdetails->hasCap('e30-hdd-logs') )
+            {
+                push( @templates, 'Arbor_E::e30-hdd-logs' );
+            }
+
+            my $hdNode = $cb->addSubtree($devNode, $subtree,
+                                        { 'comment' => $comment },
+                                        \@templates);
+        }
+
+        # e30 L2TP tunnel information
+        if( $devdetails->hasCap('e30-l2tp') )
+        {
+            # PROG: First add the appropriate template
+            my $l2tpNode = $cb->addSubtree( $devNode, 'L2TP', undef,
+                                          [ 'Arbor_E::e30-l2tp-subtree' ]);
+
+            # PROG: Cycle through the SECURE EndPoint devices
+            if( $data->{'e30'}{'l2tpSEP'} )
+            {
+                # PROG: Add the assisting template first
+                my $l2tpEndNode = $cb->addSubtree( $l2tpNode, 'Secure_Endpoint',
+                             { 'comment' => 'Secure endpoint parties' },
+                             [ 'Arbor_E::e30-l2tp-secure-endpoints-subtree' ] );
+
+                foreach my $SEP ( keys %{$data->{'e30'}{'l2tpSEP'}} )
+                {
+                  my $endPoint =  $SEP;
+                     $endPoint =~ s/\W/_/g;
+
+                  $cb->addSubtree($l2tpEndNode, $endPoint,
+                              { 'e30-l2tp-ep'   => $SEP,
+                                'e30-l2tp-file' => $endPoint },
+                              [ 'Arbor_E::e30-l2tp-secure-endpoints-leaf' ]);
+                } # END: foreach
+            }
+        }
+
+        # e30 memory
+        if( $devdetails->hasCap('e30-mem') )
+        {
+            $cb->addTemplateApplication($devNode, 'Arbor_E::e30-mem');
+        }
+
+        # e30 memory pool
+        if( $devdetails->hasCap('e30-mempool') )
+        {
+            my $subtreeName = "Memory_Pool";
+            my $param       = { 'comment' => 'Memory Pool Statistics' };
+            my $templates   = [ 'Arbor_E::e30-mempool-subtree' ];
+            my $memIndex    = $data->{'e30'}{'mempool'};
+
+            my $nodeTop     = $cb->addSubtree( $devNode, $subtreeName,
+                                               $param, $templates );
+
+            foreach my $memIDX ( keys %{$memIndex} )
+            {
+                my $leafName = $memIndex->{$memIDX};
+                my $dataFile = "%snmp-host%_mempool_" . $leafName . '.rrd';
+
+                my $nodeMem = $cb->addSubtree( $nodeTop, $leafName, 
+                                            { 'data-file'         => $dataFile,
+                                              'e30-mempool-index' => $memIDX,
+                                              'e30-mempool-name'  => $leafName
+                                            },
+                                            [ 'Arbor_E::e30-mempool' ] );
+            }
+        }
+
+        # e30 slowpath counters
+        if( $devdetails->hasCap('e30-slowpath') )
+        {
+            my $slowNode = $cb->addSubtree( $devNode, 'SlowPath', undef,
+                                          [ 'Arbor_E::e30-slowpath' ] );
+        }
+    } # END: if e30 device
+
+
+    # -----------------------------------------------------
+    #
+    # E100 series...
+
+    if( $devdetails->hasCap('e100') )
+    {
+        # CPU: per-cpu information
+        if( $devdetails->hasCap('e100-cpu') )
+        {
+            my @colors  = ( '##one', '##two', '##three', '##four', '##five',
+                            '##six', '##seven', '##eight', '##nine', '##ten'
+                          );
+            my $subtree = "CPU_Usage";
+            my $cpuTree = $cb->addSubtree( $devNode, $subtree, undef,
+                                         [ 'Arbor_E::e100-cpu-subtree' ] );
+            my $multiParam = {
+                'precedence'        => 1000,
+                'comment'           => 'Summary of all CPU utilization',
+                'graph-lower-limit' => 0,
+                'graph-title'       => 'Summary of all CPU utilization',
+                'rrd-hwpredict'     => 'disabled',
+                'vertical-label'    => 'Percent',
+                'ds-type'           => 'rrd-multigraph'
+                };
+            my $dsList;
+
+            foreach my $cpuIndex ( sort keys %{$data->{'e100'}{'cpu'}} )
+            {
+                my $cpuName = $data->{'e100'}{'cpu'}{$cpuIndex};
+  
+                # Is there proper desc for the CPU index?
+                my $comment;
+                if( $eCpuName{$cpuIndex} )
+                {
+                    $comment = $eCpuName{$cpuIndex};
+                } else {
+                    $comment = "CPU: $cpuName";
+                }
+  
+                $cb->addLeaf( $cpuTree, $cpuName,
+                            { 'comment'    => $comment,
+                              'cpu-index'  => $cpuIndex,
+                              'cpu-name'   => $cpuName,
+                              'precedence' => 1000 - $cpuIndex },
+                            [ 'Arbor_E::e100-cpu' ] );
+  
+                # Multi-graph additions
+                my $color   = shift @colors;
+                   $dsList .= $cpuName . ',';
+                $multiParam->{"ds-expr-$cpuName"}      = "{$cpuName}";
+                $multiParam->{"graph-legend-$cpuName"} = "$cpuName";
+                $multiParam->{"line-style-$cpuName"}   = "LINE1";
+                $multiParam->{"line-color-$cpuName"}   = $color;
+                $multiParam->{"line-order-$cpuName"}   = $cpuIndex;
+            } # END: foreach $cpuIndex
+
+            $dsList =~ s/,$//o;     # Remove final comma
+            $multiParam->{'ds-names'} = $dsList;
+            $cb->addLeaf($cpuTree, 'Summary', $multiParam, undef );
+
+        } # END: hasCap e100-cpu
+
+        # HDD: Partition sizes / usage
+        if( $devdetails->hasCap('e100-hdd') )
+        {
+            my $subtree = "HDD_Usage";
+            my $hddTree = $cb->addSubtree( $devNode, $subtree, undef,
+                                         [ 'Arbor_E::e100-hdd-subtree' ] );
+
+            foreach my $hddIndex ( sort keys %{$data->{'e100'}{'hdd'}} )
+            {
+              my $hddName = $data->{'e100'}{'hdd'}{$hddIndex};
+              $cb->addSubtree( $hddTree, $hddName,
+                             { 'comment'    => 'HDD: ' . $hddName,
+                               'hdd-index'  => $hddIndex,
+                               'hdd-name'   => $hddName,
+                               'precedence' => 1000 - $hddIndex },
+                             [ 'Arbor_E::e100-hdd' ] );
+            }
+        }
+
+        # MEM: per-cpu memory usage
+        if( $devdetails->hasCap('e100-mem') )
+        {
+            my $subtree = "Memory_Usage";
+            my $memTree = $cb->addSubtree( $devNode, $subtree, undef,
+                                         [ 'Arbor_E::e100-mem-subtree' ] );
+            foreach my $memIndex ( sort keys %{$data->{'e100'}{'mem'}} )
+            {
+              my $memName = $data->{'e100'}{'cpu'}{$memIndex};
+
+              my $comment = "Memory for $memName CPU";
+              $cb->addSubtree( $memTree, $memName,
+                             { 'comment'    => $comment,
+                               'mem-index'  => $memIndex,
+                               'mem-name'   => $memName,
+                               'precedence' => 1000 - $memIndex },
+                             [ 'Arbor_E::e100-mem' ] );
+            }
+        }
+
+        # PolicyMmgt: Information regarding delta, service bundles, subnets
+        if( $devdetails->hasCap('e100-policymgmt') )
+        {
+            $cb->addTemplateApplication($devNode, 'Arbor_E::e100-policymgmt');
+        }
+
+        # SubscriberMgmt: Information regarding subscriber counts, states, etc.
+        if( $devdetails->hasCap('e100-submgmt') )
+        {
+            my $subMgmtTree = $cb->addSubtree( $devNode, 'Subscribers', undef,
+                                      [ 'Arbor_E::e100-submgmt-subtree' ]
+                             );
+
+            my $stateTree  = $cb->addSubtree( $subMgmtTree, 'Subscriber_State',
+                                        undef,
+                                      [ 'Arbor_E::e100-submgmt-state-subtree' ]
+                             );
+
+            # State: Multigraph display
+            my @colors =
+                ('##one', '##two', '##three', '##four', '##five',
+                 '##six', '##seven', '##eight', '##nine', '##ten'
+                );
+            my $multiParam = {
+                'precedence'        => 1000,
+                'graph-lower-limit' => 0,
+                'graph-title'       => 'Summary of subscriber states',
+                'rrd-hwpredict'     => 'disabled',
+                'vertical-label'    => 'Subscribers',
+                'comment'           => 'Summary of all states',
+                'ds-type'           => 'rrd-multigraph'
+            };
+            my $dsList;
+
+            foreach my $stateIDX ( sort keys %{$data->{'e100'}{'submgmt'}} )
+            {
+                my $color        =  shift @colors;
+                my $stateName    =  $data->{'e100'}{'submgmt'}{$stateIDX};
+                my $stateNameRRD =  $stateName;
+                   $stateNameRRD =~ s/[^a-zA-Z_]/_/o;
+
+                my $stateNode = $cb->addLeaf( $stateTree, $stateName,
+                                   { 'comment'    => "State: $stateName",
+                                     'state-idx'  => $stateIDX,
+                                     'state-name' => $stateName,
+                                     'state-rrd'  => $stateNameRRD,
+                                     'precedence' => 100 - $stateIDX },
+                                   [ 'Arbor_E::e100-submgmt-state' ] );
+                $dsList .= $stateName . ',';
+
+                $multiParam->{"ds-expr-$stateName"}      = "{$stateName}";
+                $multiParam->{"graph-legend-$stateName"} = "$stateName";
+                $multiParam->{"line-style-$stateName"}   = "LINE1";
+                $multiParam->{"line-color-$stateName"}   = $color,
+                $multiParam->{"line-order-$stateName"}   = $stateIDX;
+            }
+            $dsList =~ s/,$//o;
+            $multiParam->{'ds-names'} = $dsList;
+
+            $cb->addLeaf($stateTree, 'Summary', $multiParam, undef );
+
+        }
+    }
+
+    # -------------------------------------------------------------------------
+    #
+    # Common information between e30 and e100
+
+    if( $devdetails->hasCap('arbor-bundle') )
+    {
+        my $subtreeName = "Bundle_Offer_Stats";
+        my $param       = { 'comment'    => 'Byte counts for each bundle ' . 
+                                            'per Offer' };
+        my $templates   = [ ];
+        my $nodeTop     = $cb->addSubtree( $devNode, $subtreeName,
+                                           $param, $templates );
+
+        foreach my $offerNameID ( keys %{$data->{'arbor_e'}{'offerName'}} )
+        {
+            my $offerName   =  $data->{'arbor_e'}{'offerName'}{$offerNameID};
+               $offerName   =~ s/\W/_/g;
+            my $offerBundle =  $data->{'arbor_e'}{'boOfferBundle'};
+            my $offerRRD    =  $offerNameID;
+
+            if( $devdetails->param('Arbor_E::enable-bundle-name-rrd')
+                eq 'yes' )
+            {
+                # Filename will now be written as offer name
+                $offerRRD = lc($offerName);
+            }
+
+            # Build tree
+            my $oparam = { 'comment'   => 'Offer: ' . $offerName,
+                           'offer-id'  => $offerNameID,
+                           'offer-rrd' => $offerRRD };
+            my $otemplates = [ 'Arbor_E::arbor-bundle-subtree' ];
+            my $offerTop = $cb->addSubtree( $nodeTop, $offerName, $oparam,
+                                            $otemplates );
+
+            Debug("    Offer: $offerName");
+
+            foreach my $bundleID ( @{%{$offerBundle}->{$offerNameID}} )
+            {
+                my @btemplates;
+                my $bundleName =  $data->{'arbor_e'}{'bundleName'}{$bundleID};
+                   $bundleName =~ s/\W/_/g;
+                my $bundleRRD  =  $bundleID;
+
+                Debug("      $bundleID: $bundleName");
+
+                if( $devdetails->param('Arbor_E::enable-bundle-name-rrd')
+                    eq 'yes' )
+                {
+                    # Filename will now be written as bundle name
+                    $bundleRRD = lc($bundleName);
+                }
+
+                my $bparam     = { 'comment'     => 'Bundle ID: ' . $bundleID,
+                                   'data-file'   => '%system-id%_bo_' .
+                                                    '%offer-rrd%_' .
+                                                    '%bundle-rrd%.rrd',
+                                   'bundle-id'   => $bundleID,
+                                   'bundle-name' => $bundleName,
+                                   'bundle-rrd'  => $bundleRRD };
+                push( @btemplates, 'Arbor_E::arbor-bundle' );
+
+                # PROG: Subscribers using the bundle
+                if( $devdetails->hasCap('arbor-bundle-subcount') )
+                {
+                    push( @btemplates, 'Arbor_E::arbor-bundle-subcount' );
+                }
+
+                # PROG: Packets sent on this bundle per size
+                if( $devdetails->hasCap('arbor-bundle-pktsize') )
+                {
+                    push( @btemplates, 'Arbor_E::arbor-bundle-pktsize' );
+                }
+
+                # PROG: Bytes sent on this bundle for deny policy drop
+                if( $devdetails->hasCap('arbor-bundle-deny') )
+                {
+                    push( @btemplates, 'Arbor_E::arbor-bundle-deny' );
+                }
+
+                # PROG: Bytes sent on this bundle for rate limit drop
+                if( $devdetails->hasCap('arbor-bundle-ratelimit') )
+                {
+                    push( @btemplates, 'Arbor_E::arbor-bundle-ratelimit' );
+                }
+
+                # Build tree
+                $cb->addSubtree( $offerTop, $bundleName,
+                                 $bparam, \@btemplates );
+            } # END: foreach $bundleID
+        } # END: foreach $offerNameID
+    } # END: hasCap arbor-bundle
+
+    # Flow device lookups
+    if( $devdetails->hasCap('arbor-flowLookup') )
+    {
+        # PROG: Flow Lookup Device (pool names)
+        my $flowNode = $cb->addSubtree( $devNode, 'Flow_Lookup',
+                                      { 'comment' => 'Switching modules' },
+                                        undef );
+
+        my $flowLookup = $data->{'arbor_e'}{'flowModule'};
+
+        foreach my $flowDevIdx ( keys %{$flowLookup} )
+        {
+            my $flowNodeDev = $cb->addSubtree( $flowNode,
+                              'Flow_Lookup_' .  $flowDevIdx,
+                              { 'comment' => 'Switching module '
+                                              . $flowDevIdx },
+                              [ 'Arbor_E::arbor-flowlkup-subtree' ] );
+
+            # PROG: Find all the pool names and add Subtree
+            foreach my $flowPoolIdx ( keys %{$flowLookup->{$flowDevIdx}} )
+            {
+                my $poolName = $flowLookup->{$flowDevIdx}{$flowPoolIdx};
+
+                my $poolNode = $cb->addSubtree( $flowNodeDev, $poolName,
+                               { 'comment'        => 'Flow Pool: ' . $poolName,
+                                 'flowdev-index'  => $flowDevIdx,
+                                 'flowpool-index' => $flowPoolIdx,
+                                 'flowpool-name'  => $poolName,
+                                 'precedence'     => 1000 - $flowPoolIdx},
+                               [ 'Arbor_E::arbor-flowlkup-leaf' ] );
+            } # END: foreach my $flowPoolIdx
+        } # END: foreach my $flowDevIdx
+    } # END: hasCap arbor-flowLookup
+
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/Arista.pm b/torrus/perllib/Torrus/DevDiscover/Arista.pm
new file mode 100644
index 000000000..bd18029e4
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Arista.pm
@@ -0,0 +1,144 @@
+#
+#  Copyright (C) 2009  Jon Nistor
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Arista.pm,v 1.1 2010-12-27 00:03:49 ivan Exp $
+# Jon Nistor <nistor at snickers.org>
+
+# Force10 Networks Real Time Operating System Software
+#
+# NOTE: Arista::x
+
+package Torrus::DevDiscover::Arista;
+
+use strict;
+use Torrus::Log;
+
+$Torrus::DevDiscover::registry{'Arista'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     'sysDescr'		=> '1.3.6.1.2.1.1.1.0',
+     # Arista
+     'aristaProducts'	=> '1.3.6.1.4.1.30065.1'
+
+     );
+
+
+# Not all interfaces are normally needed to monitor.
+# You may override the interface filtering in devdiscover-siteconfig.pl:
+# redefine $Torrus::DevDiscover::Arista::interfaceFilter
+# or define $Torrus::DevDiscover::Arista::interfaceFilterOverlay
+
+our $interfaceFilter;
+our $interfaceFilterOverlay;
+my %aristaInterfaceFilter;
+
+if( not defined( $interfaceFilter ) )
+{
+    $interfaceFilter = \%aristaInterfaceFilter;
+}
+
+
+# Key is some unique symbolic name, does not mean anything
+#  ifType is the number to match the interface type
+# ifDescr is the regexp to match the interface description
+%aristaInterfaceFilter =
+    (
+     'other' => {
+         'ifType'  => 1,                     # other
+     },
+     'lag'      => {
+         'ifType'  => 161,                   # ieee 802.3ad LAG groups
+                                             # added due to index too high
+     },
+     'loopback' => {
+         'ifType'  => 24,                    # softwareLoopback
+     },
+     'vlan' => {
+         'ifType'  => 136,                   # vlan
+                                             # added due to index too high
+     },
+
+    );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'aristaProducts',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+
+    &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+        ($devdetails, $interfaceFilter);
+    
+    if( defined( $interfaceFilterOverlay ) )
+    {
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilterOverlay);
+    }
+
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # PROG: Add comment for sysDescr
+    my $desc	= $dd->retrieveSnmpOIDs('sysDescr');
+    $data->{'param'}{'comment'} = $desc->{'sysDescr'};
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+}
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/AscendMax.pm b/torrus/perllib/Torrus/DevDiscover/AscendMax.pm
new file mode 100644
index 000000000..4bf2bd83b
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/AscendMax.pm
@@ -0,0 +1,207 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: AscendMax.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Ascend (Lucent) MAX device discovery.
+
+# Tested with:
+#
+# MAX 4000, TAOS version 7.0.26
+
+# NOTE: SNMP version 1 is only supported. Because of version 1 and numerous
+# WAN DS0 interfaces, the discovery process may take few minutes.
+
+package Torrus::DevDiscover::AscendMax;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'AscendMax'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # ASCEND-MIB
+     'ASCEND-MIB::max' => '1.3.6.1.4.1.529.1.2',
+     # ASCEND-ADVANCED-AGENT-MIB
+     'ASCEND-ADVANCED-AGENT-MIB::wanLineTable' =>
+     '1.3.6.1.4.1.529.4.21',
+     'ASCEND-ADVANCED-AGENT-MIB::wanLineState' =>
+     '1.3.6.1.4.1.529.4.21.1.5',
+     'ASCEND-ADVANCED-AGENT-MIB::wanLineActiveChannels' =>
+     '1.3.6.1.4.1.529.4.21.1.7',
+     'ASCEND-ADVANCED-AGENT-MIB::wanLineSwitchedChannels' =>
+     '1.3.6.1.4.1.529.4.21.1.13'
+     );
+
+# Not all interfaces are normally needed to monitor.
+# You may override the interface filtering in devdiscover-siteconfig.pl:
+# redefine $Torrus::DevDiscover::AscendMax::interfaceFilter
+# or define $Torrus::DevDiscover::AscendMax::interfaceFilterOverlay
+
+our $interfaceFilter;
+our $interfaceFilterOverlay;
+my %ascMaxInterfaceFilter;
+
+if( not defined( $interfaceFilter ) )
+{
+    $interfaceFilter = \%ascMaxInterfaceFilter;
+}
+
+
+# Key is some unique symbolic name, does not mean anything
+# ifType is the number to match the interface type
+# ifDescr is the regexp to match the interface description
+%ascMaxInterfaceFilter =
+    (
+     'Console' => {
+         'ifType'  => 33                      # rs232
+         },
+     'E1' => {
+         'ifType'  => 19                      # e1
+         },
+     'wan_activeN' => {
+         'ifType'  => 23,                     # ppp
+         'ifDescr'  => '^wan\d+'
+         },
+     'wan_inactiveN' => {
+         'ifType'  => 1,                      # other
+         'ifDescr'  => '^wan\d+'
+         },
+     'wanidleN' => {
+         'ifType'  => 1,                      # other
+         'ifDescr'  => '^wanidle\d+'
+         },
+     'loopbacks' => {
+         'ifType'  => 24                      # softwareLoopback
+         }
+     );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'ASCEND-MIB::max',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+
+    &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+        ($devdetails, $interfaceFilter);
+
+    if( defined( $interfaceFilterOverlay ) )
+    {
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilterOverlay);
+    }
+
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    my $wanTableOid = $dd->oiddef('ASCEND-ADVANCED-AGENT-MIB::wanLineTable' );
+    my $stateOid =
+        $dd->oiddef('ASCEND-ADVANCED-AGENT-MIB::wanLineState' );
+    my $totalOid =
+        $dd->oiddef('ASCEND-ADVANCED-AGENT-MIB::wanLineSwitchedChannels' );
+
+    my $wanTable =  $session->get_table( -baseoid => $wanTableOid );
+    if( defined( $wanTable ) )
+    {
+        $devdetails->storeSnmpVars( $wanTable );
+        $devdetails->setCap('wanLineTable');
+
+        $data->{'ascend_wanLines'} = {};
+
+        foreach my $ifIndex ( $devdetails->getSnmpIndices( $stateOid ) )
+        {
+            # Check if the line State is 13(active)
+            if( $devdetails->snmpVar( $stateOid . '.' . $ifIndex) == 13 )
+            {
+                my $descr = $devdetails->snmpVar($dd->oiddef('ifDescr') .
+                                                 '.' . $ifIndex);
+
+                $data->{'ascend_wanLines'}{$ifIndex}{'description'} = $descr;
+                $data->{'ascend_wanLines'}{$ifIndex}{'channels'} =
+                    $devdetails->snmpVar( $totalOid . '.' . $ifIndex );
+            }
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    my $callStatsNode = $cb->addSubtree( $devNode, 'Call_Statistics', undef,
+                                         ['AscendMax::ascend-totalcalls']);
+
+    foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'ascend_wanLines'}} )
+    {
+        my $param = {};
+        $param->{'precedence'} = sprintf('%d', -10000 - $ifIndex);
+        $param->{'ascend-ifidx'} = $ifIndex;
+
+        my $nChannels = $data->{'ascend_wanLines'}{$ifIndex}{'channels'};
+        $param->{'upper-limit'} = $nChannels;
+        $param->{'graph-upper-limit'} = $nChannels;
+
+        my $subtreeName = $data->{'ascend_wanLines'}{$ifIndex}{'description'};
+        $subtreeName =~ s/\W/_/g;
+
+        $cb->addLeaf( $callStatsNode, $subtreeName, $param,
+                      ['AscendMax::ascend-line-stats']);
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/AxxessIT.pm b/torrus/perllib/Torrus/DevDiscover/AxxessIT.pm
new file mode 100644
index 000000000..12dc05957
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/AxxessIT.pm
@@ -0,0 +1,351 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: AxxessIT.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# AxxessIT Ethernet over SDH switches, also known as
+# Cisco ONS 15305 and 15302 (by January 2005)
+# Probably later Cisco will update the software and it will need
+# another Torrus discovery module.
+# Company website: http://www.axxessit.no/
+
+# Tested with:
+#
+# Cisco ONS 15305 software release 1.1.1
+# Cisco ONS 15302
+
+
+    
+
+package Torrus::DevDiscover::AxxessIT;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'AxxessIT'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # AXXEDGE-MIB
+     'axxEdgeTypes'                  => '1.3.6.1.4.1.7546.1.4.1.1',
+     
+     'axxEdgeWanPortMapTable'         => '1.3.6.1.4.1.7546.1.4.1.2.5.1.2',
+     'axxEdgeWanPortMapSlotNumber'    => '1.3.6.1.4.1.7546.1.4.1.2.5.1.2.1.1',
+     'axxEdgeWanPortMapPortNumber'    => '1.3.6.1.4.1.7546.1.4.1.2.5.1.2.1.2',
+
+     'axxEdgeWanXPortMapTable'        => '1.3.6.1.4.1.7546.1.4.1.2.5.1.11',
+     'axxEdgeWanXPortMapSlotNumber'   => '1.3.6.1.4.1.7546.1.4.1.2.5.1.11.1.1',
+     'axxEdgeWanXPortMapPortNumber'   => '1.3.6.1.4.1.7546.1.4.1.2.5.1.11.1.2',
+     
+     'axxEdgeWanPortDescription'      => '1.3.6.1.4.1.7546.1.4.1.2.5.1.3.1.4',
+     'axxEdgeWanXPortDescription'     => '1.3.6.1.4.1.7546.1.4.1.2.5.1.12.1.4',
+     
+     'axxEdgeEthPortMapTable'         => '1.3.6.1.4.1.7546.1.4.1.2.6.1.2',
+     'axxEdgeEthPortMapSlotNumber'    => '1.3.6.1.4.1.7546.1.4.1.2.6.1.2.1.1',
+     'axxEdgeEthPortMapPortNumber'    => '1.3.6.1.4.1.7546.1.4.1.2.6.1.2.1.2',
+
+     'axxEdgeEthLanXPortMapTable'     => '1.3.6.1.4.1.7546.1.4.1.2.6.1.4',
+     'axxEdgeEthLanXPortMapSlotNumber' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.4.1.1',
+     'axxEdgeEthLanXPortMapPortNumber' => '1.3.6.1.4.1.7546.1.4.1.2.6.1.4.1.2',
+     
+     'axxEdgeEthPortDescription'      => '1.3.6.1.4.1.7546.1.4.1.2.6.1.3.1.4',
+     'axxEdgeEthLanXPortDescription'  => '1.3.6.1.4.1.7546.1.4.1.2.6.1.5.1.4',
+     
+     'axxEdgeDcnManagementPortMode'    => '1.3.6.1.4.1.7546.1.4.1.2.3.2.1.0',
+     'axxEdgeDcnManagementPortIfIndex' => '1.3.6.1.4.1.7546.1.4.1.2.3.2.2.0',
+
+     # AXX155E-MIB (ONS 15302)
+     'axx155EDevices'                 => '1.3.6.1.4.1.7546.1.5.1.1',
+
+     'axx155EEthPortTable'            => '1.3.6.1.4.1.7546.1.5.1.2.6.1.2',
+     'axx155EEthPortIfIndex'          => '1.3.6.1.4.1.7546.1.5.1.2.6.1.2.1.2',
+     'axx155EEthPortName'             => '1.3.6.1.4.1.7546.1.5.1.2.6.1.2.1.3',
+     'axx155EEthPortType'             => '1.3.6.1.4.1.7546.1.5.1.2.6.1.2.1.4',
+
+     'axx155EDcnManagementPortMode'   => '1.3.6.1.4.1.7546.1.5.1.2.2.2.2.0',
+     'axx155EDcnManagementPortIfIndex' => '1.3.6.1.4.1.7546.1.5.1.2.2.2.3.0'
+     );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $sysObjID = $devdetails->snmpVar( $dd->oiddef('sysObjectID') );
+    if( index( $sysObjID, $dd->oiddef('axxEdgeTypes') ) == 0 )
+    {
+        $devdetails->setCap('axxEdge');
+    }
+    elsif( index( $sysObjID, $dd->oiddef('axx155EDevices') ) == 0 )
+    {
+        $devdetails->setCap('axx155E');
+    }
+    else
+    {
+        return 0;
+    }
+
+    $devdetails->setCap('interfaceIndexingManaged');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    $data->{'param'}{'ifindex-map'} = '$IFIDX_IFINDEX';
+    
+    $data->{'nameref'}{'ifNick'}        = 'axxInterfaceNick';
+    $data->{'nameref'}{'ifSubtreeName'} = 'axxInterfaceNick';
+    $data->{'nameref'}{'ifComment'}     = 'axxInterfaceComment';
+    $data->{'nameref'}{'ifReferenceName'}  = 'axxInterfaceHumanName';
+
+    if( $devdetails->hasCap('axxEdge') )
+    {
+        my %map =
+            ( 'Wan' => {
+                'MapTable'      => 'axxEdgeWanPortMapTable',
+                'MapSlotNumber' => 'axxEdgeWanPortMapSlotNumber',
+                'MapPortNumber' => 'axxEdgeWanPortMapPortNumber',
+                'Description'   => 'axxEdgeWanPortDescription',
+                'ifNick'        => 'Wan_%d_%d',
+                'ifHuman'       => 'WAN %d/%d',
+                'ifComment'     => 'WAN slot %d, port %d' },
+
+              'WanX' => {
+                'MapTable'      => 'axxEdgeWanXPortMapTable',
+                'MapSlotNumber' => 'axxEdgeWanXPortMapSlotNumber',
+                'MapPortNumber' => 'axxEdgeWanXPortMapPortNumber',
+                'Description'   => 'axxEdgeWanXPortDescription',
+                'ifNick'        => 'WanX_%d_%d',
+                'ifHuman'       => 'WANX %d/%d',
+                'ifComment'     => 'WANX slot %d, port %d'  },
+              
+              'Eth' => {
+                'MapTable'      => 'axxEdgeEthPortMapTable',
+                'MapSlotNumber' => 'axxEdgeEthPortMapSlotNumber',
+                'MapPortNumber' => 'axxEdgeEthPortMapPortNumber',
+                'Description'   => 'axxEdgeEthPortDescription',
+                'ifNick'        => 'Eth_%d_%d',
+                'ifHuman'       => 'Ethernet %d/%d',
+                'ifComment'     => 'Ethernet interface: slot %d, port %d' },
+              
+              'EthLanX' => {
+                'MapTable'      => 'axxEdgeEthLanXPortMapTable',
+                'MapSlotNumber' => 'axxEdgeEthLanXPortMapSlotNumber',
+                'MapPortNumber' => 'axxEdgeEthLanXPortMapPortNumber',
+                'Description'   => 'axxEdgeEthLanXPortDescription',
+                'ifNick'        => 'EthLanX_%d_%d',
+                'ifHuman'       => 'Ethernet LANX %d/%d',
+                'ifComment'  => 'Ethernet LANX interface: slot %d, port %d' }
+              );
+
+        foreach my $type ( keys %map )
+        {
+            my $mapTable =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef($map{$type}{'MapTable'}) );
+            $devdetails->storeSnmpVars( $mapTable );
+            
+            my $descTable =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef($map{$type}{'Description'}) );
+            $devdetails->storeSnmpVars( $descTable );
+        
+            foreach my $ifIndex
+                ( $devdetails->
+                  getSnmpIndices($dd->oiddef($map{$type}{'MapSlotNumber'})) )
+            {
+                my $interface = $data->{'interfaces'}{$ifIndex};
+                next if not defined( $interface );
+
+                my $slot =
+                    $devdetails->snmpVar
+                    ($dd->oiddef($map{$type}{'MapSlotNumber'}) .'.'. $ifIndex);
+                my $port =
+                    $devdetails->snmpVar
+                    ($dd->oiddef($map{$type}{'MapPortNumber'}) .'.'. $ifIndex);
+            
+                my $desc =
+                    $devdetails->snmpVar
+                    ($dd->oiddef($map{$type}{'Description'}) .'.'.
+                     $slot .'.'. $port);
+                
+                $interface->{'param'}{'interface-index'} = $ifIndex;
+
+                $interface->{'axxInterfaceNick'} =
+                    sprintf( $map{$type}{'ifNick'}, $slot, $port );
+                
+                $interface->{'axxInterfaceHumanName'} =
+                    sprintf( $map{$type}{'ifHuman'}, $slot, $port );
+
+                $interface->{'axxInterfaceComment'} =
+                    sprintf( $map{$type}{'ifComment'}, $slot, $port );
+                if( length( $desc ) > 0 )
+                {
+                    $interface->{'axxInterfaceComment'} .= ' (' . $desc . ')';
+                }
+            }
+        }
+        
+        # Management interface
+        {
+            my $result = $dd->retrieveSnmpOIDs
+                ( 'axxEdgeDcnManagementPortMode',
+                  'axxEdgeDcnManagementPortIfIndex');
+
+            if( defined( $result ) )
+            {
+                if( $result->{'axxEdgeDcnManagementPortMode'} != 2 )
+                {
+                    Warning('Non-IP mode of Management port is not supported');
+                }
+                else
+                {
+                    my $ifIndex = $result->{'axxEdgeDcnManagementPortIfIndex'};
+                    
+                    my $interface = $data->{'interfaces'}{$ifIndex};
+            
+                    $interface->{'param'}{'interface-index'} = $ifIndex;
+
+                    $interface->{'axxInterfaceNick'} = 'Management';
+
+                    $interface->{'axxInterfaceHumanName'} = 'Management';
+
+                    $interface->{'axxInterfaceComment'} = 'Management port';
+                }
+            }
+        }
+    }
+    
+    if( $devdetails->hasCap('axx155E') )
+    {
+        my $ethTable =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('axx155EEthPortTable') );
+        $devdetails->storeSnmpVars( $ethTable );
+
+        foreach my $port
+            ( $devdetails->
+              getSnmpIndices($dd->oiddef('axx155EEthPortIfIndex')) )
+        {
+            my $ifIndex =
+                $devdetails->snmpVar
+                ($dd->oiddef('axx155EEthPortIfIndex') .'.'. $port);
+
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            next if not defined( $interface );
+
+            my $portName =
+                $devdetails->snmpVar
+                ($dd->oiddef('axx155EEthPortName') .'.'. $port);
+            
+            my $portType =
+                $devdetails->snmpVar
+                ($dd->oiddef('axx155EEthPortType') .'.'. $port);
+
+            $interface->{'param'}{'interface-index'} = $ifIndex;
+            
+            my $type = $portType == 1 ? 'Eth':'Wan';
+            
+            $interface->{'axxInterfaceNick'} =
+                sprintf( '%s_%d', $type, $port );
+            
+            $interface->{'axxInterfaceHumanName'} =
+                sprintf( '%s %d', $type, $port );
+            
+            $interface->{'axxInterfaceComment'} = '';
+            if( length( $portName ) > 0 )
+            {
+                $interface->{'axxInterfaceComment'} = $portName;
+            }
+        }
+        
+        # Management interface
+        {
+            my $result = $dd->retrieveSnmpOIDs
+                ( 'axx155EDcnManagementPortMode',
+                  'axx155EDcnManagementPortIfIndex');
+
+            if( defined( $result ) )
+            {
+                if( $result->{'axx155EDcnManagementPortMode'} != 2 )
+                {
+                    Warning('Non-IP mode of Management port is not supported');
+                }
+                else
+                {
+                    my $ifIndex = $result->{'axx155EDcnManagementPortIfIndex'};
+                    
+                    my $interface = $data->{'interfaces'}{$ifIndex};
+                    
+                    $interface->{'param'}{'interface-index'} = $ifIndex;
+                    
+                    $interface->{'axxInterfaceNick'} = 'Management';
+                    
+                    $interface->{'axxInterfaceHumanName'} = 'Management';
+                    
+                    $interface->{'axxInterfaceComment'} = 'Management port';
+                }
+            }
+        }
+    }
+    
+    foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+    {
+        if( not defined( $data->{'interfaces'}{$ifIndex}->
+                         {'param'}{'interface-index'} ) )
+        {
+            delete $data->{'interfaces'}{$ifIndex};
+        }
+    }    
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/BetterNetworks.pm b/torrus/perllib/Torrus/DevDiscover/BetterNetworks.pm
new file mode 100644
index 000000000..c7187992c
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/BetterNetworks.pm
@@ -0,0 +1,238 @@
+#  Copyright (C) 2004 Marc Haber
+#  Copyright (C) 2005 Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# $Id: BetterNetworks.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+# Marc Haber <mh+torrus-devel@zugschlus.de>
+# Redesigned by Stanislav Sinyagin
+
+# Better Networks Ethernet Box
+
+package Torrus::DevDiscover::BetterNetworks;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'BetterNetworks'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     'BNEversion'          => '1.3.6.1.4.1.14848.2.1.1.1.0',
+     'BNElocation'         => '1.3.6.1.4.1.14848.2.1.1.2.0',
+     'BNEtempunit'         => '1.3.6.1.4.1.14848.2.1.1.3.0',
+     'BNEuptime'           => '1.3.6.1.4.1.14848.2.1.1.7.0',
+     'BNEsensorTable'      => '1.3.6.1.4.1.14848.2.1.2',
+     'BNEsensorName'       => '1.3.6.1.4.1.14848.2.1.2.1.2',
+     'BNEsensorType'       => '1.3.6.1.4.1.14848.2.1.2.1.3',
+     'BNEsensorValid'      => '1.3.6.1.4.1.14848.2.1.2.1.7',
+     );
+
+
+our %sensorTypes =
+    (
+     1 => {
+         'comment' => 'Temperature sensor',
+     },
+     2 => {
+         'comment' => 'Brightness sensor',
+         'label' => 'Lux',
+     },
+     3 => {
+         'comment' => 'Humidity sensor',
+         'label' => 'Percent RH',
+     },
+     4 => {
+         'comment' => 'Switch contact',
+     },
+     5 => {
+         'comment' => 'Voltage meter',
+     },
+     6 => {
+         'comment' => 'Smoke sensor',
+     },
+     );
+
+our %tempUnits =
+    (
+     0 => 'Celsius',
+     1 => 'Fahrenheit',
+     2 => 'Kelvin'
+     );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->checkSnmpOID( 'BNEuptime' ) )
+    {
+        return 0;
+    }
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    my $unitInfo = $dd->retrieveSnmpOIDs('BNEversion',
+                                         'BNElocation',
+                                         'BNEtempunit');
+    if( not defined( $unitInfo ) )
+    {
+        Error('Error retrieving Better Networks Ethernet Box device details');
+        return 0;
+    }
+    
+    # sensor support
+    my $sensorTable = $session->get_table( -baseoid =>
+                                           $dd->oiddef('BNEsensorTable') );
+    if( defined( $sensorTable ) )
+    {
+        $devdetails->storeSnmpVars( $sensorTable );
+
+        # store the sensor names to guarantee uniqueness
+        my %sensorNames;
+            
+        foreach my $INDEX
+            ( $devdetails->getSnmpIndices($dd->oiddef('BNEsensorName') ) )
+        {
+            if( $devdetails->snmpVar( $dd->oiddef('BNEsensorValid') .
+                                      '.' . $INDEX ) == 0 )
+            {
+                next;
+            }
+                
+            my $type = $devdetails->snmpVar( $dd->oiddef('BNEsensorType') .
+                                             '.' . $INDEX );
+            my $name = $devdetails->snmpVar( $dd->oiddef('BNEsensorName')
+                                             . '.' . $INDEX );
+
+            if( $sensorNames{$name} )
+            {
+                Warn('Duplicate sensor names: ' . $name);
+                $sensorNames{$name}++;
+            }
+            else
+            {
+                $sensorNames{$name} = 1;
+            }
+
+            if( $sensorNames{$name} > 1 )
+            {
+                $name .= sprintf(' %d', $sensorNames{$name});
+            }
+            
+            my $leafName = $name;
+            $leafName =~ s/\W/_/g;
+
+            my $param = {
+                'bne-sensor-index' => $INDEX,
+                'node-display-name' => $name,
+                'precedence' => sprintf('%d', 1000 - $INDEX)
+                };
+            
+            if( defined( $sensorTypes{$type} ) )
+            {
+                $param->{'comment'} =
+                    sprintf('%s: %s', $sensorTypes{$type}{'comment'}, $name);
+                if( $type != 1 )
+                {
+                    if( defined( $sensorTypes{$type}{'label'} ) )
+                    {
+                        $param->{'vertical-label'} =
+                            $sensorTypes{$type}{'label'};
+                    }
+                }
+                else
+                {
+                    $param->{'vertical-label'} =
+                        $tempUnits{$unitInfo->{'BNEtempunit'}};
+                }
+            }
+            else
+            {
+                $param->{'comment'} = 'Unknown sensor type';
+            }
+
+            $data->{'BNEsensor'}{$INDEX}{'param'} = $param;
+            $data->{'BNEsensor'}{$INDEX}{'leafName'} = $leafName;            
+        }
+
+        if( scalar( %{$data->{'BNEsensor'}} ) > 0 )
+        {
+            $devdetails->setCap('BNEsensor');
+
+            my $devComment = 
+                'BetterNetworks EthernetBox, ' . $unitInfo->{'BNEversion'};
+            if( $unitInfo->{'BNElocation'} =~ /\w/ )
+            {
+                $devComment .= ', Location: ' . 
+                    $unitInfo->{'BNElocation'};
+            }
+            $data->{'param'}{'comment'} = $devComment;
+        }
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    if( $devdetails->hasCap('BNEsensor') )
+    {
+        foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'BNEsensor'}} )
+        {
+            my $param = $data->{'BNEsensor'}{$INDEX}{'param'};
+            my $leafName = $data->{'BNEsensor'}{$INDEX}{'leafName'};
+            
+            $cb->addLeaf( $devNode, $leafName, $param,
+                          ['BetterNetworks::betternetworks-sensor'] );
+        }
+    }
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CasaCMTS.pm b/torrus/perllib/Torrus/DevDiscover/CasaCMTS.pm
new file mode 100644
index 000000000..90b41633f
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CasaCMTS.pm
@@ -0,0 +1,268 @@
+#  Copyright (C) 2010  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CasaCMTS.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# DOCSIS interface, CASA specific
+
+package Torrus::DevDiscover::CasaCMTS;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CasaCMTS'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{
+    'DocsisMacModemsMonitor'} = 'CasaCMTS';
+
+
+our %oiddef =
+    (
+     'casaProducts' => '1.3.6.1.4.1.20858.2',
+     );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+    
+    if( not $dd->oidBaseMatch
+        ( 'casaProducts',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) or
+        not $devdetails->isDevType('RFC2670_DOCS_IF') )
+    {
+        return 0;
+    }
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    
+    push( @{$data->{'docsConfig'}{'docsCableMaclayer'}{'templates'}},
+          'CasaCMTS::casa-docsis-mac-subtree' );
+    
+    foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        push( @{$interface->{'docsTemplates'}},
+              'CasaCMTS::casa-docsis-mac-util' );
+    }
+
+    foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        push( @{$interface->{'docsTemplates'}},
+              'CasaCMTS::casa-docsis-upstream-util' );
+    }
+    
+    foreach my $ifIndex ( @{$data->{'docsCableDownstream'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+        
+        push( @{$interface->{'docsTemplates'}},
+              'CasaCMTS::casa-docsis-downstream-util' );
+    }
+    
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+
+    if( scalar( @{$data->{'docsCableMaclayer'}} ) > 0 )
+    {
+        # Build All_Modems summary graph
+        my $param = {
+            'ds-type'              => 'rrd-multigraph',
+            'ds-names'             => 'total,active,registered',        
+            'graph-lower-limit'    => '0',
+            'precedence'           => '1000',                          
+            'vertical-label'       => 'Modems',
+                
+            'graph-legend-total'   => 'Total',
+            'line-style-total'     => '##totalresource',
+            'line-color-total'     => '##totalresource',
+            'line-order-total'     => '1',
+            
+            'graph-legend-active'  => 'Active',
+            'line-style-active'    => '##resourcepartusage',
+            'line-color-active'    => '##resourcepartusage',
+            'line-order-active'    => '2',
+            
+            'graph-legend-registered'  => 'Registered',
+            'line-style-registered'    => '##resourceusage',
+            'line-color-registered'    => '##resourceusage',
+            'line-order-registered'    => '3',
+            'descriptive-nickname'     => '%system-id%: All modems'
+            };
+
+        # for the sake of better Emacs formatting
+        $param->{'comment'} =
+            'Registered, Active and Total modems on CMTS';
+        
+        $param->{'nodeid'} =
+            $data->{'docsConfig'}{'docsCableMaclayer'}{'nodeidCategory'} .
+            '//%nodeid-device%//modems';
+        
+        my $first = 1;
+        foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            
+            my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+            
+            if( $first )
+            {
+                $param->{'ds-expr-total'} =
+                    '{' . $intf . '/Modems_Total}';
+                $param->{'ds-expr-active'} =
+                    '{' . $intf . '/Modems_Active}';
+                $param->{'ds-expr-registered'} =
+                    '{' . $intf . '/Modems_Registered}';
+                $first = 0;
+            }
+            else
+            {
+                $param->{'ds-expr-total'} .=
+                    ',{' . $intf . '/Modems_Total},+';
+                $param->{'ds-expr-active'} .=
+                    ',{' . $intf . '/Modems_Active},+';
+                $param->{'ds-expr-registered'} .=
+                    ',{' . $intf . '/Modems_Registered},+';
+            }
+        }
+
+        my $macNode =
+            $cb->getChildSubtree( $devNode,
+                                  $data->{'docsConfig'}{
+                                      'docsCableMaclayer'}{
+                                          'subtreeName'} );
+        if( defined( $macNode ) )
+        {
+            $cb->addLeaf( $macNode, 'All_Modems', $param, [] );
+        }
+        else
+        {
+            Error('Could not find the MAC layer subtree');
+            exit 1;
+        }
+        
+        # Apply selector actions
+        foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            
+            my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+            
+            my $monitor =
+                $interface->{'selectorActions'}{'DocsisMacModemsMonitor'};
+            if( defined( $monitor ) )
+            {
+                my $intfNode = $cb->getChildSubtree( $macNode, $intf );
+                $cb->addLeaf( $intfNode, 'Modems_Registered',
+                              {'monitor' => $monitor } );
+            }
+        }
+    }
+
+    if( scalar( @{$data->{'docsCableUpstream'}} ) > 0 )
+    {
+        my $upstrNode =
+            $cb->getChildSubtree( $devNode,
+                                  $data->{'docsConfig'}{'docsCableUpstream'}{
+                                      'subtreeName'} );
+        
+        # Override the overview shortcus defined in rfc2670.docsis-if.xml
+        
+        my $shortcuts = 'snr,fec,freq,modems';
+        
+        my $param = {        
+            'overview-shortcuts' =>
+                $shortcuts,
+                
+                'overview-subleave-name-modems' => 'Modems',
+                'overview-direct-link-modems' => 'yes',
+                'overview-direct-link-view-modems' => 'expanded-dir-html',
+                'overview-shortcut-text-modems' => 'All modems',
+                'overview-shortcut-title-modems'=>
+                'Show modem quantities in one page',
+                'overview-page-title-modems' => 'Modem quantities',
+            };
+        
+        $cb->addParams( $upstrNode, $param );
+    }
+    
+    if( scalar( @{$data->{'docsCableDownstream'}} ) > 0 )
+    {
+        my $downstrNode =
+            $cb->getChildSubtree( $devNode,
+                                  $data->{'docsConfig'}{'docsCableDownstream'}{
+                                      'subtreeName'} );
+        
+        # Override the overview shortcus defined in rfc2670.docsis-if.xml
+        
+        my $shortcuts = 'util,modems';
+        
+        my $param = {        
+            'overview-shortcuts' => $shortcuts,
+            'overview-subleave-name-modems' => 'Modems',
+            'overview-direct-link-modems' => 'yes',
+            'overview-direct-link-view-modems' => 'expanded-dir-html',
+            'overview-shortcut-text-modems' => 'All modems',
+            'overview-shortcut-title-modems' =>
+                'Show modem quantities in one page',
+            'overview-page-title-modems' => 'Modem quantities',
+            };
+        
+        $cb->addParams( $downstrNode, $param );
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoCatOS.pm b/torrus/perllib/Torrus/DevDiscover/CiscoCatOS.pm
new file mode 100644
index 000000000..411d72f7a
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CiscoCatOS.pm
@@ -0,0 +1,193 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CiscoCatOS.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Cisco CatOS devices discovery
+# To do:
+#    Power supply and temperature monitoring
+#    RAM monitoring
+
+package Torrus::DevDiscover::CiscoCatOS;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CiscoCatOS'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # CISCO-SMI
+     'ciscoWorkgroup'                    => '1.3.6.1.4.1.9.5',
+     # CISCO-STACK-MIB
+     'CISCO-STACK-MIB::portName'         => '1.3.6.1.4.1.9.5.1.4.1.1.4',
+     'CISCO-STACK-MIB::portIfIndex'      => '1.3.6.1.4.1.9.5.1.4.1.1.11',
+     'CISCO-STACK-MIB::chassisSerialNumberString' =>
+     '1.3.6.1.4.1.9.5.1.2.19.0'
+     );
+
+
+# Not all interfaces are normally needed to monitor.
+# You may override the interface filtering in devdiscover-siteconfig.pl:
+# redefine $Torrus::DevDiscover::CiscoCatOS::interfaceFilter
+# or define $Torrus::DevDiscover::CiscoCatOS::interfaceFilterOverlay
+
+our $interfaceFilter;
+our $interfaceFilterOverlay;
+my %catOsInterfaceFilter;
+
+if( not defined( $interfaceFilter ) )
+{
+    $interfaceFilter = \%catOsInterfaceFilter;
+}
+
+
+# Key is some unique symbolic name, does not mean anything
+# ifType is the number to match the interface type
+# ifDescr is the regexp to match the interface description
+%catOsInterfaceFilter =
+    (
+     'VLAN N' => {
+         'ifType'  => 53,                     # propVirtual
+         'ifDescr' => '^VLAN\s+\d+'
+         },
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'ciscoWorkgroup',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+
+    &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+        ($devdetails, $interfaceFilter);
+
+    if( defined( $interfaceFilterOverlay ) )
+    {
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilterOverlay);
+    }
+
+    $devdetails->setCap('interfaceIndexingManaged');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    $data->{'nameref'}{'ifReferenceName'} = 'ifName';
+    $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT';
+    $data->{'param'}{'ifindex-table'} = '$ifName';
+
+    $data->{'nameref'}{'ifComment'} = 'portName';
+    
+    # Retrieve port descriptions from CISCO-STACK-MIB
+
+    my $portIfIndexOID = $dd->oiddef('CISCO-STACK-MIB::portIfIndex');
+    my $portNameOID = $dd->oiddef('CISCO-STACK-MIB::portName');
+
+    my $portIfIndex = $session->get_table( -baseoid => $portIfIndexOID );
+    if( defined $portIfIndex )
+    {
+        $devdetails->storeSnmpVars( $portIfIndex );
+
+        my $portName = $session->get_table( -baseoid => $portNameOID );
+        if( defined $portName )
+        {
+            foreach my $portIndex
+                ( $devdetails->getSnmpIndices( $portIfIndexOID ) )
+            {
+                my $ifIndex =
+                    $devdetails->snmpVar( $portIfIndexOID .'.'. $portIndex );
+                my $interface = $data->{'interfaces'}{$ifIndex};
+
+                $interface->{'portName'} =
+                    $portName->{$portNameOID .'.'. $portIndex};
+            }
+        }        
+    }
+
+    # In large installations, only named ports may be of interest
+    if( $devdetails->param('CiscoCatOS::suppress-noname-ports') eq 'yes' )
+    {
+        my $nExcluded = 0;
+        foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            if( not defined( $interface->{'portName'} ) or
+                length( $interface->{'portName'} ) == 0 )
+            {
+                $interface->{'excluded'} = 1;
+                $nExcluded++;
+            }            
+        }
+        Debug('Excluded ' . $nExcluded . ' catalyst ports with empty names');
+    }
+
+    my $chassisSerial =
+        $dd->retrieveSnmpOIDs( 'CISCO-STACK-MIB::chassisSerialNumberString' );
+    if( defined( $chassisSerial ) )
+    {
+        if( defined( $data->{'param'}{'comment'} ) )
+        {
+            $data->{'param'}{'comment'} .= ', ';
+        }
+        $data->{'param'}{'comment'} .= 'Hw Serial#: ' .
+            $chassisSerial->{'CISCO-STACK-MIB::chassisSerialNumberString'};
+    }
+    
+    return 1;
+}
+
+
+# Nothing really to do yet
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoFirewall.pm b/torrus/perllib/Torrus/DevDiscover/CiscoFirewall.pm
new file mode 100644
index 000000000..b27cfb466
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CiscoFirewall.pm
@@ -0,0 +1,142 @@
+#  Copyright (C) 2003  Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CiscoFirewall.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $
+# Shawn Ferry <lalartu at obscure dot org> <sferry at sevenspace dot com>
+
+# Cisco Firewall devices discovery
+
+package Torrus::DevDiscover::CiscoFirewall;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CiscoFirewall'} = {
+    'sequence'     => 510,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # CISCO-FIREWALL
+     'ciscoFirewallMIB'            => '1.3.6.1.4.1.9.9.147',
+     'cfwBasicEventsTableLastRow'  => '1.3.6.1.4.1.9.9.147.1.1.4',
+     'cfwConnectionStatTable'      => '1.3.6.1.4.1.9.9.147.1.2.2.2.1',
+     'cfwConnectionStatMax'        => '1.3.6.1.4.1.9.9.147.1.2.2.2.1.5.40.7',
+     );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    if( $devdetails->isDevType('CiscoGeneric') and
+        $dd->checkSnmpTable('ciscoFirewallMIB') )
+    {
+        $devdetails->setCap('interfaceIndexingManaged');
+        return 1;
+    }
+
+    return 0;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    $data->{'nameref'}{'ifReferenceName'} = 'ifName';
+    $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT';
+    $data->{'param'}{'ifindex-table'} = '$ifName';
+
+    if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) )
+    {
+        my $oidsPerPDU =
+            $devdetails->param('CiscoFirewall::snmp-oids-per-pdu');
+        if( $oidsPerPDU == 0 )
+        {
+            $oidsPerPDU = 10;
+        }
+        $data->{'param'}{'snmp-oids-per-pdu'} = $oidsPerPDU;
+    }
+
+    if( $dd->checkSnmpOID('cfwConnectionStatMax') )
+    {
+        $devdetails->setCap('CiscoFirewall::connections');
+    }
+    
+    # I have not seen a system that supports this.
+    if( $dd->checkSnmpOID('cfwBasicEventsTableLastRow') )
+    {
+        $devdetails->setCap('CiscoFirewall::events');
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    my $fwStatsTree = "Firewall_Stats";
+    my $fwStatsParam = {
+        'precedence' => '-1000',
+        'comment'    => 'Firewall Stats',
+    };
+
+    my @templates = ('CiscoFirewall::cisco-firewall-subtree');
+    
+    if( $devdetails->hasCap('CiscoFirewall::connections') )
+    {
+        push( @templates, 'CiscoFirewall::connections');
+    }
+
+    if( $devdetails->hasCap('CiscoFirewall::events') )
+    {
+        push( @templates, 'CiscoFirewall::events');
+    }
+
+    $cb->addSubtree( $devNode, $fwStatsTree, $fwStatsParam, \@templates );
+}
+
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoGeneric.pm b/torrus/perllib/Torrus/DevDiscover/CiscoGeneric.pm
new file mode 100644
index 000000000..4262bdd71
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CiscoGeneric.pm
@@ -0,0 +1,743 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CiscoGeneric.pm,v 1.1 2010-12-27 00:03:48 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Common Cisco MIBs, supported by many IOS and CatOS devices
+
+package Torrus::DevDiscover::CiscoGeneric;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CiscoGeneric'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # CISCO-SMI
+     'cisco'                             => '1.3.6.1.4.1.9',
+
+     # CISCO-ENVMON-MIB
+     'ciscoEnvMonTemperatureStatusDescr' => '1.3.6.1.4.1.9.9.13.1.3.1.2',
+     'ciscoEnvMonTemperatureStatusValue' => '1.3.6.1.4.1.9.9.13.1.3.1.3',
+     'ciscoEnvMonTemperatureThreshold'   => '1.3.6.1.4.1.9.9.13.1.3.1.4',
+     'ciscoEnvMonTemperatureStatusState' => '1.3.6.1.4.1.9.9.13.1.3.1.6',
+     'ciscoEnvMonSupplyState'            => '1.3.6.1.4.1.9.9.13.1.5.1.3',
+
+     # CISCO-ENHANCED-MEMPOOL-MIB
+     'cempMemPoolName'                   => '1.3.6.1.4.1.9.9.221.1.1.1.1.3',
+     
+     # CISCO-MEMORY-POOL-MIB
+     'ciscoMemoryPoolName'               => '1.3.6.1.4.1.9.9.48.1.1.1.2',
+
+     # CISCO-PROCESS-MIB
+     'cpmCPUTotalTable'                  => '1.3.6.1.4.1.9.9.109.1.1.1.1',
+     'cpmCPUTotalPhysicalIndex'          => '1.3.6.1.4.1.9.9.109.1.1.1.1.2',
+     'cpmCPUTotal1minRev'                => '1.3.6.1.4.1.9.9.109.1.1.1.1.7',
+     'cpmCPUTotal1min'                   => '1.3.6.1.4.1.9.9.109.1.1.1.1.4',
+
+     # OLD-CISCO-CPU-MIB
+     'avgBusy1'                          => '1.3.6.1.4.1.9.2.1.57.0'
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'cisco', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+    
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    if( $devdetails->param('CiscoGeneric::disable-sensors') ne 'yes' )
+    {
+        # Check if temperature sensors are supported
+
+        my $oidTempDescr = $dd->oiddef('ciscoEnvMonTemperatureStatusDescr');
+        my $oidTempValue = $dd->oiddef('ciscoEnvMonTemperatureStatusValue');
+        my $oidTempThrsh = $dd->oiddef('ciscoEnvMonTemperatureThreshold');
+        my $oidTempState = $dd->oiddef('ciscoEnvMonTemperatureStatusState');
+
+        if( defined $session->get_table( -baseoid => $oidTempValue ) )
+        {
+            $devdetails->setCap('ciscoTemperatureSensors');
+            $data->{'ciscoTemperatureSensors'} = {};
+
+            my $tempDescr = $session->get_table( -baseoid => $oidTempDescr );
+            my $tempThrsh = $session->get_table( -baseoid => $oidTempThrsh );
+
+            # Get the sensor states and ignore those notPresent(5)
+
+            my $tempState = $session->get_table( -baseoid => $oidTempState );
+
+            my $prefixLen = length( $oidTempDescr ) + 1;
+            while( my( $oid, $descr ) = each %{$tempDescr} )
+            {
+                # Extract the sensor index from OID
+                my $sIndex = substr( $oid, $prefixLen );
+
+                if( $tempState->{$oidTempState.'.'.$sIndex} != 5 )
+                {
+                    $data->{'ciscoTemperatureSensors'}{$sIndex}{
+                        'description'} = $descr;
+                    $data->{'ciscoTemperatureSensors'}{$sIndex}{
+                        'threshold'} = $tempThrsh->{$oidTempThrsh.'.'.$sIndex};
+                }
+            }
+        }
+    }
+
+    if( $devdetails->param('CiscoGeneric::disable-psupplies') ne 'yes' )
+    {
+        # Check if power supply status is supported
+
+        my $oidSupply = $dd->oiddef('ciscoEnvMonSupplyState');
+
+        my $supplyTable = $session->get_table( -baseoid => $oidSupply );
+        if( defined( $supplyTable ) )
+        {
+            $devdetails->setCap('ciscoPowerSupplies');
+            $data->{'ciscoPowerSupplies'} = [];
+            
+            my $prefixLen = length( $oidSupply ) + 1;
+            while( my( $oid, $val ) = each %{$supplyTable} )
+            {
+                # Extract the supply index from OID
+                my $sIndex = substr( $oid, $prefixLen );
+                
+                #check if the value is not notPresent(5)
+                if( $val != 5 )
+                {
+                    push( @{$data->{'ciscoPowerSupplies'}}, $sIndex );
+                }
+            }
+        }
+    }
+    
+    if( $devdetails->param('CiscoGeneric::disable-memory-pools') ne 'yes' )
+    {
+        my $eMemPool =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('cempMemPoolName') );
+        if( defined $eMemPool and scalar( %{$eMemPool} ) > 0 and
+            $devdetails->isDevType('RFC2737_ENTITY_MIB') )
+        {
+            $devdetails->storeSnmpVars( $eMemPool );
+            $devdetails->setCap('cempMemPool');
+            $data->{'cempMemPool'} = {};
+
+            foreach my $INDEX
+                ( $devdetails->
+                  getSnmpIndices($dd->oiddef('cempMemPoolName') ) )
+            {
+                # $INDEX is a pair entPhysicalIndex . cempMemPoolIndex
+                my ( $phyIndex, $poolIndex ) = split('\.', $INDEX);
+
+                my $poolName = $devdetails->
+                    snmpVar($dd->oiddef('cempMemPoolName') . '.' . $INDEX );
+
+                $poolName = 'Processor' unless $poolName;
+                
+                my $phyDescr = $data->{'entityPhysical'}{$phyIndex}{'descr'};
+                my $phyName = $data->{'entityPhysical'}{$phyIndex}{'name'};
+                
+                $phyDescr = 'Processor' unless $phyDescr;
+                $phyName = ('Chassis #' .
+                            $phyIndex) unless $phyName;
+               
+                $data->{'cempMemPool'}{$INDEX} = {
+                    'phyIndex'     => $phyIndex,
+                    'poolIndex'    => $poolIndex,
+                    'poolName'     => $poolName,                    
+                    'phyDescr' => $phyDescr,
+                    'phyName'  => $phyName
+                    };
+            }
+        }
+        else
+        {
+            my $MemoryPool =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef('ciscoMemoryPoolName') );
+
+            if( defined $MemoryPool and scalar( %{$MemoryPool} ) > 0 )
+            {
+                $devdetails->storeSnmpVars( $MemoryPool );
+                $devdetails->setCap('ciscoMemoryPool');
+                
+                $data->{'ciscoMemoryPool'} = {};
+                
+                foreach my $memType
+                    ( $devdetails->
+                      getSnmpIndices($dd->oiddef('ciscoMemoryPoolName')) )
+                {
+                    # According to CISCO-MEMORY-POOL-MIB, only types 1 to 5
+                    # are static, and the rest are dynamic
+                    # (of which none ever seen)
+                    if( $memType <= 5 )
+                    {
+                        my $name =
+                            $devdetails->
+                            snmpVar($dd->oiddef('ciscoMemoryPoolName') .
+                                    '.' . $memType );
+
+                        $data->{'ciscoMemoryPool'}{$memType} = $name;
+                    }
+                }
+            }
+        }
+    }
+
+    if( $devdetails->param('CiscoGeneric::disable-cpu-stats') ne 'yes' )
+    {
+        my $ciscoCpuStats =
+            $session->get_table( -baseoid => $dd->oiddef('cpmCPUTotalTable') );
+
+        if( defined $ciscoCpuStats )
+        {
+            $devdetails->setCap('ciscoCpuStats');
+            $devdetails->storeSnmpVars( $ciscoCpuStats );
+
+            $data->{'ciscoCpuStats'} = {};
+
+            # Find multiple CPU entries pointing to the same Phy index
+            my %phyReferers = ();            
+            foreach my $INDEX
+                ( $devdetails->
+                  getSnmpIndices($dd->oiddef('cpmCPUTotalPhysicalIndex') ) )
+            {
+                my $phyIndex = $devdetails->
+                    snmpVar($dd->oiddef('cpmCPUTotalPhysicalIndex') .
+                            '.' . $INDEX );
+                $phyReferers{$phyIndex}++;
+            }
+                
+            foreach my $INDEX
+                ( $devdetails->
+                  getSnmpIndices($dd->oiddef('cpmCPUTotalPhysicalIndex') ) )
+            {
+                $data->{'ciscoCpuStats'}{$INDEX} = {};
+
+                my $phyIndex = $devdetails->
+                    snmpVar($dd->oiddef('cpmCPUTotalPhysicalIndex') .
+                            '.' . $INDEX );
+                
+                my $phyDescr;
+                my $phyName;
+                
+                if( $phyIndex > 0 and
+                    $devdetails->isDevType('RFC2737_ENTITY_MIB') )
+                {
+                    $phyDescr = $data->{'entityPhysical'}{$phyIndex}{'descr'};
+                    $phyName = $data->{'entityPhysical'}{$phyIndex}{'name'};
+                }
+                
+                $phyDescr = 'Central Processor' unless $phyDescr;
+                $phyName = ('Chassis #' . $phyIndex) unless $phyName;
+                    ;
+                my $cpuNick = $phyName;
+                $cpuNick =~ s/^\///;
+                $cpuNick =~ s/\W/_/g;
+                $cpuNick =~ s/_+/_/g;
+
+                if( $phyReferers{$phyIndex} > 1 )
+                {
+                    $phyDescr .= ' (' . $INDEX . ')';
+                    $cpuNick .= '_' . $INDEX;
+                }
+                
+                $data->{'ciscoCpuStats'}{$INDEX} = {
+                    'phy-index'  => $phyIndex,
+                    'phy-name'   => $phyName,
+                    'phy-descr'  => $phyDescr,
+                    'phy-referers' => $phyReferers{$phyIndex},
+                    'cpu-nick'   => $cpuNick };
+                
+                if( $devdetails->hasOID( $dd->oiddef('cpmCPUTotal1minRev') .
+                                         '.' .  $INDEX ) )
+                {
+                    $data->{'ciscoCpuStats'}{$INDEX}{'stats-type'} = 'revised';
+                }
+            }
+        }
+        else
+        {
+            # Although OLD-CISCO-CPU-MIB is implemented in IOS only,
+            # it is easier to leave it here in Generic
+
+            if( $dd->checkSnmpOID('avgBusy1') )
+            {
+                $devdetails->setCap('old-ciscoCpuStats');
+                push( @{$data->{'templates'}}, 'CiscoGeneric::old-cisco-cpu' );
+            }
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    
+    my $data = $devdetails->data();
+
+    # Temperature Sensors
+
+    if( $devdetails->hasCap('ciscoTemperatureSensors') )
+    {
+        # Create a subtree for the sensors
+        my $subtreeName = 'Temperature_Sensors';
+
+        my $fahrenheit =
+            $devdetails->param('CiscoGeneric::use-fahrenheit') eq 'yes';
+
+        my $param = {
+            'node-display-name' => 'Temperature Sensors',
+        };
+        my $templates = [ 'CiscoGeneric::cisco-temperature-subtree' ];
+        
+        my $filePerSensor =
+            $devdetails->param('CiscoGeneric::file-per-sensor') eq 'yes';
+        
+        $param->{'data-file'} = '%snmp-host%_sensors' .
+            ($filePerSensor ? '_%sensor-index%':'') .
+            ($fahrenheit ? '_fahrenheit':'') . '.rrd';
+
+        my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName,
+                                           $param, $templates );
+        
+        foreach my $sIndex ( sort {$a<=>$b} keys
+                             %{$data->{'ciscoTemperatureSensors'}} )
+        {
+            my $leafName = sprintf( 'sensor_%.2d', $sIndex );
+
+            my $desc =
+                $data->{'ciscoTemperatureSensors'}{$sIndex}{'description'};
+            my $threshold =
+                $data->{'ciscoTemperatureSensors'}{$sIndex}{'threshold'};
+
+            if( $fahrenheit )
+            {
+                $threshold = $threshold * 1.8 + 32;
+            }
+
+            my $param = {
+                'sensor-index'       => $sIndex,
+                'sensor-description' => $desc,
+                'upper-limit'        => $threshold
+                };
+
+            my $templates = ['CiscoGeneric::cisco-temperature-sensor' .
+                             ($fahrenheit ? '-fahrenheit':'')];
+
+            my $monitor = $data->{'ciscoTemperatureSensors'}{$sIndex}->{
+                'selectorActions'}{'Monitor'};
+            if( defined( $monitor ) )
+            {
+                $param->{'monitor'} = $monitor;
+            }
+
+            my $tset = $data->{'ciscoTemperatureSensors'}{$sIndex}->{
+                'selectorActions'}{'TokensetMember'};
+            if( defined( $tset ) )
+            {
+                $param->{'tokenset-member'} = $tset;
+            }
+
+            $cb->addLeaf( $subtreeNode, $leafName, $param, $templates );
+        }
+    }
+
+    # Power supplies
+
+    if( $devdetails->hasCap('ciscoPowerSupplies') )
+    {
+        # Create a subtree for the power supplies
+        my $subtreeName = 'Power_Supplies';
+
+        my $param = {
+            'node-display-name' => 'Power Supplies',
+            'comment' => 'Power supplies status',
+            'precedence' => -600,
+        };
+        my $templates = [];
+                
+        $param->{'data-file'} = '%system-id%_power.rrd';
+
+        my $monitor = $devdetails->param('CiscoGeneric::power-monitor');
+        if( length( $monitor ) > 0 )
+        {
+            $param->{'monitor'} = $monitor;
+        }
+
+        my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName,
+                                           $param, $templates );
+        
+        foreach my $sIndex ( sort {$a<=>$b} @{$data->{'ciscoPowerSupplies'}} )
+        {
+            my $leafName = sprintf( 'power_%.2d', $sIndex );
+
+            my $param = {
+                'power-index'       => $sIndex
+                };
+
+            my $templates = ['CiscoGeneric::cisco-power-supply'];
+
+            $cb->addLeaf( $subtreeNode, $leafName, $param, $templates );
+        }
+    }
+
+    
+    # Memory Pools
+
+    if( $devdetails->hasCap('cempMemPool') or
+        $devdetails->hasCap('ciscoMemoryPool') )
+    {
+        my $subtreeName = 'Memory_Usage';
+
+        my $param = {
+            'node-display-name' => 'Memory Usage',
+            'precedence'        => '-100',
+            'comment'           => 'Router memory utilization'
+            };
+
+        my $subtreeNode =
+            $cb->addSubtree( $devNode, $subtreeName, $param,
+                             ['CiscoGeneric::cisco-memusage-subtree']);
+
+        if( $devdetails->hasCap('cempMemPool') )
+        {
+            foreach my $INDEX ( sort {
+                $data->{'cempMemPool'}{$a}{'phyIndex'} <=>
+                    $data->{'cempMemPool'}{$b}{'phyIndex'} or
+                    $data->{'cempMemPool'}{$a}{'poolIndex'} <=>
+                    $data->{'cempMemPool'}{$b}{'poolIndex'} }
+                                keys %{$data->{'cempMemPool'}} )
+            {
+                my $pool = $data->{'cempMemPool'}{$INDEX};
+
+                # Chop off the long chassis description, like
+                # uBR7246VXR chassis, Hw Serial#: XXXXX, Hw Revision: A
+                my $phyName = $pool->{'phyName'};                
+                if( $phyName =~ /chassis/ )
+                {
+                    $phyName =~ s/,.+//;
+                }
+                
+                my $poolSubtreeName =
+                    $phyName . '_' . $pool->{'poolName'};
+                $poolSubtreeName =~ s/^\///;
+                $poolSubtreeName =~ s/\W/_/g;
+                $poolSubtreeName =~ s/_+/_/g;
+                
+                my $param = {};
+
+                $param->{'comment'} =
+                    $pool->{'poolName'} . ' memory of ';
+                if( $pool->{'phyDescr'} eq $pool->{'phyName'} )
+                {
+                    $param->{'comment'} .= $phyName;
+                }
+                else
+                {
+                    $param->{'comment'} .= 
+                        $pool->{'phyDescr'} . ' in ' . $phyName;
+                }
+                
+                $param->{'mempool-index'} = $INDEX;
+                $param->{'mempool-phyindex'} = $pool->{'phyIndex'};
+                $param->{'mempool-poolindex'} = $pool->{'poolIndex'};
+                
+                $param->{'mempool-name'} =  $pool->{'poolName'};
+                $param->{'precedence'} =
+                    sprintf("%d", 1000 -
+                            $pool->{'phyIndex'} * 100 - $pool->{'poolIndex'});
+                
+                $cb->addSubtree( $subtreeNode, $poolSubtreeName, $param,
+                                 [ 'CiscoGeneric::cisco-enh-mempool' ]);
+            }
+        }
+        else
+        {
+            foreach my $memType
+                ( sort {$a<=>$b} keys %{$data->{'ciscoMemoryPool'}} )
+            {
+                my $poolName = $data->{'ciscoMemoryPool'}{$memType};
+                
+                my $poolSubtreeName = $poolName;
+                $poolSubtreeName =~ s/^\///;
+                $poolSubtreeName =~ s/\W/_/g;
+                $poolSubtreeName =~ s/_+/_/g;
+                
+                my $param = {
+                    'comment'      => 'Memory Pool: ' . $poolName,
+                    'mempool-type' => $memType,
+                    'mempool-name' => $poolName,
+                    'precedence'   => sprintf("%d", 1000 - $memType)
+                    };
+
+                $cb->addSubtree( $subtreeNode, $poolSubtreeName,
+                                 $param, [ 'CiscoGeneric::cisco-mempool' ]);
+            }
+        }
+    }
+
+    if( $devdetails->hasCap('ciscoCpuStats') )
+    {
+        my $subtreeName = 'CPU_Usage';
+        my $param = {
+            'node-display-name' => 'CPU Usage',
+            'precedence'         => '-500',
+            'comment'            => 'Overall CPU busy percentage'
+            };
+
+        my $subtreeNode =
+            $cb->addSubtree( $devNode, $subtreeName, $param,
+                             ['CiscoGeneric::cisco-cpu-usage-subtree']);
+        
+        foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'ciscoCpuStats'}} )
+        {
+            my $cpu = $data->{'ciscoCpuStats'}{$INDEX};
+
+            my $param = {
+                'comment' => $cpu->{'phy-descr'} . ' in ' . $cpu->{'phy-name'}
+                };
+
+            # On newer dual-CPU routers, several (two seen) CPU entries
+            # refer to the same physical entity. For such entries,
+            # we map them directly to cpmCPUTotalTable index.
+            if( $cpu->{'phy-referers'} > 1 )
+            {
+                $param->{'cisco-cpu-indexmap'} = $INDEX;
+                $param->{'cisco-cpu-ref'} = $INDEX;
+            }
+            else
+            {
+                $param->{'entity-phy-index'} = $cpu->{'phy-index'};
+                $param->{'cisco-cpu-ref'} = '%entity-phy-index%';
+            }
+            
+            my @templates;
+
+            if( $cpu->{'stats-type'} eq 'revised' )
+            {
+                push( @templates, 'CiscoGeneric::cisco-cpu-revised' );
+            }
+            else
+            {
+                push( @templates, 'CiscoGeneric::cisco-cpu' );
+            }
+            
+            my $cpuNode = $cb->addSubtree( $subtreeNode, $cpu->{'cpu-nick'},
+                                           $param, \@templates );
+            
+            my $tset = $cpu->{'selectorActions'}{'TokensetMember'};
+            if( defined( $tset ) )
+            {
+                $cb->addLeaf( $cpuNode, 'CPU_Total_1min',
+                              { 'tokenset-member' => $tset } );
+            }
+        }
+    }
+}
+
+
+
+#######################################
+# Selectors interface
+#
+
+$Torrus::DevDiscover::selectorsRegistry{'CiscoSensor'} = {
+    'getObjects'      => \&getSelectorObjects,
+    'getObjectName'   => \&getSelectorObjectName,
+    'checkAttribute'  => \&checkSelectorAttribute,
+    'applyAction'     => \&applySelectorAction,
+};
+
+$Torrus::DevDiscover::selectorsRegistry{'CiscoCPU'} = {
+    'getObjects'      => \&getSelectorObjects,
+    'getObjectName'   => \&getSelectorObjectName,
+    'checkAttribute'  => \&checkSelectorAttribute,
+    'applyAction'     => \&applySelectorAction,
+};
+
+## Objects are interface indexes
+
+sub getSelectorObjects
+{
+    my $devdetails = shift;
+    my $objType = shift;
+
+    my $data = $devdetails->data();
+    my @ret;
+    
+    if( $objType eq 'CiscoSensor' )
+    {
+        @ret = keys( %{$data->{'ciscoTemperatureSensors'}} );
+    }
+    elsif( $objType eq 'CiscoCPU' )
+    {
+        @ret = keys( %{$data->{'ciscoCpuStats'}} );
+    }
+
+    return( sort {$a<=>$b} @ret );
+}
+
+
+sub checkSelectorAttribute
+{
+    my $devdetails = shift;
+    my $object = shift;
+    my $objType = shift;
+    my $attr = shift;
+    my $checkval = shift;
+
+    my $data = $devdetails->data();
+    
+    my $value;
+    my $operator = '=~';
+    
+    if( $objType eq 'CiscoSensor' )
+    {
+        my $sensor = $data->{'ciscoTemperatureSensors'}{$object};
+        if( $attr eq 'SensorDescr' )
+        {
+            $value = $sensor->{'description'};
+        }
+        else
+        {
+            Error('Unknown CiscoSensor selector attribute: ' . $attr);
+            $value = '';
+        }
+    }
+    elsif( $objType eq 'CiscoCPU' )
+    {
+        my $cpu = $data->{'ciscoCpuStats'}{$object};
+        if( $attr eq 'CPUName' )
+        {
+            $value = $cpu->{'cpu-nick'};
+        }
+        elsif( $attr eq 'CPUDescr' )
+        {
+            $value = $cpu->{'cpu-descr'};
+        }
+        else
+        {
+            Error('Unknown CiscoCPU selector attribute: ' . $attr);
+            $value = '';
+        }        
+    }        
+    
+    return eval( '$value' . ' ' . $operator . '$checkval' ) ? 1:0;
+}
+
+
+sub getSelectorObjectName
+{
+    my $devdetails = shift;
+    my $object = shift;
+    my $objType = shift;
+    
+    my $data = $devdetails->data();
+    my $name;
+
+    if( $objType eq 'CiscoSensor' )
+    {
+        $name = $data->{'ciscoTemperatureSensors'}{$object}{'description'};
+    }
+    elsif( $objType eq 'CiscoCPU' )
+    {
+        $name = $data->{'ciscoCpuStats'}{$object}{'cpu-nick'};
+    }
+    return $name;
+}
+
+
+my %knownSelectorActions =
+    (
+     'CiscoSensor' => {
+         'Monitor' => 1,
+         'TokensetMember' => 1 },
+     'CiscoCPU' => {
+         'TokensetMember' => 1 }
+     );
+
+                            
+sub applySelectorAction
+{
+    my $devdetails = shift;
+    my $object = shift;
+    my $objType = shift;
+    my $action = shift;
+    my $arg = shift;
+
+    my $data = $devdetails->data();
+    my $objref;
+    if( $objType eq 'CiscoSensor' )
+    {
+        $objref = $data->{'ciscoTemperatureSensors'}{$object};
+    }
+    elsif( $objType eq 'CiscoCPU' )
+    {
+        $objref = $data->{'ciscoCpuStats'}{$object};
+    }
+    
+    if( $knownSelectorActions{$objType}{$action} )
+    {
+        $objref->{'selectorActions'}{$action} = $arg;
+    }
+    else
+    {
+        Error('Unknown Cisco selector action: ' . $action);
+    }
+}   
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoIOS.pm b/torrus/perllib/Torrus/DevDiscover/CiscoIOS.pm
new file mode 100644
index 000000000..6bd6d91c2
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CiscoIOS.pm
@@ -0,0 +1,687 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CiscoIOS.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Cisco IOS devices discovery
+# To do:
+#   SA Agent MIB
+#   DiffServ MIB
+
+package Torrus::DevDiscover::CiscoIOS;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CiscoIOS'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # CISCO-SMI
+     'ciscoProducts'                     => '1.3.6.1.4.1.9.1',
+     # CISCO-PRODUCTS-MIB
+     'ciscoLS1010'                       => '1.3.6.1.4.1.9.1.107',
+     # CISCO-IMAGE-MIB
+     'ciscoImageTable'                   => '1.3.6.1.4.1.9.9.25.1.1',
+     # CISCO-ENHANCED-IMAGE-MIB
+     'ceImageTable'                      => '1.3.6.1.4.1.9.9.249.1.1.1',
+     # OLD-CISCO-MEMORY-MIB
+     'bufferElFree'                      => '1.3.6.1.4.1.9.2.1.9.0',
+     # CISCO-IPSEC-FLOW-MONITOR-MIB
+     'cipSecGlobalHcInOctets'            => '1.3.6.1.4.1.9.9.171.1.3.1.4.0',
+     # CISCO-BGP4-MIB
+     'cbgpPeerAddrFamilyName'            => '1.3.6.1.4.1.9.9.187.1.2.3.1.3',
+     'cbgpPeerAcceptedPrefixes'          => '1.3.6.1.4.1.9.9.187.1.2.4.1.1',
+     'cbgpPeerPrefixAdminLimit'          => '1.3.6.1.4.1.9.9.187.1.2.4.1.3',
+     # CISCO-CAR-MIB
+     'ccarConfigTable'                   => '1.3.6.1.4.1.9.9.113.1.1.1',
+     'ccarConfigType'                    => '1.3.6.1.4.1.9.9.113.1.1.1.1.3',
+     'ccarConfigAccIdx'                  => '1.3.6.1.4.1.9.9.113.1.1.1.1.4',
+     'ccarConfigRate'                    => '1.3.6.1.4.1.9.9.113.1.1.1.1.5',
+     'ccarConfigLimit'                   => '1.3.6.1.4.1.9.9.113.1.1.1.1.6',
+     'ccarConfigExtLimit'                => '1.3.6.1.4.1.9.9.113.1.1.1.1.7',
+     'ccarConfigConformAction'           => '1.3.6.1.4.1.9.9.113.1.1.1.1.8',
+     'ccarConfigExceedAction'            => '1.3.6.1.4.1.9.9.113.1.1.1.1.9',
+     # CISCO-VPDN-MGMT-MIB
+     'cvpdnSystemTunnelTotal'            => '1.3.6.1.4.1.9.10.24.1.1.4.1.2'
+     );
+
+
+# Not all interfaces are normally needed to monitor.
+# You may override the interface filtering in devdiscover-siteconfig.pl:
+# redefine $Torrus::DevDiscover::CiscoIOS::interfaceFilter
+# or define $Torrus::DevDiscover::CiscoIOS::interfaceFilterOverlay
+
+our $interfaceFilter;
+our $interfaceFilterOverlay;
+my %ciscoInterfaceFilter;
+
+if( not defined( $interfaceFilter ) )
+{
+    $interfaceFilter = \%ciscoInterfaceFilter;
+}
+
+
+# Key is some unique symbolic name, does not mean anything
+# ifType is the number to match the interface type
+# ifDescr is the regexp to match the interface description
+%ciscoInterfaceFilter =
+    (
+     'Null0' => {
+         'ifType'  => 1,                      # other
+         'ifDescr' => '^Null'
+         },
+
+     'E1 N/N/N' => {
+         'ifType'  => 18,                     # ds1
+         'ifDescr' => '^E1'
+         },
+
+     'Virtual-AccessN' => {
+         'ifType'  => 23,                     # ppp
+         'ifDescr' => '^Virtual-Access'
+         },
+     
+     'DialerN' => {
+         'ifType'  => 23,                     # ppp
+         'ifDescr' => '^Dialer'
+         },
+
+     'LoopbackN'  => {
+         'ifType'  => 24,                     # softwareLoopback
+         'ifDescr' => '^Loopback'
+         },
+
+     'SerialN:N-Bearer Channel' => {
+         'ifType'  => 81,                     #  ds0, Digital Signal Level 0
+         'ifDescr' => '^Serial.*Bearer\s+Channel'
+         },
+
+     'Voice Encapsulation (POTS) Peer: N' => {
+         'ifType'  => 103                     # voiceEncap
+         },
+
+     'Voice Over IP Peer: N' => {
+         'ifType'  => 104                     # voiceOverIp
+         },
+
+     'ATMN/N/N.N-atm subif' => {
+         'ifType'  => 134,                    # atmSubInterface
+         'ifDescr' => '^ATM[0-9\/]+\.[0-9]+\s+subif'
+         },
+     
+     'BundleN' => {
+         'ifType'  => 127,                    # docsCableMaclayer
+         'ifDescr' => '^Bundle'
+         },
+
+     'EOBCN/N' => {
+         'ifType'  => 53,                     # propVirtual
+         'ifDescr' => '^EOBC'
+         },
+
+     'FIFON/N' => {
+         'ifType'  => 53,                     # propVirtual
+         'ifDescr' => '^FIFO'
+         },
+     );
+
+our %tunnelType =
+    (
+     # CISCO-VPDN-MGMT-MIB Tunnel Types
+     '1' => 'L2F',
+     '2' => 'L2TP',
+     '3' => 'PPTP'
+    );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'ciscoProducts',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+
+    my $session = $dd->session();
+    if( not $dd->checkSnmpTable('ciscoImageTable') )
+    {
+        if( $dd->checkSnmpTable('ceImageTable') )
+        {
+            # IOS XR has a new MIB for software image management
+            $devdetails->setCap('CiscoIOSXR');            
+        }
+        else
+        {
+            return 0;
+        }
+    }
+
+    # On some Layer3 switching devices, VlanXXX interfaces give some
+    # useful stats, while on others the stats are not relevant at all
+    
+    if( $devdetails->param('CiscoIOS::enable-vlan-interfaces') ne 'yes' )
+    {
+        $interfaceFilter->{'VlanN'} = {
+            'ifType'  => 53,                     # propVirtual
+            'ifDescr' => '^Vlan\d+'
+            };
+    }
+
+    # same thing with unrouted VLAN interfaces
+    if( $devdetails->param('CiscoIOS::enable-unrouted-vlan-interfaces')
+        ne 'yes' )
+    {
+        $interfaceFilter->{'unrouted VLAN N'} => {
+            'ifType'  => 53,                     # propVirtual
+            'ifDescr' => '^unrouted\s+VLAN\s+\d+'
+            };
+    }
+    
+    &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+        ($devdetails, $interfaceFilter);
+
+    if( defined( $interfaceFilterOverlay ) )
+    {
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilterOverlay);
+    }
+
+    $devdetails->setCap('interfaceIndexingManaged');
+
+    return 1;
+}
+
+
+my %ccarConfigType =
+    ( 1 => 'all',
+      2 => 'quickAcc',
+      3 => 'standardAcc' );
+
+my %ccarAction =
+    ( 1 => 'drop',
+      2 => 'xmit',
+      3 => 'continue',
+      4 => 'precedXmit',
+      5 => 'precedCont' );
+                      
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # Old mkroutercfg used cisco-interface-counters
+    if( $Torrus::DevDiscover::CiscoIOS::useCiscoInterfaceCounters )
+    {
+        foreach my $interface ( values %{$data->{'interfaces'}} )
+        {
+            $interface->{'hasHCOctets'} = 0;
+            $interface->{'hasOctets'} = 0;
+            push( @{$interface->{'templates'}},
+                  'CiscoIOS::cisco-interface-counters' );
+        }
+    }
+    else
+    {
+        # This is a well-known bug in IOS: HC counters are implemented,
+        # but always zero. We can catch this only for active interfaces.
+
+        foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+
+            if( $interface->{'hasHCOctets'} and
+                ( (
+                   $devdetails->snmpVar( $dd->oiddef('ifHCInOctets')
+                                         . '.' . $ifIndex ) == 0 and
+                   $devdetails->snmpVar( $dd->oiddef('ifInOctets')
+                                         . '.' . $ifIndex ) > 0
+                   )
+                  or
+                  (
+                   $devdetails->snmpVar( $dd->oiddef('ifHCOutOctets')
+                                         . '.' . $ifIndex ) == 0 and
+                   $devdetails->snmpVar( $dd->oiddef('ifOutOctets')
+                                         . '.' . $ifIndex ) > 0
+                   ) ) )
+            {
+                Debug('Disabling HC octets for ' . $ifIndex . ': ' .
+                      $interface->{'ifDescr'});
+
+                $interface->{'hasHCOctets'} = 0;
+                $interface->{'hasHCUcastPkts'} = 0;
+            }
+        }
+    }
+
+    if( $devdetails->param('CiscoIOS::enable-membuf-stats') eq 'yes' )
+    {
+        # Old Memory Buffers, if we have bufferElFree we assume
+        # the rest as they are "required"
+
+        if( $dd->checkSnmpOID('bufferElFree') )
+        {
+            $devdetails->setCap('old-ciscoMemoryBuffers');
+            push( @{$data->{'templates'}},
+                  'CiscoIOS::old-cisco-memory-buffers' );
+        }
+    }
+
+    if( $devdetails->param('CiscoIOS::disable-ipsec-stats') ne 'yes' )
+    {
+        if( $dd->checkSnmpOID('cipSecGlobalHcInOctets') )
+        {
+            $devdetails->setCap('ciscoIPSecGlobalStats');
+            push( @{$data->{'templates'}},
+                  'CiscoIOS::cisco-ipsec-flow-globals' );
+        }
+        
+        if( $dd->oidBaseMatch
+            ( 'ciscoLS1010',
+              $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+        {
+            $data->{'param'}{'snmp-oids-per-pdu'} = 10;
+        }
+    }
+
+    if( $devdetails->param('CiscoIOS::disable-bgp-stats') ne 'yes' )
+    {
+        my $peerTable =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('cbgpPeerAcceptedPrefixes') );
+        if( defined( $peerTable ) and scalar( %{$peerTable} ) > 0 )
+        {
+            $devdetails->storeSnmpVars( $peerTable );
+            $devdetails->setCap('CiscoBGP');
+
+            my $limitsTable =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef('cbgpPeerPrefixAdminLimit') );
+            $limitsTable = {} if not defined( $limitsTable );
+            
+            $data->{'cbgpPeers'} = {};
+            
+            # retrieve AS numbers for neighbor peers
+            Torrus::DevDiscover::RFC1657_BGP4_MIB::discover($dd, $devdetails);
+            
+            # list of indices for peers that are not IPv4 Unicast
+            my @nonV4Unicast;
+
+            # Number of peers for each AS
+            my %asNumbers;    
+
+            foreach my $INDEX
+                ( $devdetails->
+                  getSnmpIndices( $dd->oiddef('cbgpPeerAcceptedPrefixes') ) )
+            {
+                my ($a1, $a2, $a3, $a4, $afi, $safi) = split(/\./, $INDEX);
+                my $peerIP = join('.', $a1, $a2, $a3, $a4);
+
+                my $peer = {
+                    'peerIP' => $peerIP,
+                    'addrFamily' => 'IPv4 Unicast'
+                    };
+                
+                if( $afi != 1 and $safi != 1 )
+                {
+                    push( @nonV4Unicast, $INDEX );
+                }
+
+                my $desc =
+                    $devdetails->param('peer-ipaddr-description-' .
+                                       join('_', split('\.', $peerIP)));
+                if( length( $desc ) > 0 )
+                {
+                    $peer->{'description'} = $desc;
+                }        
+                
+                my $peerAS = $data->{'bgpPeerAS'}{$peerIP};
+                if( defined( $peerAS ) )
+                {
+                    $peer->{'peerAS'} = $data->{'bgpPeerAS'}{$peerIP};
+                    $asNumbers{$peer->{'peerAS'}}++;
+
+                    my $desc =
+                        $devdetails->param('bgp-as-description-' . $peerAS);
+                    if( length( $desc ) > 0 )
+                    {
+                        if( defined( $peer->{'description'} ) )
+                        {
+                            Warn('Conflicting descriptions for peer ' .
+                                 $peerIP);
+                        }
+                        $peer->{'description'} = $desc;
+                    }
+                }
+                else
+                {
+                    Error('Cannot find AS number for BGP peer ' . $peerIP);
+                    next;
+                }
+
+                if( defined( $peer->{'description'} ) )
+                {
+                    $peer->{'description'} .= ' ';
+                }
+                $peer->{'description'} .= '[' . $peerIP . ']';
+
+                $peer->{'prefixLimit'} =
+                    $limitsTable->{$dd->oiddef('cbgpPeerPrefixAdminLimit') .
+                                       '.' . $INDEX};
+                    
+                $data->{'cbgpPeers'}{$INDEX} = $peer;                
+            }
+
+            if( scalar( @nonV4Unicast ) > 0 )
+            {
+                my $addrFamTable =
+                    $session->get_table
+                    ( -baseoid => $dd->oiddef('cbgpPeerAddrFamilyName') );
+                
+                foreach my $INDEX ( @nonV4Unicast )
+                {
+                    my $peer = $data->{'cbgpPeers'}{$INDEX};
+
+                    my $fam = $addrFamTable->{
+                        $dd->oiddef('cbgpPeerAddrFamilyName') .
+                            '.' . $INDEX};
+
+                    $peer->{'addrFamily'} = $fam;
+                    $peer->{'otherAddrFamily'} = 1;
+                    $peer->{'description'} .= ' ' . $fam;
+                }
+            }
+
+            # Construct the subtree names from AS, peer IP, and address
+            # family
+            foreach my $INDEX ( keys %{$data->{'cbgpPeers'}} )
+            {
+                my $peer = $data->{'cbgpPeers'}{$INDEX};
+                
+                my $subtreeName = 'AS' . $peer->{'peerAS'};
+                if( $asNumbers{$peer->{'peerAS'}} > 1 )
+                {
+                    $subtreeName .= '_' . $peer->{'peerIP'};
+                }
+                
+                if( $peer->{'otherAddrFamily'} )
+                {
+                    my $fam = $data->{'cbgpPeers'}{$INDEX}{'addrFamily'};
+                    $fam =~ s/\W/_/g;
+                    $subtreeName .= '_' . $fam;
+                }
+                
+                $peer->{'subtreeName'} = $subtreeName;
+            }
+        }
+    }
+
+    
+    if( $devdetails->param('CiscoIOS::disable-car-stats') ne 'yes' )
+    {
+        my $carTable =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('ccarConfigTable') );
+        if( defined( $carTable ) and scalar( %{$carTable} ) > 0 )
+        {
+            $devdetails->storeSnmpVars( $carTable );
+            $devdetails->setCap('CiscoCAR');
+
+            $data->{'ccar'} = {};
+
+            foreach my $INDEX
+                ( $devdetails->
+                  getSnmpIndices( $dd->oiddef('ccarConfigType') ) )
+            {
+                my ($ifIndex, $dir, $carIndex) = split(/\./, $INDEX);
+                my $interface = $data->{'interfaces'}{$ifIndex};
+
+                my $car = {
+                    'ifIndex'   => $ifIndex,
+                    'direction' => $dir,
+                    'carIndex'  => $carIndex };
+
+                $car->{'configType'} =
+                    $ccarConfigType{ $carTable->{$dd->oiddef
+                                                     ('ccarConfigType') .
+                                                     '.' . $INDEX} };
+
+                $car->{'accIdx'} = $carTable->{$dd->oiddef
+                                                   ('ccarConfigAccIdx') .
+                                                   '.' . $INDEX};
+                
+                $car->{'rate'} = $carTable->{$dd->oiddef
+                                                 ('ccarConfigRate') .
+                                                 '.' . $INDEX};
+
+                
+                $car->{'limit'} = $carTable->{$dd->oiddef
+                                                  ('ccarConfigLimit') .
+                                                  '.' . $INDEX};
+                
+                $car->{'extLimit'} = $carTable->{$dd->oiddef
+                                                     ('ccarConfigExtLimit') .
+                                                     '.' . $INDEX};
+                $car->{'conformAction'} =
+                    $ccarAction{ $carTable->{$dd->oiddef
+                                                 ('ccarConfigConformAction') .
+                                                 '.' . $INDEX} };
+                
+                $car->{'exceedAction'} =
+                    $ccarAction{ $carTable->{$dd->oiddef
+                                                 ('ccarConfigExceedAction') .
+                                                 '.' . $INDEX} };
+
+                $data->{'ccar'}{$INDEX} = $car;
+            }
+        }
+    }
+
+
+    if( $devdetails->param('CiscoIOS::disable-vpdn-stats') ne 'yes' )
+    {
+        if( $dd->checkSnmpTable( 'cvpdnSystemTunnelTotal' ) )
+        {
+            # Find the Tunnel type
+            my $tableTun = $session->get_table(
+                            -baseoid => $dd->oiddef('cvpdnSystemTunnelTotal') );
+
+            if( $tableTun )
+            {
+                $devdetails->setCap('ciscoVPDN');
+
+                $devdetails->storeSnmpVars( $tableTun );
+
+                # VPDN indexing: 1: l2f, 2: l2tp, 3: pptp
+                foreach my $typeIndex (
+                            $devdetails->getSnmpIndices(
+                              $dd->oiddef('cvpdnSystemTunnelTotal') ) )
+                {
+                    Debug("CISCO-VPDN-MGMT-MIB: found Tunnel type " .
+                           $tunnelType{$typeIndex} );
+
+                    $data->{'ciscoVPDN'}{$typeIndex} = $tunnelType{$typeIndex};
+                }
+            }
+        }
+    }
+
+    if( $devdetails->param('CiscoIOS::short-device-comment') eq 'yes' )
+    {
+        # Remove serials from device comment
+        # 1841 chassis, Hw Serial#: 3625140487, Hw Revision: 6.0
+        
+        $data->{'param'}{'comment'} =~ s/, Hw.*//o;        
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    if( $devdetails->hasCap('CiscoBGP') )
+    {
+        my $countersNode =
+            $cb->addSubtree( $devNode, 'BGP_Prefixes',
+                             {
+                                 'node-display-name' => 'BGP Prefixes',
+                                 'comment' => 'Accepted prefixes',
+                             } );
+
+        foreach my $INDEX ( sort
+                            { $data->{'cbgpPeers'}{$a}{'subtreeName'} <=>
+                                  $data->{'cbgpPeers'}{$b}{'subtreeName'} }
+                            keys %{$data->{'cbgpPeers'}} )
+        {
+            my $peer = $data->{'cbgpPeers'}{$INDEX};
+
+            my $param = {
+                'peer-index'           => $INDEX,
+                'peer-ipaddr'          => $peer->{'peerIP'},
+                'comment'              => $peer->{'description'},
+                'descriptive-nickname' => $peer->{'subtreeName'},
+                'precedence'           => 65000 - $peer->{'peerAS'}
+            };
+
+            if( defined( $peer->{'prefixLimit'} ) and
+                $peer->{'prefixLimit'} > 0 )
+            {
+                $param->{'upper-limit'} = $peer->{'prefixLimit'};
+                $param->{'graph-upper-limit'} = $peer->{'prefixLimit'} * 1.03;
+            }
+            
+            $cb->addLeaf
+                ( $countersNode, $peer->{'subtreeName'}, $param,
+                  ['CiscoIOS::cisco-bgp'] );
+        }
+    }
+
+    
+    if( $devdetails->hasCap('CiscoCAR') )
+    {
+        my $countersNode =
+            $cb->addSubtree( $devNode, 'CAR_Stats', {
+                'comment' => 'Committed Access Rate statistics',
+                'node-display-name' => 'CAR', },
+                             ['CiscoIOS::cisco-car-subtree']);
+        
+        foreach my $INDEX ( sort keys %{$data->{'ccar'}} )
+        {
+            my $car = $data->{'ccar'}{$INDEX};
+            my $interface = $data->{'interfaces'}{$car->{'ifIndex'}};
+            
+            my $subtreeName =
+                $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+
+            $subtreeName .= ($car->{'direction'} == 1) ? '_IN':'_OUT';
+            if( $car->{'carIndex'} > 1 )
+            {
+                $subtreeName .= '_' . $car->{'carIndex'};
+            }
+               
+            my $param = {
+                'searchable' => 'yes',
+                'car-direction' => $car->{'direction'},
+                'car-index' => $car->{'carIndex'} };
+                
+            $param->{'interface-name'} =
+                $interface->{'param'}{'interface-name'};            
+            $param->{'interface-nick'} =
+                $interface->{'param'}{'interface-nick'};            
+            $param->{'comment'} =
+                $interface->{'param'}{'comment'};
+
+            my $legend = sprintf("Type: %s;", $car->{'configType'});
+            if( $car->{'accIdx'} > 0 )
+            {
+                $legend .= sprintf("Access list: %d;", $car->{'accIdx'});
+            }
+            
+            $legend .=
+                sprintf("Rate: %d bps; Limit: %d bytes; Ext limit: %d bytes;" .
+                        "Conform action: %s; Exceed action: %s",
+                        $car->{'rate'},
+                        $car->{'limit'},
+                        $car->{'extLimit'},
+                        $car->{'conformAction'},
+                        $car->{'exceedAction'});
+
+            $param->{'legend'} = $legend;
+
+            $cb->addSubtree
+                ( $countersNode,
+                  $subtreeName,
+                  $param, 
+                  ['CiscoIOS::cisco-car']);
+        }
+    }
+
+
+    if( $devdetails->hasCap('ciscoVPDN') )
+    { 
+        my $tunnelNode = $cb->addSubtree
+            ( $devNode, 'VPDN_Statistics',
+              {'node-display-name' => 'VPDN Statistics'},
+              [ 'CiscoIOS::cisco-vpdn-subtree' ] );
+
+        foreach my $INDEX ( sort keys %{$data->{'ciscoVPDN'}} )
+        {
+            my $tunnelProtocol = $data->{'ciscoVPDN'}{$INDEX};
+
+            $cb->addSubtree( $tunnelNode, $tunnelProtocol,
+                { 'comment'  => $tunnelProtocol . ' information',
+                  'tunIndex' => $INDEX,
+                  'tunFile'  => lc($tunnelProtocol) },
+                [ 'CiscoIOS::cisco-vpdn-leaf' ] );
+        }
+    }
+}
+
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoIOS_Docsis.pm b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_Docsis.pm
new file mode 100644
index 000000000..8118a6542
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_Docsis.pm
@@ -0,0 +1,285 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CiscoIOS_Docsis.pm,v 1.1 2010-12-27 00:03:46 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# DOCSIS interface, Cisco specific
+
+package Torrus::DevDiscover::CiscoIOS_Docsis;
+
+use strict;
+use Torrus::Log;
+
+# Sequence number is 600 - we depend on RFC2670_DOCS_IF and CiscoIOS
+
+$Torrus::DevDiscover::registry{'CiscoIOS_Docsis'} = {
+    'sequence'     => 600,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{
+    'DocsisMacModemsMonitor'} = 'CiscoIOS_Docsis';
+
+$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{
+    'DocsisUpUtilMonitor'} = 'CiscoIOS_Docsis';
+$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{
+    'DocsisUpSlotsMonitor'} = 'CiscoIOS_Docsis';
+
+
+our %oiddef =
+    (
+     # CISCO-DOCS-EXT-MIB:cdxIfUpstreamChannelExtTable
+     'cdxIfUpChannelMaxUGSLastFiveMins' => '1.3.6.1.4.1.9.9.116.1.4.1.1.14'
+     );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( $devdetails->isDevType('CiscoIOS') and
+        $devdetails->isDevType('RFC2670_DOCS_IF') )
+    {
+        return 1;
+    }
+
+    return 0;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    
+    if( $dd->checkSnmpTable( 'cdxIfUpChannelMaxUGSLastFiveMins' ) )
+    {
+        $devdetails->setCap('cdxIfUpChannelMaxUGSLastFiveMins');
+    }
+
+    push( @{$data->{'docsConfig'}{'docsCableMaclayer'}{'templates'}},
+          'CiscoIOS_Docsis::cisco-docsis-mac-subtree' );
+
+    foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        push( @{$interface->{'docsTemplates'}},
+              'CiscoIOS_Docsis::cisco-docsis-mac-util' );
+    }
+
+    foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        push( @{$interface->{'docsTemplates'}},
+              'CiscoIOS_Docsis::cisco-docsis-upstream-util' );
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    if( $devdetails->hasCap('cdxIfUpChannelMaxUGSLastFiveMins') )
+    {
+        $cb->setVar( $devNode, 'CiscoIOS_Docsis::ugs-supported', 'true' );
+    }
+
+    if( scalar( @{$data->{'docsCableMaclayer'}} ) > 0 )
+    {
+        # Build All_Modems summary graph
+        my $param = {
+            'ds-type'              => 'rrd-multigraph',
+            'ds-names'             => 'total,active,registered',
+            'graph-lower-limit'    => '0',
+            'precedence'           => '1000',
+            'comment'              =>
+                'Registered, Active and Total modems on CMTS',
+                
+                'vertical-label'       => 'Modems',
+                
+                'graph-legend-total'   => 'Total',
+                'line-style-total'     => '##totalresource',
+                'line-color-total'     => '##totalresource',
+                'line-order-total'     => '1',
+                
+                'graph-legend-active'  => 'Active',
+                'line-style-active'    => '##resourcepartusage',
+                'line-color-active'    => '##resourcepartusage',
+                'line-order-active'    => '2',
+                
+                'graph-legend-registered'  => 'Registered',
+                'line-style-registered'    => '##resourceusage',
+                'line-color-registered'    => '##resourceusage',
+                'line-order-registered'    => '3',
+                'descriptive-nickname'     => '%system-id%: All modems'
+            };
+        
+        my $first = 1;
+        foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            
+            my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+            
+            if( $first )
+            {
+                $param->{'ds-expr-total'} =
+                    '{' . $intf . '/Modems_Total}';
+                $param->{'ds-expr-active'} =
+                    '{' . $intf . '/Modems_Active}';
+                $param->{'ds-expr-registered'} =
+                    '{' . $intf . '/Modems_Registered}';
+                $first = 0;
+            }
+            else
+            {
+                $param->{'ds-expr-total'} .=
+                    ',{' . $intf . '/Modems_Total},+';
+                $param->{'ds-expr-active'} .=
+                    ',{' . $intf . '/Modems_Active},+';
+                $param->{'ds-expr-registered'} .=
+                    ',{' . $intf . '/Modems_Registered},+';
+            }
+        }
+
+        my $macNode =
+            $cb->getChildSubtree( $devNode,
+                                  $data->{'docsConfig'}{
+                                      'docsCableMaclayer'}{
+                                          'subtreeName'} );
+        if( defined( $macNode ) )
+        {
+            $cb->addLeaf( $macNode, 'All_Modems', $param, [] );
+        }
+        else
+        {
+            Error('Could not find the MAC layer subtree');
+            exit 1;
+        }
+        
+        # Apply selector actions
+        foreach my $ifIndex ( @{$data->{'docsCableMaclayer'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            
+            my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+            
+            my $monitor =
+                $interface->{'selectorActions'}{'DocsisMacModemsMonitor'};
+            if( defined( $monitor ) )
+            {
+                my $intfNode = $cb->getChildSubtree( $macNode, $intf );
+                $cb->addLeaf( $intfNode, 'Modems_Registered',
+                              {'monitor' => $monitor } );
+            }
+        }
+    }
+
+    if( scalar( @{$data->{'docsCableUpstream'}} ) > 0 )
+    {
+        my $upstrNode =
+            $cb->getChildSubtree( $devNode,
+                                  $data->{'docsConfig'}{'docsCableUpstream'}{
+                                      'subtreeName'} );
+        
+        foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            
+            my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+            
+            my $monitor =
+                $interface->{'selectorActions'}{'DocsisUpUtilMonitor'};
+            if( defined( $monitor ) )
+            {
+                my $intfNode = $cb->getChildSubtree( $upstrNode, $intf );
+                $cb->addLeaf( $intfNode, 'Util',
+                              {'monitor' => $monitor } );
+            }
+
+            $monitor =
+                $interface->{'selectorActions'}{'DocsisUpSlotsMonitor'};
+            if( defined( $monitor ) )
+            {
+                my $intfNode = $cb->getChildSubtree( $upstrNode, $intf );
+                $cb->addLeaf( $intfNode, 'ContSlots',
+                              {'monitor' => $monitor } );
+            }
+        }
+
+        # Override the overview shortcus defined in rfc2670.docsis-if.xml
+        
+        my $shortcuts = 'snr,fec,freq,modems,util';
+        if( $devdetails->hasCap('cdxIfUpChannelMaxUGSLastFiveMins') )
+        {
+            $shortcuts .= ',ugs';
+        }
+        
+        my $param = {        
+            'overview-shortcuts' =>
+                $shortcuts,
+                
+                'overview-subleave-name-modems' => 'Modems',
+                'overview-direct-link-modems' => 'yes',
+                'overview-direct-link-view-modems' => 'expanded-dir-html',
+                'overview-shortcut-text-modems' => 'All modems',
+                'overview-shortcut-title-modems'=>
+                'Show modem quantities in one page',
+                'overview-page-title-modems' => 'Modem quantities',
+                
+                'overview-subleave-name-util' => 'Util_Summary',
+                'overview-direct-link-util' => 'yes',
+                'overview-direct-link-view-util' => 'expanded-dir-html',
+                'overview-shortcut-text-util' => 'All utilization',
+                'overview-shortcut-title-util' => 'All upstream utilization',
+                'overview-page-title-util' => 'Upstream utilization',
+                
+                'overview-subleave-name-ugs' => 'Active_UGS',
+                'overview-direct-link-ugs' => 'yes',
+                'overview-direct-link-view-ugs' => 'expanded-dir-html',
+                'overview-shortcut-text-ugs' => 'All UGS',
+                'overview-shortcut-title-ugs' => 'Show all UGS in one page',
+                'overview-page-title-ugs' => 'UGS Statistics'
+            };
+
+        $cb->addParams( $upstrNode, $param );
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoIOS_MacAccounting.pm b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_MacAccounting.pm
new file mode 100644
index 000000000..841a5755c
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_MacAccounting.pm
@@ -0,0 +1,388 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CiscoIOS_MacAccounting.pm,v 1.1 2010-12-27 00:03:46 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Cisco IOS MAC accounting
+
+package Torrus::DevDiscover::CiscoIOS_MacAccounting;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CiscoIOS_MacAccounting'} = {
+    'sequence'     => 510,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # CISCO-IP-STAT-MIB
+     'cipMacHCSwitchedBytes'        => '1.3.6.1.4.1.9.9.84.1.2.3.1.2',
+     
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+
+    if( $devdetails->isDevType('CiscoIOS') and
+        $dd->checkSnmpTable('cipMacHCSwitchedBytes') )
+    {
+        return 1;
+    }
+    
+    return 0;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    my $table = $session->get_table( -baseoid =>
+                                     $dd->oiddef('cipMacHCSwitchedBytes'));
+    
+    if( not defined( $table ) or scalar( %{$table} ) == 0 )
+    {
+        return 0;
+    }
+    $devdetails->storeSnmpVars( $table );
+
+    # External storage serviceid assignment
+    my $extSrv =
+        $devdetails->param('CiscoIOS_MacAccounting::external-serviceid');
+    if( defined( $extSrv ) and length( $extSrv ) > 0 )
+    {
+        my $extStorage = {};
+        my $extStorageTrees = {};
+
+        foreach my $srvDef ( split( /\s*,\s*/, $extSrv ) )
+        {
+            my ( $serviceid, $peerName, $direction, $trees ) =
+                split( /\s*:\s*/, $srvDef );
+
+            if( defined( $trees ) )
+            {
+                # Trees are listed with '|' as separator,
+                # whereas compiler expects commas
+                
+                $trees =~ s/\s*\|\s*/,/g;
+            }
+            
+            if( $direction eq 'Both' )
+            {
+                $extStorage->{$peerName}{'In'} = $serviceid . '_IN';
+                $extStorageTrees->{$serviceid . '_IN'} = $trees;
+                
+                $extStorage->{$peerName}{'Out'} = $serviceid . '_OUT';
+                $extStorageTrees->{$serviceid . '_OUT'} = $trees;
+            }
+            else
+            {
+                $extStorage->{$peerName}{$direction} = $serviceid;
+                $extStorageTrees->{$serviceid} = $trees;
+            }
+        }
+        $data->{'cipMacExtStorage'} = $extStorage;
+        $data->{'cipMacExtStoragetrees'} = $extStorageTrees;
+    }
+
+
+    # tokenset members
+    # Format: tokenset:ASXXXX,ASXXXX; tokenset:ASXXXX,ASXXXX;
+    # Peer MAC or IP addresses could be used too
+    my $tsetMembership =
+        $devdetails->param('CiscoIOS_MacAccounting::tokenset-members');
+    if( defined( $tsetMembership ) and length( $tsetMembership ) > 0 )
+    {
+        my $tsetMember = {};
+        foreach my $memList ( split( /\s*;\s*/, $tsetMembership ) )
+        {
+            my ($tset, $list) = split( /\s*:\s*/, $memList );
+            foreach my $peerName ( split( /\s*,\s*/, $list ) )
+            {
+                $tsetMember->{$peerName}{$tset} = 1;
+            }
+        }
+        $data->{'cipTokensetMember'} = $tsetMember;
+    }
+    
+    Torrus::DevDiscover::RFC2011_IP_MIB::discover($dd, $devdetails);
+    Torrus::DevDiscover::RFC1657_BGP4_MIB::discover($dd, $devdetails);
+    
+    foreach my $INDEX
+        ( $devdetails->
+          getSnmpIndices( $dd->oiddef('cipMacHCSwitchedBytes') ) )
+    {
+        my( $ifIndex, $direction, @phyAddrOctets ) = split( '\.', $INDEX );
+
+        my $interface = $data->{'interfaces'}{$ifIndex};
+        next if not defined( $interface );
+
+        my $phyAddr = '0x';
+        my $macAddrString = '';
+        foreach my $byte ( @phyAddrOctets )
+        {
+            $phyAddr .= sprintf('%.2x', $byte);
+            if( length( $macAddrString ) > 0 )
+            {
+                $macAddrString .= ':';
+            }
+            $macAddrString .= sprintf('%.2x', $byte);
+        }
+
+        next if ( $phyAddr eq '0xffffffffffff' );
+        
+        my $peerIP = $interface->{'mediaToIpNet'}{$phyAddr};
+        if( not defined( $peerIP ) )
+        {
+            # Try in the global table, as the ARP is stored per subinterface,
+            # and MAC accounting is on main interface
+            $peerIP = $data->{'mediaToIpNet'}{$phyAddr};
+        }
+        
+        if( not defined( $peerIP ) )
+        {
+            # high logging level, because who cares about staled entries?
+            Debug('Cannot determine IP address for MAC accounting ' .
+                  'entry: ' . $macAddrString);            
+            next;
+        }
+
+        # There should be two entries per IP: in and out.
+        if( defined( $data->{'cipMac'}{$ifIndex . ':' . $phyAddr} ) )
+        {
+            $data->{'cipMac'}{$ifIndex . ':' . $phyAddr}{'nEntries'}++;
+            next;
+        }
+        
+        my $peer = {
+            'peerIP' => $peerIP,
+            'phyAddr' => $phyAddr,
+            'macAddrString' => $macAddrString,
+            'ifIndex' => $ifIndex,
+            'nEntries' => 1
+        };
+
+        $peer->{'macAddrOID'} = join('.', @phyAddrOctets);
+
+        $peer->{'ifReferenceName'} =
+            $interface->{$data->{'nameref'}{'ifReferenceName'}};
+        $peer->{'ifNick'} =
+            $interface->{$data->{'nameref'}{'ifNick'}};
+        
+        my $desc =
+            $devdetails->param('peer-ipaddr-description-' .
+                               join('_', split('\.', $peerIP)));
+        if( length( $desc ) > 0 )
+        {
+            $peer->{'description'} = $desc;
+        }        
+        
+        if( $devdetails->hasCap('bgpPeerTable') )
+        {
+            my $peerAS = $data->{'bgpPeerAS'}{$peerIP};
+            if( defined( $peerAS ) )
+            {
+                $peer->{'peerAS'} = $data->{'bgpPeerAS'}{$peerIP};
+                
+                my $desc =
+                    $devdetails->param('bgp-as-description-' . $peerAS);
+                if( length( $desc ) > 0 )
+                {
+                    if( defined( $peer->{'description'} ) )
+                    {
+                        Warn('Conflicting descriptions for peer ' .
+                             $peerIP);
+                    }
+                    $peer->{'description'} = $desc;
+                }
+            }
+            elsif( $devdetails->
+                    param('CiscoIOS_MacAccounting::bgponly') eq 'yes' )
+            {
+                next;
+            }
+        }
+
+        if( defined( $peer->{'description'} ) )
+        {
+            $peer->{'description'} .= ' ';
+        }
+        $peer->{'description'} .= '[' . $peerIP . ']';
+                    
+        $data->{'cipMac'}{$ifIndex . ':' . $phyAddr} = $peer;
+    }
+
+    my %asNumbers;    
+    foreach my $INDEX ( keys %{$data->{'cipMac'}} )
+    {        
+        my $peer = $data->{'cipMac'}{$INDEX};
+
+        if( $peer->{'nEntries'} != 2 )
+        {
+            delete $data->{'cipMac'}{$INDEX};
+        }
+        else
+        {
+            if( defined( $peer->{'peerAS'} ) )
+            {
+                $asNumbers{$peer->{'peerAS'}}++;
+            }
+        }
+    }
+    
+    foreach my $INDEX ( keys %{$data->{'cipMac'}} )
+    {
+        my $peer = $data->{'cipMac'}{$INDEX};
+        
+        my $subtreeName = $peer->{'peerIP'};
+        my $asNum = $peer->{'peerAS'};
+        if( defined( $asNum ) )
+        {
+            $subtreeName = 'AS' . $asNum; 
+            if( $asNumbers{$asNum} > 1 )
+            {
+                $subtreeName .= '_' . $peer->{'peerIP'};
+            }
+        }
+        $peer->{'subtreeName'} = $subtreeName;
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    my $countersNode =
+        $cb->addSubtree( $devNode, 'MAC_Accounting',
+                         {'node-display-name' => 'MAC Accounting'},
+                         ['CiscoIOS_MacAccounting::cisco-macacc-subtree']);
+    
+    foreach my $INDEX ( sort { $data->{'cipMac'}{$a}{'subtreeName'} <=>
+                                   $data->{'cipMac'}{$b}{'subtreeName'} }
+                        keys %{$data->{'cipMac'}} )
+    {
+        my $peer = $data->{'cipMac'}{$INDEX};
+    
+        my $param = {
+            'peer-macaddr'         => $peer->{'phyAddr'},
+            'peer-macoid'          => $peer->{'macAddrOID'},
+            'peer-ipaddr'          => $peer->{'peerIP'},
+            'interface-name'       => $peer->{'ifReferenceName'},
+            'interface-nick'       => $peer->{'ifNick'},
+            'comment'              => $peer->{'description'},
+            'descriptive-nickname' => $peer->{'subtreeName'},
+            'precedence'           => 65000 - $peer->{'peerAS'},
+            'searchable'           => 'yes'
+            };
+
+        my $peerNode = $cb->addSubtree
+            ( $countersNode, $peer->{'subtreeName'}, $param,
+              ['CiscoIOS_MacAccounting::cisco-macacc'] );
+
+        if( defined( $data->{'cipMacExtStorage'} ) or
+            defined( $data->{'cipTokensetMember'} ) )
+        {
+            my $extStorageApplied = 0;
+            my $tsetMemberApplied = 0;
+            
+            foreach my $peerName ( 'AS'.$peer->{'peerAS'}, $peer->{'peerIP'},
+                                   $peer->{'phyAddr'} )
+            {
+                if( defined( $peerName ) )
+                {
+                    if( not $extStorageApplied and
+                        defined( $data->{'cipMacExtStorage'}{$peerName} ) )
+                    {
+                        my $extStorage =
+                            $data->{'cipMacExtStorage'}{$peerName};
+                        foreach my $dir ( 'In', 'Out' )
+                        {
+                            if( defined( $extStorage->{$dir} ) )
+                            {
+                                my $serviceid = $extStorage->{$dir};
+                                
+                                my $params = {
+                                    'storage-type' => 'rrd,ext',
+                                    'ext-service-units' => 'bytes',
+                                    'ext-service-id' => $serviceid };
+                                
+                                if( defined( $data->{'cipMacExtStoragetrees'}{
+                                    $serviceid}) and
+                                    length( $data->{'cipMacExtStoragetrees'}{
+                                        $serviceid}) > 0 )
+                                {
+                                    $params->{'ext-service-trees'} =
+                                        $data->{'cipMacExtStoragetrees'}{
+                                            $serviceid};
+                                }
+                                
+                                $cb->addLeaf
+                                    ( $peerNode, 'Bytes_' . $dir,
+                                      $params );
+                            }
+                        }
+                        $extStorageApplied = 1;
+                    }
+
+                    if( not $tsetMemberApplied and
+                        defined( $data->{'cipTokensetMember'}{$peerName} ) )
+                    {
+                        my $tsetList =
+                            join( ',', sort keys
+                                  %{$data->{'cipTokensetMember'}{$peerName}} );
+
+                        $cb->addLeaf
+                            ( $peerNode, 'InOut_bps',
+                              { 'tokenset-member' => $tsetList } );
+                    }                        
+                }
+            }
+        }
+    }
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoIOS_SAA.pm b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_SAA.pm
new file mode 100644
index 000000000..6d136a93e
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CiscoIOS_SAA.pm
@@ -0,0 +1,382 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CiscoIOS_SAA.pm,v 1.1 2010-12-27 00:03:50 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Cisco IOS Service Assurance Agent
+# TODO:
+#   should really consider rtt-type and rtt-echo-protocol when applying
+#   per-rtt templates
+#
+#   translate TOS bits into DSCP values
+
+package Torrus::DevDiscover::CiscoIOS_SAA;
+
+use strict;
+use Socket qw(inet_ntoa);
+
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CiscoIOS_SAA'} = {
+    'sequence'     => 510,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # CISCO-RTTMON-MIB
+     'rttMonCtrlAdminTable'               => '1.3.6.1.4.1.9.9.42.1.2.1',
+     'rttMonCtrlAdminOwner'               => '1.3.6.1.4.1.9.9.42.1.2.1.1.2',
+     'rttMonCtrlAdminTag'                 => '1.3.6.1.4.1.9.9.42.1.2.1.1.3',
+     'rttMonCtrlAdminRttType'             => '1.3.6.1.4.1.9.9.42.1.2.1.1.4',
+     'rttMonCtrlAdminFrequency'           => '1.3.6.1.4.1.9.9.42.1.2.1.1.6',
+     'rttMonCtrlAdminStatus'              => '1.3.6.1.4.1.9.9.42.1.2.1.1.9',
+     'rttMonEchoAdminTable'               => '1.3.6.1.4.1.9.9.42.1.2.2',
+     'rttMonEchoAdminProtocol'            => '1.3.6.1.4.1.9.9.42.1.2.2.1.1',
+     'rttMonEchoAdminTargetAddress'       => '1.3.6.1.4.1.9.9.42.1.2.2.1.2',
+     'rttMonEchoAdminPktDataRequestSize'  => '1.3.6.1.4.1.9.9.42.1.2.2.1.3',
+     'rttMonEchoAdminTargetPort'          => '1.3.6.1.4.1.9.9.42.1.2.2.1.5',
+     'rttMonEchoAdminTOS'                 => '1.3.6.1.4.1.9.9.42.1.2.2.1.9',
+     'rttMonEchoAdminTargetAddressString' => '1.3.6.1.4.1.9.9.42.1.2.2.1.11',
+     'rttMonEchoAdminNameServer'          => '1.3.6.1.4.1.9.9.42.1.2.2.1.12',
+     'rttMonEchoAdminURL'                 => '1.3.6.1.4.1.9.9.42.1.2.2.1.15',
+     'rttMonEchoAdminInterval'            => '1.3.6.1.4.1.9.9.42.1.2.2.1.17',
+     'rttMonEchoAdminNumPackets'          => '1.3.6.1.4.1.9.9.42.1.2.2.1.18'
+     );
+
+
+
+our %adminInterpret =
+    (
+     'rttMonCtrlAdminOwner' => {
+         'order'   => 10,
+         'legend'  => 'Owner: %s;',
+         'param'   => 'rtt-owner'
+         },
+
+     'rttMonCtrlAdminTag' => {
+         'order'   => 20,
+         'legend'  => 'Tag: %s;',
+         'comment' => '%s: ',
+         'param'   => 'rtt-tag'
+         },
+
+     'rttMonCtrlAdminRttType' => {
+         'order'   => 30,
+         'legend'  => 'Type: %s;',
+         'translate' => \&translateRttType,
+         'param'   => 'rtt-type'
+         },
+
+     'rttMonCtrlAdminFrequency' => {
+         'order'   => 40,
+         'legend'  => 'Frequency: %d seconds;',
+         'param'   => 'rtt-frequency'
+         },
+
+     'rttMonEchoAdminProtocol' => {
+         'order'   => 50,
+         'legend'  => 'Protocol: %s;',
+         'translate' => \&translateRttEchoProtocol,
+         'param'   => 'rtt-echo-protocol'
+         },
+
+     'rttMonEchoAdminTargetAddress' => {
+         'order'   => 60,
+         'legend'  => 'Target: %s;',
+         'comment' => 'Target=%s ',
+         'translate' => \&translateRttTargetAddr,
+         'param'   => 'rtt-echo-target-addr',
+         'ignore-text' => '0.0.0.0'
+         },
+
+     'rttMonEchoAdminPktDataRequestSize' => {
+         'order'   => 70,
+         'legend'  => 'Packet size: %d octets;',
+         'param'   => 'rtt-echo-request-size'
+         },
+
+     'rttMonEchoAdminTargetPort' => {
+         'order'   => 80,
+         'legend'  => 'Port: %d;',
+         'param'   => 'rtt-echo-port',
+         'ignore-numeric' => 0
+         },
+
+     'rttMonEchoAdminTOS' => {
+         'order'   => 90,
+         'legend'  => 'TOS: %d;',
+         'comment' => 'TOS=%d ',
+         'param'   => 'rtt-echo-tos',
+         'ignore-numeric' => 0
+         },
+
+     'rttMonEchoAdminTargetAddressString' => {
+         'order'   => 100,
+         'legend'  => 'Address string: %s;',
+         'param'   => 'rtt-echo-addr-string'
+         },
+
+     'rttMonEchoAdminNameServer' => {
+         'order'   => 110,
+         'legend'  => 'NameServer: %s;',
+         'translate' => \&translateRttTargetAddr,
+         'param'   => 'rtt-echo-name-server',
+         'ignore-text' => '0.0.0.0'
+         },
+
+     'rttMonEchoAdminURL' => {
+         'order'   => 120,
+         'legend'  => 'URL: %s;',
+         'param'   => 'rtt-echo-url'
+         },
+
+     'rttMonEchoAdminInterval' => {
+         'order'   => 130,
+         'legend'  => 'Interval: %d milliseconds;',
+         'param'   => 'rtt-echo-interval',
+         'ignore-numeric' => 0
+         },
+
+     'rttMonEchoAdminNumPackets' => {
+         'order'   => 140,
+         'legend'  => 'Packets: %d;',
+         'param'   => 'rtt-echo-num-packets',
+         'ignore-numeric' => 0
+         }
+     );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+
+    if( $devdetails->isDevType('CiscoIOS') )
+    {
+        my $rttAdminTable =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('rttMonCtrlAdminTable') );
+        if( defined $rttAdminTable and scalar( %{$rttAdminTable} ) > 0 )
+        {
+            $devdetails->storeSnmpVars( $rttAdminTable );
+            return 1;
+        }
+    }
+
+    return 0;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    my $rttEchoAdminTable =
+        $session->get_table( -baseoid =>
+                             $dd->oiddef('rttMonEchoAdminTable') );
+    if( defined $rttEchoAdminTable )
+    {
+        $devdetails->storeSnmpVars( $rttEchoAdminTable );
+        undef $rttEchoAdminTable;
+    }
+
+    $data->{'rtt_entries'} = {};
+
+    foreach my $rttIndex
+        ( $devdetails->getSnmpIndices( $dd->oiddef('rttMonCtrlAdminOwner') ) )
+    {
+        # we're interested in Active agents only
+        if( $devdetails->snmpVar($dd->oiddef('rttMonCtrlAdminStatus') .
+                                 '.' . $rttIndex) != 1 )
+        {
+            next;
+        }
+
+        my $ref = {};
+        $data->{'rtt_entries'}{$rttIndex} = $ref;
+        $ref->{'param'} = {};
+
+        my $comment = '';
+        my $legend = '';
+
+        foreach my $adminField
+            ( sort {$adminInterpret{$a}{'order'} <=>
+                        $adminInterpret{$b}{'order'}}
+              keys %adminInterpret )
+        {
+            my $value = $devdetails->snmpVar( $dd->oiddef( $adminField ) .
+                                              '.' . $rttIndex );
+            if( defined( $value ) and length( $value ) > 0 )
+            {
+                my $intrp = $adminInterpret{$adminField};
+                if( ref( $intrp->{'translate'} ) )
+                {
+                    $value = &{$intrp->{'translate'}}( $value );
+                }
+
+                if( ( defined( $intrp->{'ignore-numeric'} ) and
+                      $value == $intrp->{'ignore-numeric'} )
+                    or
+                    ( defined( $intrp->{'ignore-text'} ) and
+                      $value eq $intrp->{'ignore-text'} ) )
+                {
+                    next;
+                }
+
+                if( defined( $intrp->{'param'} ) )
+                {
+                    $ref->{'param'}{$intrp->{'param'}} = $value;
+                }
+
+                if( defined( $intrp->{'comment'} ) )
+                {
+                    $comment .= sprintf( $intrp->{'comment'}, $value );
+                }
+
+                if( defined( $intrp->{'legend'} ) )
+                {
+                    $legend .= sprintf( $intrp->{'legend'}, $value );
+                }
+            }
+        }
+
+        $ref->{'param'}{'rtt-index'} = $rttIndex;
+        $ref->{'param'}{'comment'} = $comment;
+        $ref->{'param'}{'legend'} = $legend;
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    my $subtreeNode =
+        $cb->addSubtree( $devNode, 'SAA', undef,
+                         ['CiscoIOS_SAA::cisco-saa-subtree']);
+
+    foreach my $rttIndex ( sort {$a<=>$b} keys %{$data->{'rtt_entries'}} )
+    {
+        my $subtreeName = 'rtt_' . $rttIndex;
+        my $param = $data->{'rtt_entries'}{$rttIndex}{'param'};
+        $param->{'precedence'} = sprintf('%d', 10000 - $rttIndex);
+
+        # TODO: should really consider rtt-type and rtt-echo-protocol
+
+        $cb->addSubtree( $subtreeNode, $subtreeName, $param,
+                         ['CiscoIOS_SAA::cisco-rtt-echo-subtree']);
+    }
+}
+
+
+our %rttType =
+    (
+     '1'  => 'echo',
+     '2'  => 'pathEcho',
+     '3'  => 'fileIO',
+     '4'  => 'script',
+     '5'  => 'udpEcho',
+     '6'  => 'tcpConnect',
+     '7'  => 'http',
+     '8'  => 'dns',
+     '9'  => 'jitter',
+     '10' => 'dlsw',
+     '11' => 'dhcp',
+     '12' => 'ftp'
+     );
+
+sub translateRttType
+{
+    my $value = shift;
+    return $rttType{$value};
+}
+
+
+our %rttEchoProtocol =
+    (
+     '1'   =>  'notApplicable',
+     '2'   =>  'ipIcmpEcho',
+     '3'   =>  'ipUdpEchoAppl',
+     '4'   =>  'snaRUEcho',
+     '5'   =>  'snaLU0EchoAppl',
+     '6'   =>  'snaLU2EchoAppl',
+     '7'   =>  'snaLU62Echo',
+     '8'   =>  'snaLU62EchoAppl',
+     '9'   =>  'appleTalkEcho',
+     '10'  =>  'appleTalkEchoAppl',
+     '11'  =>  'decNetEcho',
+     '12'  =>  'decNetEchoAppl',
+     '13'  =>  'ipxEcho',
+     '14'  =>  'ipxEchoAppl',
+     '15'  =>  'isoClnsEcho',
+     '16'  =>  'isoClnsEchoAppl',
+     '17'  =>  'vinesEcho',
+     '18'  =>  'vinesEchoAppl',
+     '19'  =>  'xnsEcho',
+     '20'  =>  'xnsEchoAppl',
+     '21'  =>  'apolloEcho',
+     '22'  =>  'apolloEchoAppl',
+     '23'  =>  'netbiosEchoAppl',
+     '24'  =>  'ipTcpConn',
+     '25'  =>  'httpAppl',
+     '26'  =>  'dnsAppl',
+     '27'  =>  'jitterAppl',
+     '28'  =>  'dlswAppl',
+     '29'  =>  'dhcpAppl',
+     '30'  =>  'ftpAppl'
+     );
+
+sub translateRttEchoProtocol
+{
+    my $value = shift;
+    return $rttEchoProtocol{$value};
+}
+
+sub translateRttTargetAddr
+{
+    my $value = shift;
+    $value =~ s/^0x//;
+    return inet_ntoa( pack( 'H8', $value ) );
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoSCE.pm b/torrus/perllib/Torrus/DevDiscover/CiscoSCE.pm
new file mode 100644
index 000000000..e9d200347
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CiscoSCE.pm
@@ -0,0 +1,418 @@
+#
+#  Discovery module for Cisco Service Control Engine (formely PCube)
+#
+#  Copyright (C) 2007 Jon Nistor
+#  Copyright (C) 2007 Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CiscoSCE.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $
+# Jon Nistor <nistor at snickers dot org>
+#
+# NOTE: Options for this module
+#       CiscoSCE::disable-disk
+#       CiscoSCE::disable-gc
+#       CiscoSCE::disable-qos
+#       CiscoSCE::disable-rdr
+#       CiscoSCE::disable-subs
+#       CiscoSCE::disable-tp
+#
+
+# Cisco SCE devices discovery
+package Torrus::DevDiscover::CiscoSCE;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CiscoSCE'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+};
+
+# pmodule-dependend OIDs are presented for module #1 only.
+# currently devices with more than one module do not exist
+
+our %oiddef =
+    (
+     # PCUBE-SE-MIB
+     'pcubeProducts'        => '1.3.6.1.4.1.5655.1',
+     'pchassisSysType'      => '1.3.6.1.4.1.5655.4.1.2.1.0',
+     'pchassisNumSlots'     => '1.3.6.1.4.1.5655.4.1.2.6.0',
+     'pmoduleType'          => '1.3.6.1.4.1.5655.4.1.3.1.1.2.1',
+     'pmoduleNumLinks'      => '1.3.6.1.4.1.5655.4.1.3.1.1.7.1',
+     'pmoduleSerialNumber'  => '1.3.6.1.4.1.5655.4.1.3.1.1.9.1',
+     'pmoduleNumTrafficProcessors'   => '1.3.6.1.4.1.5655.4.1.3.1.1.3.1',
+     'rdrFormatterEnable'            => '1.3.6.1.4.1.5655.4.1.6.1.0',
+     'rdrFormatterCategoryName'      => '1.3.6.1.4.1.5655.4.1.6.11.1.2',
+     'subscribersNumIpAddrMappings'  => '1.3.6.1.4.1.5655.4.1.8.1.1.3.1',
+     'subscribersNumIpRangeMappings' => '1.3.6.1.4.1.5655.4.1.8.1.1.5.1',
+     'subscribersNumVlanMappings'    => '1.3.6.1.4.1.5655.4.1.8.1.1.7.1',
+     'subscribersNumAnonymous'       => '1.3.6.1.4.1.5655.4.1.8.1.1.16.1',
+     'pportNumTxQueues'     => '1.3.6.1.4.1.5655.4.1.10.1.1.4.1',
+     'pportIfIndex'         => '1.3.6.1.4.1.5655.4.1.10.1.1.5.1',
+     'txQueuesDescription'  => '1.3.6.1.4.1.5655.4.1.11.1.1.4.1',
+
+     # CISCO-SCAS-BB-MIB (PCUBE-ENGAGE-MIB)
+     'globalScopeServiceCounterName' => '1.3.6.1.4.1.5655.4.2.5.1.1.3.1',
+     
+    );
+
+our %sceChassisNames =
+    (
+     '1'    => 'unknown',
+     '2'    => 'SE 1000',
+     '3'    => 'SE 100',
+     '4'    => 'SE 2000',
+    );
+
+our %sceModuleDesc =
+    (
+     '1'    => 'unknown',
+     '2'    => '2xGBE + 1xFE Mgmt',
+     '3'    => '2xFE + 1xFE Mgmt',
+     '4'    => '4xGBE + 1 or 2 FastE Mgmt',
+     '5'    => '4xFE + 1xFE Mgmt',
+     '6'    => '4xOC-12 + 1 or 2 FastE Mgmt',
+     '7'    => '16xFE + 2xGBE, 2 FastE Mgmt',
+    );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'pcubeProducts',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+    
+    my $result = $dd->retrieveSnmpOIDs('pchassisNumSlots');
+    if( $result->{'pchassisNumSlots'} > 1 )
+    {
+        Error('This SCE device has more than one module on the chassis.' .
+              'The current version of DevDiscover does not support such ' .
+              'devices');
+        return 0;
+    }
+    
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # Get the system info and display it in the comment
+    my $sceInfo = $dd->retrieveSnmpOIDs
+        ( 'pchassisSysType', 'pmoduleType', 'pmoduleNumLinks',
+          'pmoduleSerialNumber', 'pmoduleNumTrafficProcessors',
+          'rdrFormatterEnable',
+          'subscribersNumIpAddrMappings', 'subscribersNumIpRangeMappings',
+          'subscribersNumVlanMappings', 'subscribersNumAnonymous' );
+
+    $data->{'sceInfo'} = $sceInfo;
+    
+    $data->{'param'}{'comment'} =
+        $sceChassisNames{$sceInfo->{'pchassisSysType'}} .
+        " chassis, " . $sceModuleDesc{$sceInfo->{'pmoduleType'}} .
+        ", Hw Serial#: " . $sceInfo->{'pmoduleSerialNumber'};
+    
+    # TP: Traffic Processor
+    if( $devdetails->param('CiscoSCE::disable-tp') ne 'yes' )
+    { 
+        $devdetails->setCap('sceTP');
+
+        $data->{'sceTrafficProcessors'} =
+            $sceInfo->{'pmoduleNumTrafficProcessors'};
+    }
+
+    # HDD: Disk Usage
+    if( $devdetails->param('CiscoSCE::disable-disk') ne 'yes' )
+    {
+        $devdetails->setCap('sceDisk');
+    }
+
+    # SUBS: subscriber aware configuration
+    if( $devdetails->param('CiscoSCE::disable-subs') ne 'yes' )
+    {
+        if( $sceInfo->{'subscribersNumIpAddrMappings'}  > 0 or
+            $sceInfo->{'subscribersNumIpRangeMappings'} > 0 or
+            $sceInfo->{'subscribersNumVlanMappings'}    > 0 or
+            $sceInfo->{'subscribersNumAnonymous'}       > 0 )
+        {
+            $devdetails->setCap('sceSubscribers');
+        }
+    }
+    
+    
+    # QOS: TX Queues Names
+    if( $devdetails->param('CiscoSCE::disable-qos') ne 'yes' )
+    { 
+        $devdetails->setCap('sceQos');
+
+        # Get the names of TX queues
+        my $txQueueNum = $session->get_table
+            ( -baseoid => $dd->oiddef('pportNumTxQueues') );
+        $devdetails->storeSnmpVars( $txQueueNum );
+        
+        my $ifIndexTable = $session->get_table
+            ( -baseoid => $dd->oiddef('pportIfIndex') );
+
+        my $txQueueDesc = $session->get_table
+            ( -baseoid => $dd->oiddef('txQueuesDescription') );
+        
+        $devdetails->storeSnmpVars( $txQueueDesc );
+        
+        foreach my $pIndex
+            ( $devdetails->getSnmpIndices( $dd->oiddef('pportNumTxQueues') ) )
+        {
+            # We take ports with more than one queue and add queueing
+            # statistics to interface counters
+            if( $txQueueNum->{$dd->oiddef('pportNumTxQueues') .
+                                  '.' . $pIndex} > 1 )
+            {
+                # We need the ifIndex to retrieve the interface name
+                
+                my $ifIndex =
+                    $ifIndexTable->{$dd->oiddef('pportIfIndex') . '.'
+                                        . $pIndex};
+
+                $data->{'scePortIfIndex'}{$pIndex} = $ifIndex;
+                
+                foreach my $qIndex
+                    ( $devdetails->getSnmpIndices
+                      ( $dd->oiddef('txQueuesDescription') . '.' . $pIndex ) )
+                {
+                    my $oid = $dd->oiddef('txQueuesDescription') . '.' .
+                        $pIndex . '.' . $qIndex;
+                    
+                    $data->{'sceQueues'}{$pIndex}{$qIndex} =
+                        $txQueueDesc->{$oid};
+                }
+            }
+        }
+    }
+
+
+    # GC: Global Service Counters
+    if( $devdetails->param('CiscoSCE::disable-gc') ne 'yes' )
+    {
+        # Set the Capability for the Global Counters
+        $devdetails->setCap('sceGlobalCounters');
+
+        my $counterNames = $session->get_table
+            ( -baseoid => $dd->oiddef('globalScopeServiceCounterName') );
+        
+        $devdetails->storeSnmpVars( $counterNames );
+        
+        foreach my $gcIndex
+            ( $devdetails->getSnmpIndices
+              ( $dd->oiddef('globalScopeServiceCounterName') ) )
+        {
+            my $oid =
+                $dd->oiddef('globalScopeServiceCounterName') . '.' . $gcIndex;
+            if( length( $counterNames->{$oid} ) > 0 )
+            {
+                $data->{'sceGlobalCounters'}{$gcIndex} = $counterNames->{$oid};
+            }
+        }
+    }
+
+
+    # RDR: Raw Data Record
+    if( $devdetails->param('CiscoSCE::disable-rdr') ne 'yes' )
+    {   
+        if( $sceInfo->{'rdrFormatterEnable'} > 0 )
+        {
+            # Set Capability for the RDR section of XML
+            $devdetails->setCap('sceRDR');
+            
+            # Get the names of the RDR Category
+            my $categoryNames = $session->get_table
+                ( -baseoid => $dd->oiddef('rdrFormatterCategoryName') );
+            
+            $devdetails->storeSnmpVars( $categoryNames );
+            
+            foreach my $categoryIndex
+                ( $devdetails->getSnmpIndices
+                  ( $dd->oiddef('rdrFormatterCategoryName') ) )
+            {
+                my $oid = $dd->oiddef('rdrFormatterCategoryName') . '.'
+                    . $categoryIndex;
+                $data->{'sceRDR'}{$categoryIndex} = $categoryNames->{$oid};
+            }
+        }
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    # Disk Usage information
+    if( $devdetails->hasCap('sceDisk') )
+    {
+        $cb->addTemplateApplication($devNode, 'CiscoSCE::cisco-sce-disk');
+    }
+
+    if( $devdetails->hasCap('sceSubscribers') )
+    {
+        $cb->addTemplateApplication($devNode,
+                                    'CiscoSCE::cisco-sce-subscribers');
+    }
+
+    # Traffic processors subtree
+    if( $devdetails->hasCap('sceTP') )
+    {   
+        my $tpNode = $cb->addSubtree( $devNode, 'SCE_TrafficProcessors',
+                                      { 'comment' => 'TP usage statistics' },
+                                      [ 'CiscoSCE::cisco-sce-tp-subtree']);
+
+        foreach my $tp ( 1 .. $data->{'sceTrafficProcessors'} )
+        {
+            $cb->addSubtree( $tpNode, sprintf('TP_%d', $tp),
+                             { 'sce-tp-index' => $tp },
+                             ['CiscoSCE::cisco-sce-tp'] );
+        }
+    }
+
+
+    # QoS queues
+    if( $devdetails->hasCap('sceQos') )
+    { 
+        # Queues subtree
+        my $qNode =
+            $cb->addSubtree( $devNode, 'SCE_Queues',
+                             { 'comment' => 'TX queues usage statistics' },
+                             [ 'CiscoSCE::cisco-sce-queues-subtree']);
+        
+        foreach my $pIndex ( sort {$a <=> $b}
+                             keys %{$data->{'scePortIfIndex'}} )
+        {
+            my $ifIndex = $data->{'scePortIfIndex'}{$pIndex};
+            my $interface = $data->{'interfaces'}{$ifIndex};
+
+            my $portNode =
+                $cb->addSubtree
+                ( $qNode,
+                  $interface->{$data->{'nameref'}{'ifSubtreeName'}},
+                  { 'sce-port-index' => $pIndex,
+                    'precedence' => 1000 - $pIndex });
+            
+            foreach my $qIndex ( sort {$a <=> $b} keys 
+                                 %{$data->{'sceQueues'}{$pIndex}} )
+            {
+                my $qName = $data->{'sceQueues'}{$pIndex}{$qIndex};
+                my $subtreeName = 'Q' . $qIndex;
+                
+                $cb->addLeaf( $portNode, $subtreeName,
+                              { 'sce-queue-index' => $qIndex,
+                                'comment' => $qName,
+                                'precedence' => 1000 - $qIndex });
+            }
+        }
+    } # hasCap sceQos
+
+
+    # Global counters
+    if( $devdetails->hasCap('sceGlobalCounters') )
+    {
+        foreach my $linkIndex ( 1 .. $data->{'sceInfo'}{'pmoduleNumLinks'} )
+        {
+            my $gcNode =
+                $cb->addSubtree( $devNode,
+                                 'SCE_Global_Counters_L' . $linkIndex,
+                                 { 'comment' =>
+                                       'Global service counters for link #'
+                                       . $linkIndex
+                                 },
+                                 [ 'CiscoSCE::cisco-sce-gc-subtree']);
+            
+            foreach my $gcIndex
+                ( sort {$a <=> $b} keys %{$data->{'sceGlobalCounters'}} )
+            {
+                my $srvName = $data->{'sceGlobalCounters'}{$gcIndex};
+                my $subtreeName = $srvName;
+                $subtreeName =~ s/\W/_/g;
+                
+                $cb->addSubtree( $gcNode, $subtreeName,
+                                 { 'sce-link-index'   => $linkIndex,
+                                   'sce-gc-index'     => $gcIndex,
+                                   'comment'          => $srvName,
+                                   'sce-service-name' => $srvName,
+                                   'precedence'       => 1000 - $gcIndex,
+                                   'searchable'       => 'yes'},
+                                 [ 'CiscoSCE::cisco-sce-gcounter' ]);
+            }
+        }
+    } # END hasCap sceGlobalCounters
+
+
+    # RDR Formatter reports
+    if( $devdetails->hasCap('sceRDR') )
+    {
+        $cb->addTemplateApplication($devNode, 'CiscoSCE::cisco-sce-rdr');
+
+        # Add a Subtree for "SCE_RDR_Categories"
+        my $rdrNode =
+            $cb->addSubtree( $devNode, 'SCE_RDR_Categories',
+                             { 'comment' => 'Raw Data Records per Category' },
+                             [ 'CiscoSCE::cisco-sce-rdr-category-subtree' ]);
+        
+        foreach my $cIndex ( sort {$a <=> $b} keys %{$data->{'sceRDR'}} )
+        {
+            my $categoryName;
+            if ( $data->{'sceRDR'}{$cIndex} )
+            {
+                $categoryName = $data->{'sceRDR'}{$cIndex};
+            }
+            else
+            {
+                $categoryName = 'Category_' . $cIndex;
+            }
+            
+            $cb->addSubtree( $rdrNode, 'Category_' . $cIndex,
+                             { 'precedence'      => 1000 - $cIndex,
+                               'sce-rdr-index'   => $cIndex,
+                               'sce-rdr-comment' => $categoryName },
+                             ['CiscoSCE::cisco-sce-rdr-category'] );
+        }
+    } # END hasCap sceRDR    
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CiscoVDSL.pm b/torrus/perllib/Torrus/DevDiscover/CiscoVDSL.pm
new file mode 100644
index 000000000..01d497594
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CiscoVDSL.pm
@@ -0,0 +1,130 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CiscoVDSL.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Cisco VDSL Line statistics.
+# Tested with Catalyst 2950 LRE
+
+package Torrus::DevDiscover::CiscoVDSL;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CiscoVDSL'} = {
+    'sequence'     => 600,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # CISCO-IETF-VDSL-LINE-MIB
+     'cvdslCurrSnrMgn'  => '1.3.6.1.4.1.9.10.87.1.1.2.1.5',
+     );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    if( $devdetails->isDevType('CiscoGeneric') )
+    {
+        my $snrTable =
+            $session->get_table( -baseoid => $dd->oiddef('cvdslCurrSnrMgn') );
+        if( defined $snrTable )
+        {
+            $devdetails->storeSnmpVars( $snrTable );
+            return 1;
+        }
+    }
+
+    return 0;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+
+    $data->{'cvdsl'} = [];
+
+    foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+    {
+        my $oid = $dd->oiddef('cvdslCurrSnrMgn') . '.' . $ifIndex;
+        if( $devdetails->hasOID( $oid . '.1' ) and
+            $devdetails->hasOID( $oid . '.2' ) )
+        {
+            push( @{$data->{'cvdsl'}}, $ifIndex );
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $subtreeName = 'VDSL_Line_Stats';
+
+    my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, {},
+                                       ['CiscoVDSL::cvdsl-subtree']);
+
+    my $data = $devdetails->data();
+
+    foreach my $ifIndex ( sort {$a<=>$b} @{$data->{'cvdsl'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        my $ifSubtreeName = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+
+        my $templates = ['CiscoVDSL::cvdsl-interface'];
+
+        my $param = {
+            'interface-name' => $interface->{'param'}{'interface-name'},
+            'interface-nick' => $interface->{'param'}{'interface-nick'},
+            'comment'        => $interface->{'param'}{'comment'}
+        };
+
+        $cb->addSubtree( $subtreeNode, $ifSubtreeName, $param, $templates );
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/CompaqCIM.pm b/torrus/perllib/Torrus/DevDiscover/CompaqCIM.pm
new file mode 100644
index 000000000..f055a187a
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/CompaqCIM.pm
@@ -0,0 +1,212 @@
+#  Copyright (C) 2003  Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: CompaqCIM.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+
+# Compaq Insight Manager
+# MIB files available at
+# http://h18023.www1.hp.com/support/files/server/us/download/19885.html
+
+package Torrus::DevDiscover::CompaqCIM;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'CompaqCIM'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef =
+    (
+     # Compaq Insite Manager
+     'cpqcim'                           => '1.3.6.1.4.1.232',
+
+     # CPQHLTH-MIB
+     'cpqHeTemperatureTable'            => '1.3.6.1.4.1.232.6.2.6.8',
+     'cpqHeTemperatureChassis'          => '1.3.6.1.4.1.232.6.2.6.8.1.1',
+     'cpqHeTemperatureIndex'            => '1.3.6.1.4.1.232.6.2.6.8.1.2',
+     'cpqHeTemperatureLocale'           => '1.3.6.1.4.1.232.6.2.6.8.1.3',
+     'cpqHeTemperatureCelsius'          => '1.3.6.1.4.1.232.6.2.6.8.1.4',
+     'cpqHeTemperatureHwLocation'       => '1.3.6.1.4.1.232.6.2.6.8.1.8',
+
+     'cpqHeCorrMemTotalErrs'            => '1.3.6.1.4.1.232.6.2.3.3.0',
+
+     # This is not a complete implementation  of the HLTH MIB
+
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    return $dd->checkSnmpTable( 'cpqcim' );
+}
+
+my $enumLocale = {
+    1   => 'other',
+    2   => 'unknown',
+    3   => 'system',
+    4   => 'systemBoard',
+    5   => 'ioBoard',
+    6   => 'cpu',
+    7   => 'memory',
+    8   => 'storage',
+    9   => 'removableMedia',
+    10  => 'powerSupply',
+    11  => 'ambient',
+    12  => 'chassis',
+    13  => 'bridgeCard',
+};
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    my @checkOids = ( 'cpqHeCorrMemTotalErrs' );
+
+    foreach my $oid ( @checkOids )
+    {
+        if( $dd->checkSnmpOID($oid) )
+        { 
+            $devdetails->setCap( $oid );
+        }
+    }
+
+    my $TemperatureTable =
+        $session->get_table( -baseoid =>
+                             $dd->oiddef('cpqHeTemperatureTable') );
+
+    if( defined( $TemperatureTable ) )
+    {
+        $devdetails->storeSnmpVars( $TemperatureTable );
+        $devdetails->setCap( 'cpqHeTemperatureTable' );
+
+        my $ref = {};
+        $ref->{'indices'} = [];
+        $data->{'TemperatureTable'} = $ref;
+
+        # Index is Chassis . Index
+        foreach my $INDEX
+            ( $devdetails->
+              getSnmpIndices( $dd->oiddef('cpqHeTemperatureIndex') ) )
+        {
+            next if ( $devdetails->snmpVar
+                      ( $dd->oiddef('cpqHeTemperatureCelsius') .
+                        '.' . $INDEX ) < 0 );
+
+            push( @{$ref->{'indices'}}, $INDEX );
+
+            my $chassis = $devdetails->snmpVar
+                ( $dd->oiddef('cpqHeTemperatureChassis') . '.' . $INDEX );
+
+            my $sensorIdx = $devdetails->snmpVar
+                ( $dd->oiddef('cpqHeTemperatureIndex') . '.' . $INDEX );
+
+            my $locale = $devdetails->snmpVar
+                ( $dd->oiddef('cpqHeTemperatureLocale') . '.' . $INDEX );
+            $locale = $enumLocale->{$locale} if $enumLocale->{$locale};
+
+            my $location = $devdetails->snmpVar
+                ( $dd->oiddef('cpqHeTemperatureHwLocation') . '.' . $INDEX );
+
+            my $nick = sprintf('Chassis%d_%s_%d',
+                               $chassis, $locale, $sensorIdx);
+
+            my $param = {};
+            $ref->{$INDEX}->{'param'} = $param;
+            $param->{'cpq-cim-sensor-index'} = $INDEX;
+            $param->{'cpq-cim-sensor-nick'} = $nick;
+            $param->{'comment'} =
+                sprintf('Chassis: %s Location: %s Index: %s',
+                        $chassis, $locale, $sensorIdx);
+            $param->{'precedence'} = 1000 - $sensorIdx;
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    my $cimParam = {
+        'comment'           => 'Compaq Insight Manager',
+        'precedence'        => '-500',
+    };
+
+    my $cimNode = $cb->addSubtree( $devNode, 'CompaqCIM', $cimParam );
+
+    my $healthParam = {
+        'comment'           => 'Compaq CIM Health',
+        'precedence'        => '-500'
+        };
+
+    my @healthTemplates;
+    if( $devdetails->hasCap('cpqHeCorrMemTotalErrs') )
+    {
+        push( @healthTemplates, 'CompaqCIM::cpq-cim-corr-mem-errs' );
+    }
+
+    my $Health = $cb->addSubtree( $cimNode, 'Health', $healthParam,
+                                  \@healthTemplates);
+
+    if( $devdetails->hasCap('cpqHeTemperatureTable') )
+    {
+        my $tempParam = {
+            'precedence' => '-100',
+            'comment' => 'Compaq Temperature Sensors',
+            'rrd-create-dstype' => 'GAUGE',
+        };
+
+        my $tempNode =
+            $cb->addSubtree(  $Health, 'Temperature_Sensors', $tempParam );
+
+        my $ref = $data->{'TemperatureTable'};
+
+        foreach my $INDEX ( @{ $ref->{'indices'} } )
+        {
+            my $param = $ref->{$INDEX}->{'param'};
+            $cb->addLeaf( $tempNode, $param->{'cpq-cim-sensor-nick'}, $param,
+                          [ 'CompaqCIM::cpq-cim-temperature-sensor' ] );
+        }
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/EmpireSystemedge.pm b/torrus/perllib/Torrus/DevDiscover/EmpireSystemedge.pm
new file mode 100644
index 000000000..f796920be
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/EmpireSystemedge.pm
@@ -0,0 +1,798 @@
+#  Copyright (C) 2003 Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: EmpireSystemedge.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+
+package Torrus::DevDiscover::EmpireSystemedge;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'EmpireSystemedge'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+# define the oids that are needed to determine support,
+# capabilities and information about the device
+our %oiddef =
+    (
+     'empire'                   => '1.3.6.1.4.1.546',
+
+     'sysedge_opmode'           => '1.3.6.1.4.1.546.1.1.1.17.0',
+     'empireSystemType'         => '1.3.6.1.4.1.546.1.1.1.12.0',
+
+     # Empire Cpu Table
+     'empireCpuStatsTable'      => '1.3.6.1.4.1.546.13.1.1',
+     'empireCpuStatsIndex'      => '1.3.6.1.4.1.546.13.1.1.1',
+     'empireCpuStatsDescr'      => '1.3.6.1.4.1.546.13.1.1.2',
+
+     # Empire Cpu Totals
+     'empireCpuTotalWait'       => '1.3.6.1.4.1.546.13.5.0',
+
+     # Empire Swap Counters
+     'empireNumPageSwapIns'      => '1.3.6.1.4.1.546.1.1.7.8.18.0',
+
+     # Empire Load Average
+     'empireLoadAverage'        => '1.3.6.1.4.1.546.1.1.7.8.26.0',
+
+     # Empire Device Table and Oids
+     'empireDevTable'           => '1.3.6.1.4.1.546.1.1.1.7.1',
+     'empireDevIndex'           => '1.3.6.1.4.1.546.1.1.1.7.1.1',
+     'empireDevMntPt'           => '1.3.6.1.4.1.546.1.1.1.7.1.3',
+     'empireDevBsize'           => '1.3.6.1.4.1.546.1.1.1.7.1.4',
+     'empireDevTblks'           => '1.3.6.1.4.1.546.1.1.1.7.1.5',
+     'empireDevType'            => '1.3.6.1.4.1.546.1.1.1.7.1.10',
+     'empireDevDevice'          => '1.3.6.1.4.1.546.1.1.1.7.1.2',
+
+     # Empire Device Stats Table and Oids
+     'empireDiskStatsTable'      => '1.3.6.1.4.1.546.12.1.1',
+     'empireDiskStatsIndex'      => '1.3.6.1.4.1.546.12.1.1.1',
+     'empireDiskStatsHostIndex'  => '1.3.6.1.4.1.546.12.1.1.9',
+     'hrDeviceDescr'             => '1.3.6.1.2.1.25.3.2.1.3',
+
+     # Empire Performance and related oids
+     'empirePerformance'        => '1.3.6.1.4.1.546.1.1.7',
+     'empireNumTraps'           => '1.3.6.1.4.1.546.1.1.7.8.15.0',
+
+     # Empire Process Stats
+     'empireRunq'               => '1.3.6.1.4.1.546.1.1.7.8.4.0',
+     'empireDiskWait'           => '1.3.6.1.4.1.546.1.1.7.8.5.0',
+     'empirePageWait'           => '1.3.6.1.4.1.546.1.1.7.8.6.0',
+     'empireSwapActive'         => '1.3.6.1.4.1.546.1.1.7.8.7.0',
+     'empireSleepActive'        => '1.3.6.1.4.1.546.1.1.7.8.8.0',
+
+     # Empire Extensions NTREGPERF
+     'empireNTREGPERF'          => '1.3.6.1.4.1.546.5.7',
+
+     'empireDnlc'               => '1.3.6.1.4.1.546.1.1.11',
+     'empireRpc'                => '1.3.6.1.4.1.546.8.1',
+     'empireNfs'                => '1.3.6.1.4.1.546.8.2',
+     'empireMon'                => '1.3.6.1.4.1.546.6.1.1',
+     'empirePmon'               => '1.3.6.1.4.1.546.15.1.1',
+     'empireLog'                => '1.3.6.1.4.1.546.11.1.1',
+     );
+
+our %storageDescTranslate =  ( '/' => {'subtree' => 'root' } );
+
+# template => 1 if specific templates for the name explicitly exist,
+# othewise the template used is based on ident
+#
+# Generally only hosts that have been directly observed should have
+# templates, the "unix" and "nt" templates are generally aiming for the
+# lowest common denominator.
+#
+# templates also need to be added to devdiscover-config.pl
+#
+#    Templated "names" require a specific template for each of the
+#    following base template types:
+#    <template name="empire-swap-counters-NAME">
+#    <template name="empire-counters-NAME">
+#    <template name="empire-total-cpu-NAME">
+#    <template name="empire-total-cpu-raw-NAME">
+#    <template name="empire-cpu-NAME">
+#    <template name="empire-cpu-raw-NAME">
+#    <template name="empire-disk-stats-NAME">
+#
+#    i.e.
+#    <template name="empire-swap-counters-solarisSparc">
+#    <template name="empire-counters-solarisSparc">
+#    <template name="empire-total-cpu-solarisSparc">
+#    <template name="empire-total-cpu-raw-solarisSparc">
+#    <template name="empire-cpu-solarisSparc">
+#    <template name="empire-cpu-raw-solarisSparc">
+#    <template name="empire-disk-stats-solarisSparc">
+#
+
+
+our %osTranslate =
+    (
+     1  => { 'name' => 'unknown',   'ident' => 'unknown', 'template' => 0, },
+     2  => { 'name' => 'solarisSparc', 'ident' => 'unix', 'template' => 1, },
+     3  => { 'name' => 'solarisIntel', 'ident' => 'unix', 'template' => 0, },
+     4  => { 'name' => 'solarisPPC',   'ident' => 'unix', 'template' => 0, },
+     5  => { 'name' => 'sunosSparc',   'ident' => 'unix', 'template' => 0, },
+     6  => { 'name' => 'hpux9Parisc',  'ident' => 'unix', 'template' => 0, },
+     7  => { 'name' => 'hpux10Parisc', 'ident' => 'unix', 'template' => 0, },
+     8  => { 'name' => 'nt351Intel',   'ident' => 'nt',   'template' => 0, },
+     9  => { 'name' => 'nt351Alpha',   'ident' => 'nt',   'template' => 0, },
+     10 => { 'name' => 'nt40Intel',    'ident' => 'nt',   'template' => 1, },
+     11 => { 'name' => 'nt40Alpha',    'ident' => 'nt',   'template' => 0, },
+     12 => { 'name' => 'irix62Mips',   'ident' => 'unix', 'template' => 0, },
+     13 => { 'name' => 'irix63Mips',   'ident' => 'unix', 'template' => 0, },
+     14 => { 'name' => 'irix64Mips',   'ident' => 'unix', 'template' => 0, },
+     15 => { 'name' => 'aix41RS6000',  'ident' => 'unix', 'template' => 0, },
+     16 => { 'name' => 'aix42RS6000',  'ident' => 'unix', 'template' => 0, },
+     17 => { 'name' => 'aix43RS6000',  'ident' => 'unix', 'template' => 0, },
+     18 => { 'name' => 'irix65Mips',   'ident' => 'unix', 'template' => 0, },
+     19 => { 'name' => 'digitalUNIX',  'ident' => 'unix', 'template' => 0, },
+     20 => { 'name' => 'linuxIntel',   'ident' => 'unix', 'template' => 1, },
+     21 => { 'name' => 'hpux11Parisc', 'ident' => 'unix', 'template' => 0, },
+     22 => { 'name' => 'nt50Intel',    'ident' => 'nt',   'template' => 1, },
+     23 => { 'name' => 'nt50Alpha',    'ident' => 'nt',   'template' => 0, },
+     25 => { 'name' => 'aix5RS6000',   'ident' => 'unix', 'template' => 1, },
+     26 => { 'name' => 'nt52Intel',    'ident' => 'nt',   'template' => 0, },
+     );
+
+# Solaris Virtual Interface Filtering
+our $interfaceFilter;
+my %solarisVirtualInterfaceFilter;
+
+%solarisVirtualInterfaceFilter = (
+    'Virtual Interface (iana 62)' => {
+        'ifType'    =>  62,             # Obsoleted
+        'ifDescr'   =>  '^\w+:\d+$',    # Virtual Interface in the form xxx:1
+                                        # e.g. eri:1 eri1:2
+        },
+
+    'Virtual Interface' => {
+        'ifType'    =>  6,
+        'ifDescr'   =>  '^\w+:\d+$',    # Virtual Interface in the form xxx:1
+                                        # e.g. eri:1 eri1:2
+        },
+    );
+
+our $storageGraphTop;
+our $storageHiMark;
+our $shortTemplate;
+our $longTemplate;
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    my $session = $dd->session();
+
+    if( not $dd->checkSnmpTable( 'empire' ) )
+    {
+        return 0;
+    }
+
+    my $result = $dd->retrieveSnmpOIDs( 'sysedge_opmode',
+                                        'empireSystemType' );
+    if( $result->{'sysedge_opmode'} == 2 )
+    {
+        Error("Sysedge Agent NOT Licensed");
+        $devdetails->setCap('SysedgeNotLicensed');
+    }
+
+    # Empire OS Type (Needed here for interface filtering)
+    
+    my $empireOsType = $result->{'empireSystemType'};
+    if( defined($empireOsType) and $empireOsType > 0 )
+    {
+        $devdetails->setCap('EmpireSystemedge::' .
+                            $osTranslate{$empireOsType}{ident} );
+        
+        $devdetails->{'os_ident'} = $osTranslate{$empireOsType}{ident};
+
+        
+        $devdetails->setCap('EmpireSystemedge::' .
+                            $osTranslate{$empireOsType}{name} );
+        
+        $devdetails->{'os_name'} = $osTranslate{$empireOsType}{name};
+
+        $devdetails->{'os_name_template'} =
+            $osTranslate{$empireOsType}{template};
+    }
+
+    # Exclude Virtual Interfaces on Solaris
+    if( $devdetails->{'os_name'} =~ /solaris/i ) {
+
+        $interfaceFilter = \%solarisVirtualInterfaceFilter;
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilter);
+    }
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+
+    if( $dd->checkSnmpOID('empireCpuTotalWait') )
+    {
+        $devdetails->setCap('EmpireSystemedge::CpuTotal::Wait');
+    }
+
+    # Empire Dev Stats Table
+
+    my $empireDiskStatsTable =
+        $session->get_table( -baseoid =>
+                             $dd->oiddef('empireDiskStatsTable') );
+
+    my $hrDeviceDescr = $session->get_table( -baseoid =>
+                                             $dd->oiddef('hrDeviceDescr') );
+
+    if( defined($empireDiskStatsTable) and defined($hrDeviceDescr) )
+    {
+        $devdetails->setCap('EmpireSystemedge::DiskStats');
+        $devdetails->storeSnmpVars( $empireDiskStatsTable );
+        $devdetails->storeSnmpVars( $hrDeviceDescr );
+
+        my $ref= {'indices' => []};
+        $data->{'empireDiskStats'} = $ref;
+
+        foreach my $INDEX
+            ( $devdetails->
+              getSnmpIndices( $dd->oiddef('empireDiskStatsIndex') ) )
+        {
+            next if( $INDEX < 1 );
+
+            my $hrindex =
+                $devdetails->snmpVar( $dd->oiddef('empireDiskStatsHostIndex') .
+                                      '.' . $INDEX );
+
+            next if( $hrindex < 1 );
+
+            push( @{ $ref->{'indices'} }, $INDEX );
+
+            my $descr = $devdetails->snmpVar($dd->oiddef('hrDeviceDescr') .
+                                             '.' . $hrindex );
+
+            my $ref = { 'param' => {}, 'templates' => [] };
+            $data->{'empireDiskStats'}{$INDEX} = $ref;
+            my $param = $ref->{'param'};
+
+
+            $param->{'comment'} = $descr;
+
+            $param->{'HRINDEX'} = $hrindex;
+
+            if ( not defined $descr )
+            {
+                $descr = "Index $hrindex";
+            }
+            $param->{'disk-stats-description'} = $descr;
+
+            $descr =~ s/^\///;
+            $descr =~ s/\W/_/g;
+            $param->{'disk-stats-nick'} = $descr;
+
+        }
+    } # end empireDiskStatsTable
+
+    # Empire Dev Table
+
+    my $empireDevTable = $session->get_table( -baseoid =>
+                                              $dd->oiddef('empireDevTable') );
+
+    if( defined( $empireDevTable ) )
+    {
+
+        $devdetails->setCap('EmpireSystemedge::Devices');
+        $devdetails->storeSnmpVars( $empireDevTable );
+
+        my $ref= {};
+        $data->{'empireDev'} = $ref;
+
+        foreach my $INDEX
+            ( $devdetails->getSnmpIndices($dd->oiddef('empireDevIndex') ) )
+        {
+            next if( $INDEX < 1 );
+
+
+            my $type = $devdetails->snmpVar( $dd->oiddef('empireDevType') .
+                                             '.' . $INDEX );
+
+            my $descr = $devdetails->snmpVar($dd->oiddef('empireDevMntPt') .
+                                             '.' . $INDEX );
+
+            my $bsize =  $devdetails->snmpVar($dd->oiddef('empireDevBsize') .
+                                              '.' . $INDEX );
+
+            # NFS has a block size of 0, it will be skipped
+            if( $bsize and defined( $descr ) )
+            {
+                push( @{ $data->{'empireDev'}->{'indices'} }, $INDEX);
+
+                my $ref = { 'param' => {}, 'templates' => [] };
+                $data->{'empireDev'}{$INDEX} = $ref;
+                my $param = $ref->{'param'};
+
+                $param->{'storage-description'} = $descr;
+                $param->{'storage-device'} =
+                    $devdetails->snmpVar($dd->oiddef('empireDevDevice')
+                                         . '.' . $INDEX );
+
+                my $comment = $type;
+                if( $descr =~ /^\// )
+                {
+                    $comment .= ' (' . $descr . ')';
+                }
+                $param->{'comment'} = $comment;
+
+                if( $storageDescTranslate{$descr}{'subtree'} )
+                {
+                    $descr = $storageDescTranslate{$descr}{'subtree'};
+                }
+                $descr =~ s/^\///;
+                $descr =~ s/\W/_/g;
+                $param->{'storage-nick'} = $descr;
+
+                my $units = $bsize;
+
+                $param->{'collector-scale'} = sprintf('%d,*', $units);
+
+                my $size =
+                    $devdetails->snmpVar
+                    ($dd->oiddef('empireDevTblks') . '.' . $INDEX);
+
+                if( $size )
+                {
+                    if( $storageGraphTop > 0 )
+                    {
+                        $param->{'graph-upper-limit'} =
+                            sprintf('%e',
+                                    $units * $size * $storageGraphTop / 100 );
+                    }
+
+                    if( $storageHiMark > 0 )
+                    {
+                        $param->{'upper-limit'} =
+                            sprintf('%e',
+                                    $units * $size * $storageHiMark / 100 );
+                    }
+                }
+
+            }
+        }
+
+        $devdetails->clearCap( 'hrStorage' );
+
+    } # end empireDevTable
+
+
+    # Empire Per - Cpu Table
+
+    my $empireCpuStatsTable =
+        $session->get_table( -baseoid =>
+                             $dd->oiddef('empireCpuStatsTable') );
+
+    if( defined( $empireCpuStatsTable ) )
+    {
+        $devdetails->setCap('EmpireSystemedge::CpuStats');
+        $devdetails->storeSnmpVars( $empireCpuStatsTable );
+
+        my $ref= {};
+        $data->{'empireCpuStats'} = $ref;
+
+        foreach my $INDEX
+            ( $devdetails->
+              getSnmpIndices( $dd->oiddef('empireCpuStatsIndex') ) )
+        {
+            next if( $INDEX < 1 );
+
+            push( @{ $ref->{'indices'} }, $INDEX);
+
+            my $descr =
+                $devdetails->snmpVar( $dd->oiddef('empireCpuStatsDescr') .
+                                      '.' . $INDEX );
+
+            my $ref = { 'param' => {}, 'templates' => [] };
+            $data->{'empireCpuStats'}{$INDEX} = $ref;
+            my $param = $ref->{'param'};
+
+            $param->{'cpu'} = 'CPU' . $INDEX;
+            $param->{'descr'} = $descr;
+            $param->{'INDEX'} = $INDEX;
+            $param->{'comment'} = $descr . ' (' . 'CPU ' . $INDEX . ')';
+        }
+    }
+
+    # Empire Load Average
+
+    if( $dd->checkSnmpOID('empireLoadAverage') )
+    {
+        $devdetails->setCap('EmpireSystemedge::LoadAverage');
+    }
+
+    # Empire Swap Counters
+
+    if( $dd->checkSnmpOID('empireNumPageSwapIns') )
+    {
+        $devdetails->setCap('EmpireSystemedge::SwapCounters');
+    }
+
+    # Empire Counter Traps
+
+    if( $dd->checkSnmpOID('empireNumTraps') )
+    {
+        $devdetails->setCap('EmpireSystemedge::CounterTraps');
+    }
+
+    # Empire Performance
+
+    my $empirePerformance =
+        $session->get_table( -baseoid => $dd->oiddef('empirePerformance') );
+
+    if( defined( $empirePerformance ) )
+    {
+        $devdetails->setCap('EmpireSystemedge::Performance');
+        $devdetails->storeSnmpVars( $empirePerformance );
+
+        if( defined $devdetails->snmpVar($dd->oiddef('empireRunq') ) )
+        {
+            $devdetails->setCap('EmpireSystemedge::RunQ');
+        }
+
+        if( defined $devdetails->snmpVar($dd->oiddef('empireDiskWait') ) )
+        {
+            $devdetails->setCap('EmpireSystemedge::DiskWait');
+        }
+
+        if( defined $devdetails->snmpVar($dd->oiddef('empirePageWait') ) )
+        {
+            $devdetails->setCap('EmpireSystemedge::PageWait');
+        }
+
+        if( defined $devdetails->snmpVar($dd->oiddef('empireSwapActive') ) )
+        {
+            $devdetails->setCap('EmpireSystemedge::SwapActive');
+        }
+
+        if( defined $devdetails->snmpVar($dd->oiddef('empireSleepActive') ) )
+        {
+            $devdetails->setCap('EmpireSystemedge::SleepActive');
+        }
+    }
+
+    my $empireNTREGPERF =
+        $session->get_table( -baseoid => $dd->oiddef('empireNTREGPERF') );
+    if( defined $empireNTREGPERF )
+    {
+        $devdetails->setCap('empireNTREGPERF');
+        $devdetails->storeSnmpVars( $empireNTREGPERF );
+
+        my $ref = {};
+        $data->{'empireNTREGPERF'} = $ref;
+        foreach my $INDEX
+            ( $devdetails->getSnmpIndices($dd->oiddef('empireNTREGPERF') ) )
+        {
+            # This is all configured on a per site basis.
+            # The xml will be site specific
+            push( @{ $ref->{'indices'} }, $INDEX);
+            my $template = {};
+            $Torrus::ConfigBuilder::templateRegistry->
+            {'EmpireSystemedge::NTREGPERF_' . $INDEX} = $template;
+            $template->{'name'}='EmpireSystemedge::NTREGPERF_' . $INDEX;
+            $template->{'source'}='vendor/empire.systemedge.ntregperf.xml';
+
+        }
+    }
+
+#NOT CONFIGURED## Empire DNLC
+#NOT CONFIGURED#    my $empireDnlc = $session->get_table( -baseoid =>
+#NOT CONFIGURED#        $dd->oiddef('empireDnlc') );
+#NOT CONFIGURED#    if( defined $empirePerformance )
+#NOT CONFIGURED#    {
+#NOT CONFIGURED#        # don't do this until we use the data
+#NOT CONFIGURED#        #$devdetails->setCap('empirednlc');
+#NOT CONFIGURED#        #$devdetails->storeSnmpVars( $empireDnlc );
+#NOT CONFIGURED#    }
+#NOT CONFIGURED#
+#NOT CONFIGURED## Empire RPC
+#NOT CONFIGURED#    my $empireRpc = $session->get_table( -baseoid =>
+#NOT CONFIGURED#        $dd->oiddef('empireRpc') );
+#NOT CONFIGURED#    if( defined $empireRpc )
+#NOT CONFIGURED#    {
+#NOT CONFIGURED#        # don't do this until we use the data
+#NOT CONFIGURED#        #$devdetails->setCap('empirerpc');
+#NOT CONFIGURED#        #$devdetails->storeSnmpVars( $empireRpc );
+#NOT CONFIGURED#    }
+#NOT CONFIGURED#
+#NOT CONFIGURED## Empire NFS
+#NOT CONFIGURED#    my $empireNfs = $session->get_table( -baseoid =>
+#NOT CONFIGURED#        $dd->oiddef('empireNfs') );
+#NOT CONFIGURED#    if( defined $empireRpc )
+#NOT CONFIGURED#    {
+#NOT CONFIGURED#        # don't do this until we use the data
+#NOT CONFIGURED#        #$devdetails->setCap('empirenfs');
+#NOT CONFIGURED#        #$devdetails->storeSnmpVars( $empireNfs );
+#NOT CONFIGURED#    }
+#NOT CONFIGURED#
+#NOT CONFIGURED## Empire Mon Entries
+#NOT CONFIGURED#    my $empireMon = $session->get_table( -baseoid =>
+#NOT CONFIGURED#        $dd->oiddef('empireMon') );
+#NOT CONFIGURED#    if( ref( $empireMon ) )
+#NOT CONFIGURED#    {
+#NOT CONFIGURED#        # don't do this until we use the data
+#NOT CONFIGURED#        #$devdetails->setCap('empiremon');
+#NOT CONFIGURED#        #$devdetails->storeSnmpVars( $empireMon );
+#NOT CONFIGURED#    }
+#NOT CONFIGURED#
+#NOT CONFIGURED## Empire Process Monitor Entries
+#NOT CONFIGURED#    my $empirePmon = $session->get_table( -baseoid =>
+#NOT CONFIGURED#        $dd->oiddef('empirePmon') );
+#NOT CONFIGURED#    if( ref( $empirePmon ) )
+#NOT CONFIGURED#    {
+#NOT CONFIGURED#        # don't do this until we use the data
+#NOT CONFIGURED#        #$devdetails->setCap('empirePmon');
+#NOT CONFIGURED#        #$devdetails->storeSnmpVars( $empirePmon );
+#NOT CONFIGURED#    }
+#NOT CONFIGURED#
+#NOT CONFIGURED## Empire Log Monitor Entries
+#NOT CONFIGURED#    my $empireLog = $session->get_table( -baseoid =>
+#NOT CONFIGURED#        $dd->oiddef('empireLog') );
+#NOT CONFIGURED#    if( ref( $empireLog ) )
+#NOT CONFIGURED#    {
+#NOT CONFIGURED#        # don't do this until we use the data
+#NOT CONFIGURED#        #$devdetails->setCap('empireLog');
+#NOT CONFIGURED#        #$devdetails->storeSnmpVars( $empireLog );
+#NOT CONFIGURED#    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    my $mononlyTree = "Mon_Only";
+    my $monParam = {
+        'precedence'    => '-100000',
+        'comment'       => 'Place to Stash Monitoring Data ',
+        'hidden'        => 'yes',
+    };
+
+    my $monNode = $cb->addSubtree( $devNode, $mononlyTree, $monParam );
+    $cb->addTemplateApplication
+        ( $monNode, 'EmpireSystemedge::sysedge_opmode' );
+
+    if( $devdetails->hasCap('SysedgeNotLicensed') )
+    {
+        return 1;
+    }
+
+    my $os_target;
+    if( $devdetails->{'os_name_template'} )
+    {
+        $os_target = $devdetails->{'os_name'};
+    }
+    else
+    {
+        $os_target = $devdetails->{'os_ident'};
+        Warn("Using Generic OS Templates '$os_target' for os: "
+             .  $devdetails->{'os_name'} );
+    }
+
+    my $subtreeName = "Storage";
+
+    my $param = {
+        'precedence'    => '-1000',
+        'comment'       => 'Storage Information',
+    };
+
+    my $StorageNode = $cb->addSubtree( $devNode, $subtreeName, $param );
+
+    # Empire Devices(Storage)
+    if( $devdetails->hasCap('EmpireSystemedge::Devices') )
+    {
+        my $subtreeName = "VolumeInfo";
+
+        my $param = {
+            'precedence'    => '-1000',
+            'comment'       => 'Physical/Logical Volume Information',
+        };
+
+        my $subtreeNode =
+            $cb->addSubtree( $StorageNode, $subtreeName, $param,
+                             [ 'EmpireSystemedge::empire-device-subtree' ] );
+
+        foreach my $INDEX ( sort {$a<=>$b} @{$data->{'empireDev'}{'indices'}} )
+        {
+            my $ref = $data->{'empireDev'}{$INDEX};
+
+            # Display in index order
+            $ref->{'param'}->{'precedence'} = sprintf("%d", 2000 - $INDEX);
+
+            $cb->addSubtree( $subtreeNode, $ref->{'param'}{'storage-nick'},
+                             $ref->{'param'},
+                             [ 'EmpireSystemedge::empire-device' ] );
+        }
+    }
+
+    # Empire Device Stats
+    if( $devdetails->hasCap('EmpireSystemedge::DiskStats') )
+    {
+        my $subtreeName = "DiskInfo";
+
+        my $param = {
+            'precedence'    => '-1000',
+            'comment'       => 'Physical/Logical Disk Information',
+        };
+
+        my $subtreeNode =
+            $cb->addSubtree( $StorageNode, $subtreeName, $param,
+                             ['EmpireSystemedge::empire-disk-stats-subtree']);
+
+        foreach my $INDEX
+            ( sort {$a<=>$b} @{$data->{'empireDiskStats'}{'indices'}} )
+        {
+            my $ref = $data->{'empireDiskStats'}{$INDEX};
+            # Display in index order
+            $ref->{'param'}->{'precedence'} = sprintf("%d", 1000 - $INDEX);
+
+            $cb->addSubtree( $subtreeNode, $ref->{'param'}{'disk-stats-nick'},
+                             $ref->{'param'},
+                             [ 'EmpireSystemedge::empire-disk-stats-' .
+                               $os_target, ] );
+        }
+    }
+
+
+    # Performance Subtree
+    my $subtreeName= "System_Performance";
+
+    my $param = {
+        'precedence'     => '-900',
+        'comment'        => 'System, CPU and memory statistics'
+        };
+
+    my @perfTemplates = ();
+
+    # Empire Load Average
+    if( $devdetails->hasCap('EmpireSystemedge::LoadAverage') )
+    {
+        push( @perfTemplates, 'EmpireSystemedge::empire-load' );
+    }
+
+    # Empire Performance
+    if( $devdetails->hasCap('EmpireSystemedge::Performance') )
+    {
+        push( @perfTemplates, 'EmpireSystemedge::empire-memory' );
+    }
+
+    push( @perfTemplates,
+          'EmpireSystemedge::empire-counters-' . $os_target,
+          'EmpireSystemedge::empire-swap-counters-' . $os_target,
+          'EmpireSystemedge::empire-total-cpu-' .  $os_target,
+          'EmpireSystemedge::empire-total-cpu-raw-' .  $os_target,
+          );
+
+    if( $devdetails->hasCap('EmpireSystemedge::RunQ') )
+    {
+        push( @perfTemplates, 'EmpireSystemedge::empire-runq' );
+    }
+
+    if( $devdetails->hasCap('EmpireSystemedge::DiskWait') )
+    {
+        push( @perfTemplates, 'EmpireSystemedge::empire-diskwait' );
+    }
+
+    if( $devdetails->hasCap('EmpireSystemedge::PageWait') )
+    {
+        push( @perfTemplates, 'EmpireSystemedge::empire-pagewait' );
+    }
+
+    if( $devdetails->hasCap('EmpireSystemedge::SwapActive') )
+    {
+        push( @perfTemplates, 'EmpireSystemedge::empire-swapactive' );
+    }
+
+    if( $devdetails->hasCap('EmpireSystemedge::SleepActive') )
+    {
+        push( @perfTemplates, 'EmpireSystemedge::empire-sleepactive' );
+    }
+
+    my $PerformanceNode = $cb->addSubtree( $devNode, $subtreeName,
+                                           $param, \@perfTemplates   );
+
+    # Empire CPU Stats
+    if( $devdetails->hasCap('EmpireSystemedge::CpuStats') )
+    {
+        my $ref = $data->{'empireCpuStats'};
+
+        my $subtreeName = "CpuStats";
+
+        my $param = {
+            'precedence'    => '-1100',
+            'comment'       => 'Per-CPU Statistics',
+        };
+
+        my $subtreeNode =
+            $cb->addSubtree( $PerformanceNode, $subtreeName, $param,
+                             [ 'EmpireSystemedge::empire-cpu-subtree' ] );
+
+        foreach my $INDEX
+            ( sort {$a<=>$b} @{$data->{'empireCpuStats'}{'indices'} } )
+        {
+            my $ref = $data->{'empireCpuStats'}{$INDEX};
+
+            # Display in index order
+            $ref->{'param'}->{'precedence'} = sprintf("%d", 1000 - $INDEX);
+
+            $cb->addSubtree
+                ( $subtreeNode, $ref->{'param'}{'cpu'},
+                  $ref->{'param'},
+                  ['EmpireSystemedge::empire-cpu-' . $os_target,
+                   'EmpireSystemedge::empire-cpu-raw-' . $os_target],
+                  );
+        }
+    }
+
+    if( $devdetails->hasCap('empireNTREGPERF') )
+    {
+        Debug("NTREGPERF");
+        my $ntregTree = "NT_REG_PERF";
+        my $ntregParam = {
+            'precedence'    => '-10000',
+            'comment'       => 'NT Reg Perf',
+        };
+        my $ntregnode =
+            $cb->addSubtree( $devNode, $ntregTree, $ntregParam );
+
+        foreach my $INDEX
+            ( sort {$a<=>$b} @{$data->{'empireNTREGPERF'}{'indices'} } )
+        {
+            my $ref = $data->{'empireNTREGPERF'}{$INDEX};
+            $cb->addTemplateApplication
+                ( $ntregnode, 'EmpireSystemedge::NTREGPERF_' . $INDEX );
+
+        }
+
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/F5BigIp.pm b/torrus/perllib/Torrus/DevDiscover/F5BigIp.pm
new file mode 100644
index 000000000..e0d0770bb
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/F5BigIp.pm
@@ -0,0 +1,543 @@
+#  Copyright (C) 2003  Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: F5BigIp.pm,v 1.1 2010-12-27 00:03:48 ivan Exp $
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+
+# F5 BigIp Load Balancer
+
+package Torrus::DevDiscover::F5BigIp;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'F5BigIp'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef =
+    (
+     # F5
+     'f5'                           => '1.3.6.1.4.1.3375',
+
+     '4.x_globalStatUptime'         => '1.3.6.1.4.1.3375.1.1.1.2.1.0',
+     '3.x_uptime'                   => '1.3.6.1.4.1.3375.1.1.50.0',
+
+     '4.x_globalAttrProductCode'    => '1.3.6.1.4.1.3375.1.1.1.1.5.0',
+
+     '4.x_virtualServer'            => '1.3.6.1.4.1.3375.1.1.3',
+     '4.x_virtualServerNumber'      => '1.3.6.1.4.1.3375.1.1.3.1.0',
+     '4.x_virtualServerTable'       => '1.3.6.1.4.1.3375.1.1.3.2',
+     '4.x_virtualServerIp'          => '1.3.6.1.4.1.3375.1.1.3.2.1.1',
+     '4.x_virtualServerPort'        => '1.3.6.1.4.1.3375.1.1.3.2.1.2',
+     '4.x_virtualServerPool'        => '1.3.6.1.4.1.3375.1.1.3.2.1.30',
+
+     '4.x_poolTable'                => '1.3.6.1.4.1.3375.1.1.7.2',
+     '4.x_poolName'                 => '1.3.6.1.4.1.3375.1.1.7.2.1.1',
+
+     '4.x_poolMemberTable'          => '1.3.6.1.4.1.3375.1.1.8.2',
+     '4.x_poolMemberPoolName'       => '1.3.6.1.4.1.3375.1.1.8.2.1.1',
+     '4.x_poolMemberIpAddress'      => '1.3.6.1.4.1.3375.1.1.8.2.1.2',
+     '4.x_poolMemberPort'           => '1.3.6.1.4.1.3375.1.1.8.2.1.3',
+
+     '4.x_sslProxyTable'            => '1.3.6.1.4.1.3375.1.1.9.2.1',
+     '4.x_sslProxyOrigIpAddress'    => '1.3.6.1.4.1.3375.1.1.9.2.1.1',
+     '4.x_sslProxyOrigPort'         => '1.3.6.1.4.1.3375.1.1.9.2.1.2',
+     '4.x_sslProxyDestIpAddress'    => '1.3.6.1.4.1.3375.1.1.9.2.1.3',
+     '4.x_sslProxyDestPort'         => '1.3.6.1.4.1.3375.1.1.9.2.1.4',
+     '4.x_sslProxyConnLimit'        => '1.3.6.1.4.1.3375.1.1.9.2.1.23',
+
+     );
+
+# from https://secure.f5.com/validate/help.jsp
+#HA (BIG-IP high availability software)
+#3DNS (3-DNS software)
+#LC (BIG-IP Link Controller software)
+#LB (BIG-IP Load Balancer 520)
+#FLB (BIG-IP FireGuard 520)
+#CLB (BIG-IP Cache Load Balancer 520)
+#SSL (BIG-IP eCommerce Load Balancer 520)
+#XLB (BIG-IP user-defined special purpose product for 520 platforms)
+#ISMAN (iControl Services Manager)
+
+our %f5_product = (
+    '1'     => { 'product' => 'indeterminate',  'supported' => 0, },
+    '2'     => { 'product' => 'ha',             'supported' => 1, },
+    '3'     => { 'product' => 'lb',             'supported' => 1, },
+    '4'     => { 'product' => 'threedns',       'supported' => 0, },
+    '5'     => { 'product' => 'flb',            'supported' => 0, },
+    '6'     => { 'product' => 'clb',            'supported' => 0, },
+    '7'     => { 'product' => 'xlb',            'supported' => 0, },
+    '8'     => { 'product' => 'ssl',            'supported' => 1, },
+    '10'    => { 'product' => 'test',           'supported' => 0, },
+    '99'    => { 'product' => 'unsupported',    'supported' => 0, },
+    );
+
+our %f5_sslGatewayLevel = (
+    '1'     => 'none',
+    '3'     => 'tps200',
+    '4'     => 'tps400',
+    '5'     => 'tps600',
+    '6'     => 'tps800',
+    '7'     => 'tps1000',
+    '9'     => 'tps500',
+    '10'    => 'tps1500',
+    '11'    => 'tps2000',
+    '99'    => 'unsupported',
+    );
+
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+    my $data = $devdetails->data();
+
+    # You would think globalAttrProductCode would work well
+    # I need more examples to see if ha(2) is specific to
+    # BipIP HA or any ha f5 product
+
+    if( not $dd->checkSnmpTable( 'f5' ) )
+    {
+        return 0;
+    }
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # SNMP on F5 boxes will become unresponsive over time with large
+    # enough oids-per-pdu values.  10 appears to work for everything however
+    # no exhaustive testing has been done to determine if a higer number
+    # could be used.
+    if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) )
+    {
+        my $oidsPerPDU = $devdetails->param('F5BigIp::snmp-oids-per-pdu');
+        if( $oidsPerPDU == 0 )
+        {
+            $oidsPerPDU = 10;
+        }
+        $data->{'param'}{'snmp-oids-per-pdu'} = $oidsPerPDU;
+    }
+
+    # this is rather basic, per-capability checking
+    # may be required in the future
+
+    if( $dd->checkSnmpOID('4.x_globalStatUptime') )
+    {
+        $devdetails->setCap('BigIp_4.x');
+    }
+    elsif( $dd->checkSnmpOID('3.x_uptime') )
+    {
+        # for v3.x we are not supporting detailed stats, so don't check
+        # anything else
+        $devdetails->setCap('BigIp_3.x');
+        return 1;
+    }
+
+    my $product_name;
+    my $product_name;
+    my $result = $dd->retrieveSnmpOIDs( '4.x_globalAttrProductCode' );
+    my $product_code = $result->{'4.x_globalAttrProductCode'};
+
+    $product_name = %f5_product->{$product_code}->{'product'};
+    if( %f5_product->{$product_code}->{'supported'} )
+    {
+        $devdetails->setCap( 'BigIp_' . $product_name );
+    }
+    else
+    {
+        if( defined($product_name) )
+        {
+            Debug("Found an unsupported F5 product '$product_name'");
+        }
+        else
+        {
+            Debug("Found an unknown F5 product");
+        }
+        return 0;
+    }
+
+    my $poolTable = $session->get_table( -baseoid =>
+                                 $dd->oiddef('4.x_poolTable') );
+
+    if( defined( $poolTable ) )
+    {
+        $devdetails->storeSnmpVars( $poolTable );
+        $devdetails->setCap('BigIp_4.x_PoolTable');
+
+        my $ref = {};
+        $ref->{'indices'} = [];
+        $data->{'poolTable'} = $ref;
+
+        foreach my $INDEX ( $devdetails->
+                            getSnmpIndices( $dd->oiddef('4.x_poolName') ) )
+        {
+            push( @{$ref->{'indices'}}, $INDEX );
+            my $pool = $devdetails->snmpVar($dd->oiddef('4.x_poolName') .
+                                            '.' . $INDEX );
+
+            my $nick = $pool;
+            $nick =~ s/\W/_/g;
+            $nick =~ s/_+/_/g;
+
+            my $param = {};
+            $ref->{$INDEX}->{'param'} = $param;
+            $param->{'nick'} = $nick;
+            $param->{'pool'} = $pool;
+            $param->{'descr'} = "Stats for Pool $pool";
+            $param->{'INDEX'} = $INDEX;
+        }
+
+    }
+
+    my $poolMemberTable =
+        $session->get_table( -baseoid =>
+                             $dd->oiddef('4.x_poolMemberTable') );
+
+    if( defined( $poolMemberTable ) )
+    {
+        $devdetails->storeSnmpVars( $poolMemberTable );
+        $devdetails->setCap('BigIp_4.x_PoolMemberTable');
+
+        my $ref = {};
+        $data->{'poolMemberTable'} = $ref;
+
+        foreach my $INDEX
+            ( $devdetails->
+              getSnmpIndices( $dd->oiddef('4.x_poolMemberPoolName') ) )
+        {
+            push( @{ $ref->{'indices'} }, $INDEX );
+            my $pool =
+                $devdetails->snmpVar($dd->oiddef('4.x_poolMemberPoolName') .
+                                     '.' . $INDEX );
+            my $ip =
+                $devdetails->snmpVar($dd->oiddef('4.x_poolMemberIpAddress') .
+                                     '.' . $INDEX );
+            my $port =
+                $devdetails->snmpVar($dd->oiddef('4.x_poolMemberPort') .
+                                     '.' . $INDEX );
+
+            my $nick = "MEMBER_${pool}_${ip}_${port}";
+            $nick =~ s/\W/_/g;
+            $nick =~ s/_+/_/g;
+
+            my $param = {};
+            $ref->{$INDEX}->{'param'} = $param;
+            $param->{'nick'} = $nick;
+            $param->{'pool'} = $pool;
+            $param->{'descr'} = "Member of Pool $pool IP: $ip Port: $port";
+            $param->{'INDEX'} = $INDEX;
+        }
+
+    }
+
+    my $virtServerNumber = $dd->retrieveSnmpOIDs( '4.x_virtualServerNumber' );
+    if( $virtServerNumber->{'4.x_virtualServerNumber'} > 0 )
+    {
+        my $virtServer = $session->get_table( -baseoid =>
+                                          $dd->oiddef('4.x_virtualServer') );
+        if( defined( $virtServer ) )
+        {
+            $devdetails->storeSnmpVars( $virtServer );
+            $devdetails->setCap('BigIp_4.x_VirtualServer');
+
+            my $ref = {};
+            $data->{'virtualServer'} = $ref;
+
+            foreach my $INDEX
+                ( $devdetails->
+                  getSnmpIndices( $dd->oiddef('4.x_virtualServerIp') ) )
+            {
+                push( @{ $ref->{'indices'} }, $INDEX);
+                my $pool = $devdetails->snmpVar(
+                                $dd->oiddef('4.x_virtualServerPool') .
+                                '.' . $INDEX );
+                my $ip = $devdetails->snmpVar(
+                                $dd->oiddef('4.x_virtualServerIp') .
+                                '.' . $INDEX );
+                my $port = $devdetails->snmpVar(
+                                $dd->oiddef('4.x_virtualServerPort') .
+                                '.' . $INDEX );
+
+                my $param = {};
+                $ref->{$INDEX}->{'param'} = $param;
+
+                my $descr = "Virtual Server Pool: $pool IP: $ip Port: $port";
+                my $nick = "VIP_${pool}_${ip}_${port}";
+                $nick =~ s/\W/_/g;
+                $nick =~ s/_+/_/g;
+
+                $param->{'INDEX'} = $INDEX;
+                $param->{'descr'} = $descr;
+                $param->{'nick'} = $nick;
+                $param->{'pool'} = $pool;
+            }
+        }
+        else
+        {
+            Debug("Virtual Servers Defined but not able to be configured");
+        }
+    }
+
+    my $sslProxyTable = $session->get_table( -baseoid =>
+                            $dd->oiddef('4.x_sslProxyTable') );
+
+    if( defined( $sslProxyTable ) )
+    {
+        $devdetails->storeSnmpVars( $sslProxyTable );
+        $devdetails->setCap('BigIp_4.x_sslProxyTable');
+
+        my $ref = {};
+        $ref->{'indices'} = [];
+        $data->{'sslProxyTable'} = $ref;
+
+        foreach my $INDEX ( $devdetails->
+            getSnmpIndices( $dd->oiddef('4.x_sslProxyOrigIpAddress') ) )
+        {
+            push( @{$ref->{'indices'}}, $INDEX );
+
+            my $origIp = $devdetails->snmpVar(
+                    $dd->oiddef('4.x_sslProxyOrigIpAddress')
+                    . '.' .  $INDEX );
+
+            my $origPort = $devdetails->snmpVar(
+                    $dd->oiddef('4.x_sslProxyOrigPort')
+                    . '.' .  $INDEX );
+
+            my $destIp = $devdetails->snmpVar(
+                    $dd->oiddef('4.x_sslProxyDestIpAddress')
+                    . '.' .  $INDEX );
+
+            my $destPort = $devdetails->snmpVar(
+                    $dd->oiddef('4.x_sslProxyDestPort')
+                    . '.' .  $INDEX );
+
+            my $connLimit = $devdetails->snmpVar(
+                    $dd->oiddef('4.x_sslProxyConnLimit')
+                    . '.' .  $INDEX );
+
+
+
+            my $nick = $origIp . '_' . $origPort . '_' . $destIp .
+                    '_' . $destPort;
+
+            my $param = {};
+            $ref->{$INDEX}->{'param'} = $param;
+            $param->{'nick'} = $nick;
+            $param->{'descr'} = "Stats for SSL Proxy Address: " .
+                    "${origIp}:${origPort} -> ${destIp}:${destPort}";
+            $param->{'INDEX'} = $INDEX;
+            $param->{'connLimit'} = $connLimit;
+
+        }
+
+
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+
+    my $bigIpName = 'BigIp_Global_Stats';
+
+    my $bigIpParam = {
+        'precedence'         => '-100',
+        'comment'            => 'BigIp Global Stats',
+        'rrd-create-dstype'  => 'GAUGE', };
+
+    if( $devdetails->hasCap('BigIp_4.x') )
+    {
+        my $bigIpStatsNode = $cb->addSubtree( $devNode, $bigIpName,
+                $bigIpParam, [ 'F5BigIp::BigIp_4.x' ]);
+
+        if( $devdetails->hasCap('BigIp_ssl') )
+        {
+            $cb->addTemplateApplication
+                ( $bigIpStatsNode , 'F5BigIp::BigIp_4.x_sslProxy_Global' );
+        }
+    }
+    elsif( $devdetails->hasCap('BigIp_3.x') )
+    {
+        $cb->addSubtree( $devNode, $bigIpName, $bigIpParam,
+                         [ 'F5BigIp::BigIp_3.x' ]);
+    }
+
+    my $virtName = 'BigIp_VirtualServers';
+
+    my $virtParam = {
+        'precedence'        => '-200',
+        'comment'           => 'Virtual Server(VIP) Stats',
+    };
+
+    my $virtTree;
+
+    if( $devdetails->hasCap('BigIp_4.x_VirtualServer') )
+    {
+        my @templates =
+            ( 'F5BigIp::BigIp_4.x_virtualServer-actvconn-overview' );
+        #    'F5BigIp::BigIp_4.x_virtualServer-connrate-overview');
+
+        $virtTree =
+            $cb->addSubtree( $devNode, $virtName, $virtParam, \@templates );
+
+        my $ref = $data->{'virtualServer'};
+
+        foreach my $INDEX ( @{ $ref->{'indices'} } )
+        {
+            my $server = $ref->{$INDEX}->{'param'};
+
+            $server->{'precedence'} = '-100';
+
+            $cb->addSubtree( $virtTree, $server->{'nick'}, $server,
+                          [ 'F5BigIp::BigIp_4.x_virtualServer' ] );
+        }
+    }
+
+    my $poolName = 'BigIp_Pools';
+    my $poolParam = {
+        'precedence'        => '-300',
+        'comment'           => 'Pool Stats',
+    };
+
+    my $poolTree;
+
+    if( $devdetails->hasCap('BigIp_4.x_PoolTable') )
+    {
+        $poolTree =
+            $cb->addSubtree( $devNode, $poolName, $poolParam,
+                             ['F5BigIp::BigIp_4.x_pool-actvconn-overview']);
+        my $ref = $data->{'poolTable'};
+
+        foreach my $INDEX ( @{ $ref->{'indices'} } )
+        {
+            my $pool = $ref->{$INDEX}->{'param'};
+
+            $pool->{'precedence'} = '-100';
+
+            $cb->addSubtree( $poolTree, $pool->{'pool'}, $pool,
+                          [ 'F5BigIp::BigIp_4.x_pool' ] );
+        }
+
+    }
+
+    my $poolMemberName = 'BigIp_Pool_Members';
+
+    my $poolMemberParam = {
+        'precedence'        => '-400',
+        'comment'           => 'Pool Member Stats',
+    };
+
+    my $poolMemberTree;
+
+    if( $devdetails->hasCap('BigIp_4.x_PoolMemberTable') )
+    {
+        $poolMemberTree =
+            $cb->addSubtree( $devNode, $poolMemberName, $poolMemberParam );
+        my $ref = $data->{'poolMemberTable'};
+
+        foreach my $INDEX ( @{ $ref->{'indices'} } )
+        {
+            my $poolMemberPoolTree;
+            my $lastPoolTree;
+            my $server = $ref->{$INDEX}->{'param'};
+
+            my $poolMemberPoolName = $server->{'pool'};
+            my $poolMemberPoolParam = {
+                'precidence'    => '-100',
+                'comment'       => "Members of the $server->{'pool'} Pool",
+            };
+
+
+            if( not defined( $lastPoolTree ) or
+                $poolMemberPoolName !~ /\b$lastPoolTree\b/ )
+            {
+                my @templates =
+                    ( 'F5BigIp::BigIp_4.x_poolMember-actvconn-overview' );
+                $poolMemberPoolTree =
+                    $cb->addSubtree( $poolMemberTree, $poolMemberPoolName,
+                                     $poolMemberPoolParam, \@templates );
+
+                $lastPoolTree = $poolMemberPoolName;
+
+                $server->{'precedence'} = '-100';
+
+                $cb->addSubtree( $poolMemberPoolTree, $server->{'nick'}, $server,
+                              [ 'F5BigIp::BigIp_4.x_poolMember' ] );
+            }
+        }
+    }
+
+
+    # BigIP SSL Product Support
+    if( $devdetails->hasCap('BigIp_4.x_sslProxyTable') )
+    {
+
+        my $bigIpSSLProxies = 'BigIp_SSL_Proxies';
+
+        my $bigIpSSLParam = {
+            'comment'            => 'BigIp SSL Proxies',
+            'rrd-create-dstype'  => 'COUNTER', };
+
+        my $sslProxyTree = $cb->addSubtree(
+                    $devNode, $bigIpSSLProxies, $bigIpSSLParam,
+                    [ 'F5BigIp::BigIp_4.x_sslProxy-currconn-overview' ]);
+
+        my $ref = $data->{'sslProxyTable'};
+
+        foreach my $INDEX ( @{ $ref->{'indices'} } )
+        {
+            my $proxy = $ref->{$INDEX}->{'param'};
+
+            $cb->addSubtree( $sslProxyTree, $proxy->{'nick'}, $proxy,
+                    [ 'F5BigIp::BigIp_4.x_sslProxy' ] );
+        }
+
+    }
+
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/FTOS.pm b/torrus/perllib/Torrus/DevDiscover/FTOS.pm
new file mode 100644
index 000000000..82629e2df
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/FTOS.pm
@@ -0,0 +1,378 @@
+#
+#  Copyright (C) 2009  Jon Nistor
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: FTOS.pm,v 1.1 2010-12-27 00:03:54 ivan Exp $
+# Jon Nistor <nistor at snickers.org>
+
+# Force10 Networks Real Time Operating System Software
+#
+# NOTE: FTOS::disable-cpu
+#       FTOS::disable-power
+#       FTOS::disable-temperature
+#       FTOS::use-fahrenheit
+#       FTOS::file-per-sensor (affects both power and temperature)
+
+package Torrus::DevDiscover::FTOS;
+
+use strict;
+use Torrus::Log;
+
+$Torrus::DevDiscover::registry{'FTOS'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # FORCE10-SMI
+     'f10Products'           => '1.3.6.1.4.1.6027.1',
+
+     # F10-CHASSIS-MIB
+     'chType'                => '1.3.6.1.4.1.6027.3.1.1.1.1.0',
+     'chSerialNumber'        => '1.3.6.1.4.1.6027.3.1.1.1.2.0',
+     'chSysPowerSupplyIndex' => '1.3.6.1.4.1.6027.3.1.1.2.1.1.1',
+     'chSysCardSlotIndex'    => '1.3.6.1.4.1.6027.3.1.1.2.3.1.1',
+     'chSysCardNumber'       => '1.3.6.1.4.1.6027.3.1.1.2.3.1.3',
+     'chRpmCpuIndex'         => '1.3.6.1.4.1.6027.3.1.1.3.7.1.1',
+
+     # FORCE10-SYSTEM-COMPONENT-MIB
+     'camUsagePartDesc'      => '1.3.6.1.4.1.6027.3.7.1.1.1.1.4'
+     );
+
+
+our %f10ChassisType =
+    (
+     '1'   => 'Force10 E1200 16-slot switch/router',
+     '2'   => 'Force10 E600 9-slot switch/router',
+     '3'   => 'Force10 E300 8-slot switch/router',
+     '4'   => 'Force10 E150 8-slot switch/router',
+     '5'   => 'Force10 E610 9-slot switch/router',
+     '6'   => 'Force10 C150 6-slot switch/router',
+     '7'   => 'Force10 C300 10-slot switch/router',
+     '8'   => 'Force10 E1200i 16-slot switch/router',
+     '9'   => 'Force10 S2410 10GbE switch',
+     '10'  => 'Force10 S2410 10GbE switch',
+     '11'  => 'Force10 S50 access switch',
+     '12'  => 'Force10 S50e access switch',
+     '13'  => 'Force10 S50v access switch',
+     '14'  => 'Force10 S50nac access switch',
+     '15'  => 'Force10 S50ndc access switch',
+     '16'  => 'Force10 S25pdc access switch',
+     '17'  => 'Force10 S25pac access switch',
+     '18'  => 'Force10 S25v access switch',
+     '19'  => 'Force10 S25n access switch'
+     );
+
+our %f10CPU =
+    (
+     '1'   => 'Control Processor',
+     '2'   => 'Routing Processor #1',
+     '3'   => 'Routing Processor #2'
+     );
+
+
+# Not all interfaces are normally needed to monitor.
+# You may override the interface filtering in devdiscover-siteconfig.pl:
+# redefine $Torrus::DevDiscover::FTOS::interfaceFilter
+# or define $Torrus::DevDiscover::FTOS::interfaceFilterOverlay
+
+our $interfaceFilter;
+our $interfaceFilterOverlay;
+my %ftosInterfaceFilter;
+
+if( not defined( $interfaceFilter ) )
+{
+    $interfaceFilter = \%ftosInterfaceFilter;
+}
+
+
+# Key is some unique symbolic name, does not mean anything
+#  ifType is the number to match the interface type
+# ifDescr is the regexp to match the interface description
+%ftosInterfaceFilter =
+    (
+     'other' => {
+         'ifType'  => 1,                     # other
+     },
+     'loopback' => {
+         'ifType'  => 24,                    # softwareLoopback
+     },
+     
+     );
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'f10Products',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+    
+    # Systems running FTOS will have chassisType, SFTOS will not.
+    if( not $dd->checkSnmpOID('chType') )
+    {
+        return 0;
+    }
+    
+    &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+        ($devdetails, $interfaceFilter);
+    
+    if( defined( $interfaceFilterOverlay ) )
+    {
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilterOverlay);
+    }
+
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # NOTE: Comments and Serial number of device
+    my $chassisSerial = $dd->retrieveSnmpOIDs( 'chType', 'chSerialNumber' );
+
+    if( defined( $chassisSerial ) )
+    {
+        $data->{'param'}{'comment'} =
+            %f10ChassisType->{$chassisSerial->{'chType'}} .
+            ', Hw Serial#: ' . $chassisSerial->{'chSerialNumber'};
+    }
+    else
+    {
+        $data->{'param'}{'comment'} = "Force10 Networks switch/router";
+    }
+
+    # PROG: CPU statistics
+    if( $devdetails->param('FTOS::disable-cpu') ne 'yes' )
+    {
+        # Poll table to translate the CPU Index to a Name
+        my $ftosCpuTable =
+            $session->get_table( -baseoid => $dd->oiddef('chRpmCpuIndex') );
+
+        $devdetails->storeSnmpVars( $ftosCpuTable );
+
+        if( defined( $ftosCpuTable ) )
+        {
+            $devdetails->setCap('ftosCPU');
+
+            # Find the index of the CPU
+            foreach my $ftosCPUidx ( $devdetails->getSnmpIndices
+                                     ( $dd->oiddef('chRpmCpuIndex') ) )
+            {
+                my $cpuType = $dd->oiddef('chRpmCpuIndex') . "." . $ftosCPUidx;
+                my $cpuName = %f10CPU->{$ftosCpuTable->{$cpuType}};
+
+                Debug("FTOS::CPU index $ftosCPUidx, $cpuName");
+
+                # Construct the data ...
+                $data->{'ftosCPU'}{$ftosCPUidx} = $cpuName;
+            }
+        }
+        else
+        {
+            Debug("FTOS::CPU No CPU information found, old sw?");
+        }
+    } # END: CPU
+
+
+    # PROG: Power Supplies
+    if( $devdetails->param('FTOS::disable-power') ne 'yes' )
+    {
+        # Poll table of power supplies
+        my $ftosPSUTable =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('chSysPowerSupplyIndex') );
+
+        $devdetails->storeSnmpVars( $ftosPSUTable );
+
+        if( defined( $ftosPSUTable ) )
+        {
+            $devdetails->setCap('ftosPSU');
+
+            # Find the Index of the Power Supplies
+            foreach my $ftosPSUidx ( $devdetails->getSnmpIndices
+                                     ($dd->oiddef('chSysPowerSupplyIndex')) )
+            {
+                Debug("FTOS::PSU index $ftosPSUidx");
+
+                push( @{$data->{'ftosPSU'}}, $ftosPSUidx );
+            }
+        }
+    } # END: PSU
+
+
+    # PROG: Temperature
+    if( $devdetails->param('FTOS::disable-sensors') ne 'yes' )
+    {
+        # Check if temperature sensors are supported
+        my $sensorTable =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('chSysCardSlotIndex') );
+        $devdetails->storeSnmpVars( $sensorTable );
+
+        my $sensorCard =
+            $session->get_table( -baseoid => $dd->oiddef('chSysCardNumber') );
+        $devdetails->storeSnmpVars( $sensorCard );
+
+
+        if( defined( $sensorTable ) )
+        {
+            $devdetails->setCap('ftosSensor');
+            
+            foreach my $sensorIdx ( $devdetails->getSnmpIndices
+                                    ( $dd->oiddef('chSysCardSlotIndex') ) )
+            {
+                my $sensorCard =
+                    $devdetails->snmpVar( $dd->oiddef('chSysCardNumber') .
+                                          '.' . $sensorIdx );
+
+                $data->{'ftosSensor'}{$sensorIdx} = $sensorCard;
+
+                Debug("FTOS::Sensor index $sensorIdx, card $sensorCard");
+            }
+        } # END if: $sensorTable
+    } # END: disable-sensors
+
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+
+    # PROG: CPU processing
+    if( $devdetails->hasCap('ftosCPU') )
+    {
+        my $nodeTop = $cb->addSubtree( $devNode, 'CPU_Usage', undef,
+                                       [ 'FTOS::ftos-cpu-subtree'] );
+
+        foreach my $CPUidx ( sort {$a <=> $b} keys %{$data->{'ftosCPU'}} )
+        {
+            my $CPUName = $data->{'ftosCPU'}{$CPUidx};
+            my $subName = sprintf( 'CPU_%.2d', $CPUidx );
+
+            my $nodeCPU = $cb->addSubtree( $nodeTop, $subName,
+                                           { 'comment'   => $CPUName,
+                                             'cpu-index' => $CPUidx,
+                                             'cpu-name'  => $CPUName },
+                                           [ 'FTOS::ftos-cpu' ] );
+        }
+    } # END if ftosCPU
+
+
+    # PROG: Power supplies
+    if( $devdetails->hasCap('ftosPSU') )
+    {
+        my $subtreeName = "Power_Supplies";
+        my $param       = { 'comment'    => 'Power supplies status',
+                            'precedence' => -600 };
+        my $filePerSensor 
+            = $devdetails->param('FTOS::file-per-sensor') eq 'yes';
+        my $templates   = [];
+
+        $param->{'data-file'} = '%snmp-host%_power' .
+            ($filePerSensor ? '_%power-index%':'') .
+            '.rrd';
+
+        my $nodeTop = $cb->addSubtree( $devNode, $subtreeName,
+                                       $param, $templates );
+
+
+        foreach my $PSUidx ( sort {$a <=> $b} @{$data->{'ftosPSU'}} )
+        {
+            my $leafName = sprintf( 'power_%.2d', $PSUidx );
+
+            my $nodePSU = $cb->addLeaf( $nodeTop, $leafName, 
+                                        { 'power-index' => $PSUidx },
+                                        [ 'FTOS::ftos-power-supply-leaf' ]);
+        }
+    }
+
+
+    # PROG: Temperature sensors
+    if( $devdetails->hasCap('ftosSensor') )
+    {
+        my $subtreeName = "Temperature_Sensors";
+        my $param       = {};
+        my $fahrenheit  = $devdetails->param('FTOS::use-fahrenheit') eq 'yes';
+        my $filePerSensor 
+            = $devdetails->param('FTOS::file-per-sensor') eq 'yes';
+        my $templates   = [ 'FTOS::ftos-temperature-subtree' ];
+
+        $param->{'data-file'} = '%snmp-host%_sensors' .
+            ($filePerSensor ? '_%sensor-index%':'') .
+            ($fahrenheit ? '_fahrenheit':'') . '.rrd';
+
+        my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName,
+                                           $param, $templates );
+
+        foreach my $sIndex ( sort {$a<=>$b} keys %{$data->{'ftosSensor'}} )
+        {
+            my $leafName   = sprintf( 'sensor_%.2d', $sIndex );
+            my $threshold  = 60;  # Forced value for the time being, 60 degC
+            my $sensorCard = $data->{'ftosSensor'}{$sIndex};
+
+            if( $fahrenheit )
+            {
+                $threshold = $threshold * 1.8 + 32;
+            }
+
+            my $param = {
+                'sensor-index'       => $sIndex,
+                'sensor-description' => 'Module ' . $sensorCard,
+                'upper-limit'        => $threshold
+                };
+
+            my $templates = ['FTOS::ftos-temperature-sensor' .
+                             ($fahrenheit ? '-fahrenheit':'')];
+
+            $cb->addLeaf( $subtreeNode, $leafName, $param, $templates );
+        } 
+    }
+}
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/Foundry.pm b/torrus/perllib/Torrus/DevDiscover/Foundry.pm
new file mode 100644
index 000000000..8c9ef2c96
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Foundry.pm
@@ -0,0 +1,566 @@
+#  Copyright (C) 2008 Roman Hochuli
+#  Copyright (C) 2010 Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Foundry.pm,v 1.1 2010-12-27 00:03:48 ivan Exp $
+# Roman Hochuli <roman@hochu.li>
+
+# Common Foundry MIBs, supported by IronWare-Devices
+
+package Torrus::DevDiscover::Foundry;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'Foundry'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # FOUNDRY-SN-ROOT-MIB
+     'fdry'                              => '1.3.6.1.4.1.1991',
+     
+     # FOUNDRY-SN-AGENT-MIB
+     'fdrySnChasSerNum'                  => '1.3.6.1.4.1.1991.1.1.1.1.2.0',
+     'fdrySnChasGen'                     => '1.3.6.1.4.1.1991.1.1.1.1.13',
+     'fdrySnChasIdNumber'                => '1.3.6.1.4.1.1991.1.1.1.1.17.0',
+     'fdrySnChasArchitectureType'        => '1.3.6.1.4.1.1991.1.1.1.1.25.0',
+     'fdrySnChasProductType'             => '1.3.6.1.4.1.1991.1.1.1.1.26.0',
+
+     # FOUNDRY-SN-AGENT-MIB
+     'fdrySnChasActualTemperature'       => '1.3.6.1.4.1.1991.1.1.1.1.18.0',
+     'fdrySnChasWarningTemperature'      => '1.3.6.1.4.1.1991.1.1.1.1.19.0',
+     'fdrySnChasShutdownTemperature'     => '1.3.6.1.4.1.1991.1.1.1.1.20.0',
+     'fdrySnAgImgVer'                    => '1.3.6.1.4.1.1991.1.1.2.1.11',
+     'fdrySnAgentTempTable'              => '1.3.6.1.4.1.1991.1.1.2.13.1',
+     'fdrySnAgentTempSensorDescr'        => '1.3.6.1.4.1.1991.1.1.2.13.1.1.3',
+     'fdrySnAgentTempValue'              => '1.3.6.1.4.1.1991.1.1.2.13.1.1.4',
+
+     # FOUNDRY-SN-AGENT-MIB
+     'fdrySnAgGblCpuUtilData'            => '1.3.6.1.4.1.1991.1.1.2.1.35',
+     'fdrySnAgGblCpuUtil1SecAvg'         => '1.3.6.1.4.1.1991.1.1.2.1.50',
+     'fdrySnAgGblCpuUtil5SecAvg'         => '1.3.6.1.4.1.1991.1.1.2.1.51',
+     'fdrySnAgGblCpuUtil1MinAvg'         => '1.3.6.1.4.1.1991.1.1.2.1.52',
+     'fdrySnAgentCpuUtilValue'           => '1.3.6.1.4.1.1991.1.1.2.11.1.1.4',
+     'fdrySnAgentCpuUtil100thPercent'    => '1.3.6.1.4.1.1991.1.1.2.11.1.1.6',
+
+     # FOUNDRY-SN-AGENT-MIB
+     'fdrySnAgentBrdTbl'                 => '1.3.6.1.4.1.1991.1.1.2.2.1.1',
+     'fdrySnAgentBrdMainBrdDescription'  => '1.3.6.1.4.1.1991.1.1.2.2.1.1.2',
+     'fdrySnAgentBrdMainPortTotal'       => '1.3.6.1.4.1.1991.1.1.2.2.1.1.4',
+     'fdrySnAgentBrdModuleStatus'        => '1.3.6.1.4.1.1991.1.1.2.2.1.1.12',
+     # Not listed in FOUNDRY-SN-AGENT-MIB, but in release notes
+     'fdrySnAgentBrdMemoryTotal'         => '1.3.6.1.4.1.1991.1.1.2.2.1.1.24',
+     'fdrySnAgentBrdMemoryAvailable'     => '1.3.6.1.4.1.1991.1.1.2.2.1.1.25',
+     );
+
+
+# Not all interfaces are normally needed to monitor.
+# You may override the interface filtering in devdiscover-siteconfig.pl:
+# redefine $Torrus::DevDiscover::Foundry::interfaceFilter
+# or define $Torrus::DevDiscover::Foundry::interfaceFilterOverlay
+
+our $interfaceFilter;
+our $interfaceFilterOverlay;
+my %fdryInterfaceFilter;
+
+if( not defined( $interfaceFilter ) )
+{
+    $interfaceFilter = \%fdryInterfaceFilter;
+}
+
+# Key is some unique symbolic name, does not mean anything
+# ifType is the number to match the interface type
+# ifDescr is the regexp to match the interface description
+%fdryInterfaceFilter =
+    (
+     'lb' => {
+         'ifType'  => 24,                    # softwareLoopback
+     },
+     
+     'v' => {
+         'ifType'  => 135,                   # l2vlan
+     },
+
+     'tnl' => {
+         'ifType'  => 150,                   # mplsTunnel
+     },
+     );
+
+
+
+my %productTypeAttr =
+    (
+     1 => {
+         'desc' => 'BigIron MG8',
+     },
+
+     2 => {
+         'desc' => 'NetIron 40G',
+     },
+
+     3 => {
+         'desc' => 'NetIron IMR 640',
+     },
+     
+     4 => {
+         'desc' => 'NetIron RX 800',
+     },
+     
+     5 => {
+         'desc' => 'NetIron XMR 16000',
+     },
+
+     6 => {
+         'desc' => 'NetIron RX 400',
+     },
+     
+     7 => {
+         'desc' => 'NetIron XMR 8000',
+     },
+
+     8 => {
+         'desc' => 'NetIron RX 200',
+     },
+
+     9 => {
+         'desc' => 'NetIron XMR 4000',
+     },
+     
+     13 => {
+         'desc' => 'NetIron MLX-32',
+     },
+
+     14 => {
+         'desc' => 'NetIron XMR 32000',
+     },
+
+     15 => {
+         'desc' => 'NetIron RX-32',
+     },
+
+     78 => {
+         'desc' => 'FastIron',
+     },
+
+     0 => {
+         'desc' => 'device',
+     },
+     );  
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+    my $retval = 0;
+
+    if( $dd->oidBaseMatch
+        ( 'fdry', $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        $retval = 1;
+
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilter);
+
+        if( defined( $interfaceFilterOverlay ) )
+        {
+            &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+                ($devdetails, $interfaceFilterOverlay);
+        }
+
+        $devdetails->setCap('interfaceIndexingPersistent');
+
+    }
+    
+    return $retval;
+}
+
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # NOTE: Comments and Serial number of device
+    
+    my $chassis = $dd->retrieveSnmpOIDs( 'fdrySnChasSerNum',
+                                         'fdrySnChasIdNumber',
+                                         'fdrySnChasArchitectureType',
+                                         'fdrySnChasProductType' );
+    
+    Debug('fdrySnChasSerNum=' . $chassis->{'fdrySnChasSerNum'});
+    Debug('fdrySnChasIdNumber=' . $chassis->{'fdrySnChasIdNumber'});
+    Debug('fdrySnChasArchitectureType=' .
+          $chassis->{'fdrySnChasArchitectureType'});
+    Debug('fdrySnChasProductType=' . $chassis->{'fdrySnChasProductType'});
+    
+    my $productType = 0;
+
+    if( defined( $chassis ) and
+        defined( $productTypeAttr{$chassis->{'fdrySnChasProductType'}} ) )
+    {
+        $productType = $chassis->{'fdrySnChasProductType'};
+    }
+
+    my $deviceComment = 'Brocade ' . $productTypeAttr{$productType}{'desc'};
+        
+    if( defined( $chassis ) )
+    {
+        if( defined( $chassis->{'fdrySnChasSerNum'} ) )
+        {
+            $deviceComment .= ', Chassis S/N: ' .
+                $chassis->{'fdrySnChasSerNum'};
+        }
+        
+        if( defined( $chassis->{'fdrySnChasIdNumber'} ) and
+            $chassis->{'fdrySnChasIdNumber'} ne '' )
+        {
+            $deviceComment .= ', Chassis ID: ' .
+                $chassis->{'fdrySnChasIdNumber'};
+        }
+    }
+
+    $data->{'param'}{'comment'} = $deviceComment;
+
+    
+    my $chasTemp = $dd->retrieveSnmpOIDs( 'fdrySnChasActualTemperature',
+                                          'fdrySnChasWarningTemperature',
+                                          'fdrySnChasShutdownTemperature');
+
+    if( defined($chasTemp) and
+        defined($chasTemp->{'fdrySnChasActualTemperature'}) )
+    {
+        $devdetails->setCap('snChasActualTemperature');
+
+        $data->{'fdryChasTemp'}{'warning'} =
+            $chasTemp->{'fdrySnChasWarningTemperature'};
+        $data->{'fdryChasTemp'}{'shutdown'} =
+            $chasTemp->{'fdrySnChasShutdownTemperature'};        
+    }
+       
+    if( $dd->checkSnmpTable('fdrySnAgentBrdTbl') )
+    {
+        $devdetails->setCap('fdryBoardStats'); 
+        $data->{'fdryBoard'} = {};
+
+        # get only the modules with
+        # snAgentBrdModuleStatus = moduleRunning(10)
+        {
+            my $base = $dd->oiddef('fdrySnAgentBrdModuleStatus');
+            my $table = $session->get_table( -baseoid => $base );        
+            my $prefixLen = length( $base ) + 1;
+            
+            while( my( $oid, $status ) = each %{$table} )
+            {
+                if( $status == 10 )
+                {
+                    my $brdIndex = substr( $oid, $prefixLen );
+                    $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} = 1;
+                }
+            }
+        }
+        
+        # get module descriptions
+        {
+            my $oid = $dd->oiddef('fdrySnAgentBrdMainBrdDescription');
+            my $table = $session->get_table( -baseoid => $oid );        
+            my $prefixLen = length( $oid ) + 1;
+            
+            while( my( $oid, $descr ) = each %{$table} )
+            {
+                if( length($descr) > 0 )
+                {
+                    my $brdIndex = substr( $oid, $prefixLen );
+                    
+                    if( $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} )
+                    {
+                        $data->{'fdryBoard'}{$brdIndex}{'description'} =
+                            $descr;
+                    }
+                }
+            }
+        }
+
+        # Non-chassis Foundry products set the description to "Invalid Module"
+        if( scalar(keys %{$data->{'fdryBoard'}}) == 1 and
+            $data->{'fdryBoard'}{1}{'moduleRunning'} )
+        {
+            $data->{'fdryBoard'}{1}{'description'} = 'Management';
+        }
+
+        # check if memory statistics are available
+        {
+            my $base = $dd->oiddef('fdrySnAgentBrdMemoryTotal');
+            my $table = $session->get_table( -baseoid => $base );        
+            my $prefixLen = length( $base ) + 1;
+            
+            while( my( $oid, $memory ) = each %{$table} )
+            {
+                if( $memory > 0 )
+                {
+                    my $brdIndex = substr( $oid, $prefixLen );
+                    
+                    if( $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} )
+                    {
+                        $data->{'fdryBoard'}{$brdIndex}{'memory'} = 1;
+                    }
+                }
+            }
+        }
+
+        # check if CPU stats are available
+        # FOUNDRY-SN-AGENT-MIB::snAgentCpuUtilValue.1.1.1 = Gauge32: 1
+        # FOUNDRY-SN-AGENT-MIB::snAgentCpuUtilValue.1.1.5 = Gauge32: 1
+        # FOUNDRY-SN-AGENT-MIB::snAgentCpuUtilValue.1.1.60 = Gauge32: 1
+        # FOUNDRY-SN-AGENT-MIB::snAgentCpuUtilValue.1.1.300 = Gauge32: 1
+        {
+            my $base = $dd->oiddef('fdrySnAgentCpuUtilValue');
+            my $table = $session->get_table( -baseoid => $base );
+            my $prefixLen = length( $base ) + 1;
+                
+            while( my( $oid, $val ) = each %{$table} )
+            {
+                my $brdIndex = substr( $oid, $prefixLen );
+                $brdIndex =~ s/\.(.+)$//o;
+                if( $1 eq '1.1' and
+                    $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} )
+                {
+                    $data->{'fdryBoard'}{$brdIndex}{'cpu'} = 1;
+                }
+            }
+        }
+
+        # snAgentCpuUtil100thPercent: supported on NetIron XMR and NetIron
+        # MLX devices running software release 03.9.00 and later, FGS release
+        # 04.3.01 and later, and FSX 04.3.00 and later.
+        # snAgentCpuUtilValue is deprecated in these releases
+        {
+            my $base = $dd->oiddef('fdrySnAgentCpuUtil100thPercent');
+            my $table = $session->get_table( -baseoid => $base );
+            my $prefixLen = length( $base ) + 1;
+                
+            while( my( $oid, $val ) = each %{$table} )
+            {
+                my $brdIndex = substr( $oid, $prefixLen );
+                $brdIndex =~ s/\.(.+)$//o;
+                if( $1 eq '1.1' and
+                    $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} )
+                {
+                    $data->{'fdryBoard'}{$brdIndex}{'cpu-new'} = 1;
+                }
+            }
+        }        
+        
+        # check if temperature stats are available
+        # exclude the sensors which show zero
+        {
+            my $base = $dd->oiddef('fdrySnAgentTempSensorDescr');
+            my $table = $session->get_table( -baseoid => $base );        
+            my $prefixLen = length( $base ) + 1;
+
+            my $baseVal = $dd->oiddef('fdrySnAgentTempValue');
+            my $values = $session->get_table( -baseoid => $baseVal );
+            
+            while( my( $oid, $descr ) = each %{$table} )
+            {
+                my $index = substr( $oid, $prefixLen );
+                my ($brdIndex, $sensor) = split(/\./, $index);
+                
+                if( $data->{'fdryBoard'}{$brdIndex}{'moduleRunning'} and
+                    $values->{$baseVal . '.' . $index} > 0 )
+                {
+                    $data->{'fdryBoard'}{$brdIndex}{'temperature'}{$sensor} =
+                        $descr;
+                    $devdetails->setCap('fdryBoardTemperature'); 
+                }
+            }
+        }                    
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    # Chassis Temperature Sensors
+    if( $devdetails->hasCap('snChasActualTemperature') and not
+        $devdetails->hasCap('fdryBoardTemperature') )
+    {
+        my $param = {
+            'fdry-chastemp-warning' => $data->{'fdryChasTemp'}{'warning'}/2,
+            'fdry-chastemp-shutdown' => $data->{'fdryChasTemp'}{'shutdown'}/2,
+        };
+                         
+        my $templates = [ 'Foundry::fdry-chass-temperature' ];
+
+        $cb->addLeaf( $devNode, 'Chassis_Temperature',
+                      $param, $templates );
+    }
+    
+    # Board Stats
+    if( $devdetails->hasCap('fdryBoardStats') )
+    {
+        my $brdNode = $devNode;
+        if( scalar(keys %{$data->{'fdryBoard'}}) > 1 )
+        {
+            my $param = {
+                'node-display-name' => 'Linecard Statistics',
+                'comment' => 'CPU, Memory, and Temperature information',
+            };
+            
+            $brdNode =
+                $cb->addSubtree( $devNode, 'Linecard_Statistics', $param );
+        }
+       
+        $cb->addTemplateApplication( $brdNode,
+                                     'Foundry::fdry-board-overview' );
+        
+            
+        foreach my $brdIndex ( sort {$a <=> $b} keys %{$data->{'fdryBoard'}} )
+        {
+            my $descr = $data->{'fdryBoard'}{$brdIndex}{'description'};
+            my $param = {
+                'comment'  => $descr,
+                'fdry-board-index' => $brdIndex,
+                'fdry-board-descr' => $descr,
+                'nodeid' => 'module//%nodeid-device%//' . $brdIndex,
+            };
+            
+            my $linecardNode =
+                $cb->addSubtree( $brdNode, 'Linecard_' . $brdIndex,
+                                 $param,
+                                 [ 'Foundry::fdry-board-subtree' ]);
+            
+            if( $data->{'fdryBoard'}{$brdIndex}{'memory'} )
+            {
+                $cb->addSubtree( $linecardNode, 'Memory_Statistics', {},
+                                 [ 'Foundry::fdry-board-memstats' ]);
+            }
+            
+
+            my $cpuOid;            
+            if( $data->{'fdryBoard'}{$brdIndex}{'cpu-new'} )
+            {
+                $cpuOid = '$fdrySnAgentCpuUtil100thPercent';
+            }
+            elsif( $data->{'fdryBoard'}{$brdIndex}{'cpu'} )                
+            {
+                $cpuOid = '$fdrySnAgentCpuUtilValue';
+            }
+
+            if( defined( $cpuOid ) )
+            {
+                
+                $cb->addSubtree
+                    ( $linecardNode, 'CPU_Statistics',
+                      {
+                          'fdry-cpu-base' => $cpuOid,
+                          'nodeid' => 'cpu//%nodeid-device%//' . $brdIndex,
+                      },
+                      [ 'Foundry::fdry-board-cpustats' ]);
+            }
+            
+            if( defined( $data->{'fdryBoard'}{$brdIndex}{'temperature'} ) )
+            {
+                my $tempNode =
+                    $cb->addSubtree( $linecardNode, 'Temperature_Statistics',
+                                     {}, ['Foundry::fdry-board-tempstats']);
+
+                # Build a multi-graph for all sensors
+                
+                my @colors =
+                    ('##one', '##two', '##three', '##four', '##five',
+                     '##six', '##seven', '##eight', '##nine', '##ten');
+
+                my $mgParam = {
+                    'comment' => 'Board temperature sensors combined',
+                    'ds-type' => 'rrd-multigraph',
+                    'vertical-label' => 'Degrees Celcius',
+                    'nodeid' => 'temp//%nodeid-device%//' . $brdIndex,
+                };
+
+                my @sensors;
+                
+                foreach my $sensor
+                    ( sort {$a <=> $b}
+                      keys %{$data->{'fdryBoard'}{$brdIndex}{'temperature'}} )
+                {
+                    my $leafName = 'sensor_' . $sensor;
+                    
+                    my $descr = $data->{'fdryBoard'}{$brdIndex}{
+                        'temperature'}{$sensor};
+
+                    my $short = 'Temperature sensor ' . $sensor;
+                    
+                    my $param = {
+                        'comment'            => $descr,
+                        'precedence'         => 1000 - $sensor,
+                        'sensor-index'       => $sensor,
+                        'sensor-short'       => $short,
+                        'sensor-description' => $descr,                        
+                    };
+                    
+                    $cb->addLeaf
+                        ( $tempNode, $leafName, $param,
+                          ['Foundry::fdry-board-temp-sensor-halfcelsius'] );
+                    
+                    push(@sensors, $leafName);
+                    
+                    $mgParam->{'ds-expr-' . $leafName} =
+                        '{' . $leafName . '}';
+                    $mgParam->{'graph-legend-' . $leafName} = $short;
+                    $mgParam->{'line-style-' . $leafName} = 'LINE2';
+
+                    my $color = shift @colors;
+                    if( not defined( $color ) )
+                    {
+                        Error('Too many sensors on one Foundry board');
+                        $color = '##black';
+                    }                    
+                    $mgParam->{'line-color-' . $leafName} = $color;
+                    
+                    $mgParam->{'line-order-' . $leafName} = $sensor;
+                }
+
+                $mgParam->{'ds-names'} = join(',', @sensors);
+
+                $cb->addLeaf( $tempNode, 'Temperature_Overview', $mgParam );
+            }
+        }
+    }
+}
+
+
+
+1;
diff --git a/torrus/perllib/Torrus/DevDiscover/Jacarta.pm b/torrus/perllib/Torrus/DevDiscover/Jacarta.pm
new file mode 100644
index 000000000..fdd6ee959
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Jacarta.pm
@@ -0,0 +1,210 @@
+#  Copyright (C) 2010 Roman Hochuli
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# $Id: Jacarta.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+
+# Sensor-MIBs of Jacarta iMeter-Products
+
+
+package Torrus::DevDiscover::Jacarta;
+
+use strict;
+use Torrus::Log;
+use Switch;
+use Data::Dumper;
+
+
+$Torrus::DevDiscover::registry{'Jacarta'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     'jacarta'             => '1.3.6.1.4.1.19011',
+     'sensorEntry'         => '1.3.6.1.4.1.19011.2.3.1.1',
+     'sensorIndex'         => '1.3.6.1.4.1.19011.2.3.1.1.1',
+     'sensorDescription'   => '1.3.6.1.4.1.19011.2.3.1.1.2',
+     'sensorType'          => '1.3.6.1.4.1.19011.2.3.1.1.3',
+     'sensorValue'         => '1.3.6.1.4.1.19011.2.3.1.1.4',
+     'sensorUnit'          => '1.3.6.1.4.1.19011.2.3.1.1.5',
+     );
+
+
+our %sensor_types =
+    (
+     2 => {
+         'template' => 'Jacarta::imeter-humi-sensor',
+         'max' => 'NetBotz::humi-max',
+     },
+     3 => {
+         'template' => 'Jacarta::imeter-temp-sensor',
+         'max' => 'NetBotz::dew-max',
+     },
+     5 => {
+         'template' => 'Jacarta::imeter-amps-sensor',
+         'max' => 'NetBotz::dew-max',
+     },     
+     
+     );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'jacarta',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+    
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    $data->{'Jacarta'} = {};
+    
+    my $sensorTable =
+        $session->get_table( -baseoid => $oiddef{'sensorEntry'} );
+
+    if( not defined( $sensorTable ) )
+    {
+        return 1;
+    }
+    
+    $devdetails->storeSnmpVars( $sensorTable );
+        
+    # store the sensor names to guarantee uniqueness
+    my %sensorNames;
+    
+    foreach my $INDEX
+        ($devdetails->getSnmpIndices( $oiddef{'sensorIndex'} ))
+    {
+        my $sensorType =
+            $devdetails->snmpVar( $oiddef{'sensorType'} . '.' .
+                                  $INDEX);
+        my $sensorName =
+            $devdetails->snmpVar( $oiddef{'sensorDescription'} . '.' .
+                                  $INDEX);
+        
+        if( not defined( $sensor_types{$sensorType} ) )
+        {
+            Error('Sensor ' . $INDEX . ' of unknown type: ' . $sensorType);
+            next;
+        }
+        
+        if( $sensorNames{$sensorName} )
+        {
+            Warn('Duplicate sensor names: ' . $sensorName);
+            $sensorNames{$sensorName}++;
+        }
+        else
+        {
+            $sensorNames{$sensorName} = 1;
+        }
+        
+        if( $sensorNames{$sensorName} > 1 )
+        {
+            $sensorName .= sprintf(' %d', $INDEX);
+        }
+        
+        my $leafName = $sensorName;
+        $leafName =~ s/\W/_/g;
+        
+        my $param = {
+            'imeter-sensor-index' => $INDEX,
+            'node-display-name' => $sensorName,
+            'graph-title' => $sensorName,
+            'precedence' => sprintf('%d', 1000 - $INDEX)
+            };
+
+        
+        if( defined( $sensor_types{$sensorType}{'max'} ) )
+        {
+            my $max =
+                $devdetails->param($sensor_types{$sensorType}{'max'});
+            
+            if( defined($max) and $max > 0 )
+            {
+                $param->{'upper-limit'} = $max;
+            }
+        }
+                
+        $data->{'Jacarta'}{$INDEX} = {
+            'param'    => $param,
+            'leafName' => $leafName,
+            'template' => $sensor_types{$sensorType}{'template'}};
+        
+        Debug('Found Sensor ' . $INDEX . ' of type ' . $sensorType .
+              ', named ' . $sensorName );
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    
+    my $data = $devdetails->data();
+    
+    my $param = {
+        'node-display-name' => 'Sensors',
+        'comment' => 'All sensors connected via this iMeter Master',
+    };
+    
+    my $sensorTree =
+        $cb->addSubtree( $devNode, 'Sensors', $param );
+
+    foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'Jacarta'}} )
+    {
+        my $ref = $data->{'Jacarta'}{$INDEX};
+        
+        $cb->addLeaf( $sensorTree, $ref->{'leafName'}, $ref->{'param'},
+                      [$ref->{'template'}] );
+    }
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/JunOS.pm b/torrus/perllib/Torrus/DevDiscover/JunOS.pm
new file mode 100644
index 000000000..ff5c3f8a0
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/JunOS.pm
@@ -0,0 +1,657 @@
+#
+#  Copyright (C) 2007  Jon Nistor
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: JunOS.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $
+# Jon Nistor <nistor at snickers.org>
+
+# Juniper JunOS Discovery Module
+#
+# NOTE: For Class of service, if you are noticing that you are not seeing
+#       all of your queue names show up, this is by design of Juniper.
+#       Solution: Put place-holder names for those queues such as:
+#                 "UNUSED-queue-#"
+#       This is in reference to JunOS 7.6
+#
+# NOTE: Options for this module:
+#       JunOS::disable-cos
+#       JunOS::disable-cos-red
+#       JunOS::disable-cos-tail
+#       JunOS::disable-firewall
+#       JunOS::disable-operating
+#       JunOS::disable-rpf
+
+package Torrus::DevDiscover::JunOS;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'JunOS'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+};
+
+
+our %oiddef =
+    (
+     # JUNIPER-SMI
+     'jnxProducts'          => '1.3.6.1.4.1.2636.1',
+     'jnxBoxDescr'          => '1.3.6.1.4.1.2636.3.1.2.0',
+     'jnxBoxSerialNo'       => '1.3.6.1.4.1.2636.3.1.3.0',
+
+     # Operating status
+     'jnxOperatingDescr'    => '1.3.6.1.4.1.2636.3.1.13.1.5',
+     'jnxOperatingTemp'     => '1.3.6.1.4.1.2636.3.1.13.1.7',
+     'jnxOperatingCPU'      => '1.3.6.1.4.1.2636.3.1.13.1.8',
+     'jnxOperatingISR'      => '1.3.6.1.4.1.2636.3.1.13.1.9',
+     'jnxOperatingDRAMSize' => '1.3.6.1.4.1.2636.3.1.13.1.10', # deprecated
+     'jnxOperatingBuffer'   => '1.3.6.1.4.1.2636.3.1.13.1.11',
+     'jnxOperatingMemory'   => '1.3.6.1.4.1.2636.3.1.13.1.15',
+
+     # Firewall filter
+     'jnxFWCounterDisplayFilterName' => '1.3.6.1.4.1.2636.3.5.2.1.6',
+     'jnxFWCounterDisplayName'       => '1.3.6.1.4.1.2636.3.5.2.1.7',
+     'jnxFWCounterDisplayType'       => '1.3.6.1.4.1.2636.3.5.2.1.8',
+
+     # Class of Service (jnxCosIfqStatsTable deprecated, use jnxCosQstatTable)
+     #             COS  - Class Of Service
+     #             RED  - Random Early Detection
+     #             PLP  - Packet Loss Priority
+     #             DSCP - Differential Service Code Point
+
+     'jnxCosFcIdToFcName'   => '1.3.6.1.4.1.2636.3.15.3.1.2',
+     'jnxCosQstatQedPkts'   => '1.3.6.1.4.1.2636.3.15.4.1.3',
+
+     # Reverse path forwarding
+     'jnxRpfStatsPackets'   => '1.3.6.1.4.1.2636.3.17.1.1.1.3'
+
+    );
+
+
+# Not all interfaces are normally needed to monitor.
+# You may override the interface filtering in devdiscover-siteconfig.pl:
+# redefine $Torrus::DevDiscover::JunOS::interfaceFilter
+# or define $Torrus::DevDiscover::JunOS::interfaceFilterOverlay
+
+our $interfaceFilter;
+our $interfaceFilterOverlay;
+my %junosInterfaceFilter;
+
+if( not defined( $interfaceFilter ) )
+{
+    $interfaceFilter = \%junosInterfaceFilter;
+}
+
+
+# Key is some unique symbolic name, does not mean anything
+# ifType is the number to match the interface type
+# ifDescr is the regexp to match the interface description
+%junosInterfaceFilter =
+    (
+     'lsi' => {
+         'ifType'  => 150,                   # mplsTunnel
+         'ifDescr' => '^lsi$'
+     },
+     
+     'other' => {
+         'ifType'  => 1,                     # other
+     },
+     
+     'loopback' => {
+         'ifType'  => 24,                    # softwareLoopback
+     },
+     
+     'propVirtual' => {
+         'ifType'  => 53,                    # propVirtual
+     },
+     
+     'gre_ipip_pime_pimd_mtun'  => {
+         'ifType'  => 131,                     # tunnel
+         'ifDescr' => '^(gre)|(ipip)|(pime)|(pimd)|(mtun)$'
+     },
+
+     'pd_pe_gr_ip_mt_lt' => {
+         'ifType'  => 131,                     # tunnel
+         'ifDescr' => '^(pd)|(pe)|(gr)|(ip)|(mt)|(lt)-\d+\/\d+\/\d+$'
+     },
+     
+     'ls' => {
+         'ifType'  => 108,                     # pppMultilinkBundle
+         'ifDescr' => '^ls-\d+\/\d+\/\d+$'
+     },
+    );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'jnxProducts',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) )
+        )
+    {
+        return 0;
+    }
+
+    &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+        ($devdetails, $interfaceFilter);
+    
+    if( defined( $interfaceFilterOverlay ) )
+    {
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilterOverlay);
+    }
+
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # NOTE: Comments and Serial number of device
+    my $chassisSerial =
+        $dd->retrieveSnmpOIDs( 'jnxBoxDescr', 'jnxBoxSerialNo' );
+
+    if( defined( $chassisSerial ) )
+    {
+        $data->{'param'}{'comment'} = $chassisSerial->{'jnxBoxDescr'} .
+            ', Hw Serial#: ' . $chassisSerial->{'jnxBoxSerialNo'};
+    } else
+    {
+        $data->{'param'}{'comment'} = "Juniper router";
+    }
+
+
+    # PROG: Class of Service
+    #
+    if( $devdetails->param('JunOS::disable-cos') ne 'yes' )
+    {
+        # Poll table to translate the CoS Index to a Name
+        my $cosQueueNumTable =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('jnxCosFcIdToFcName') );
+        $devdetails->storeSnmpVars( $cosQueueNumTable );
+
+        if( $cosQueueNumTable )
+        {
+            $devdetails->setCap('jnxCoS');
+
+            # Find the index of the CoS queue name    
+            foreach my $cosFcIndex ( $devdetails->getSnmpIndices
+                                     ($dd->oiddef('jnxCosFcIdToFcName')) )
+            {
+                my $cosFcNameOid = $dd->oiddef('jnxCosFcIdToFcName') . "." .
+                    $cosFcIndex;
+                my $cosFcName    = $cosQueueNumTable->{$cosFcNameOid};
+
+                Debug("JunOS::CoS  FC index: $cosFcIndex  name: $cosFcName");
+
+                # Construct the data ...
+                $data->{'jnxCos'}{'queue'}{$cosFcIndex} = $cosFcName;
+            }
+
+            # We need to find out all the interfaces that have CoS enabled
+            # on them. We will use jnxCosQstatQedPkts as our reference point.
+            my $cosIfIndex =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef('jnxCosQstatQedPkts') );
+            $devdetails->storeSnmpVars( $cosIfIndex );
+
+	    if( $cosIfIndex )            
+            {
+		foreach my $INDEX ( $devdetails->getSnmpIndices
+                                ($dd->oiddef('jnxCosQstatQedPkts')) )
+            	{
+                	my( $ifIndex, $cosQueueIndex ) = split( '\.', $INDEX );
+			$data->{'jnxCos'}{'ifIndex'}{$ifIndex} = 1;
+               	} 
+            }
+        }
+    } # END JunOS::disable-cos
+
+
+    # PROG: Grab and store description of parts
+    #
+    if( $devdetails->param('JunOS::disable-operating') ne 'yes' )
+    {
+        my $tableDesc = $session->get_table( -baseoid =>
+                                             $dd->oiddef('jnxOperatingDescr'));
+        $devdetails->storeSnmpVars( $tableDesc );
+
+        if ( $tableDesc )
+        {
+            # PROG: Set Capability flag
+            $devdetails->setCap('jnxOperating');
+
+            # PROG: Poll tables for more info to match and index on
+            my $tableCPU =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef('jnxOperatingCPU'));
+            $devdetails->storeSnmpVars( $tableCPU );
+
+            my $tableISR =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef('jnxOperatingISR'));
+            $devdetails->storeSnmpVars( $tableISR );
+
+            my $tableMEM =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef('jnxOperatingMemory'));
+            $devdetails->storeSnmpVars( $tableMEM );
+
+            my $tableTemp =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef('jnxOperatingTemp'));
+            $devdetails->storeSnmpVars( $tableTemp );
+
+            # PROG: Build tables for all the oids
+            #       We are using the Descr oid base for matching. (cheap hack)
+            foreach my $opIndex ( $devdetails->getSnmpIndices
+                                  ($dd->oiddef('jnxOperatingDescr')) )
+            {
+                my $opCPU  = $devdetails->snmpVar
+                    ($dd->oiddef('jnxOperatingCPU') . '.' . $opIndex);
+                my $opDesc = $devdetails->snmpVar
+                    ($dd->oiddef('jnxOperatingDescr') . '.' . $opIndex);
+                my $opMem  = $devdetails->snmpVar
+                    ($dd->oiddef('jnxOperatingMemory') . '.' . $opIndex);
+                my $opISR  = $devdetails->snmpVar
+                    ($dd->oiddef('jnxOperatingISR') . '.' . $opIndex);
+                my $opTemp = $devdetails->snmpVar
+                    ($dd->oiddef('jnxOperatingTemp')  . '.' . $opIndex);
+
+                Debug("JunOS:: opIdx: $opIndex  Desc: $opDesc");
+                Debug("JunOS::   CPU: $opCPU, CPU: $opISR, MEM: $opMem");
+                Debug("JunOS::   Temp: $opTemp");
+
+                # Construct the data
+                $data->{'jnxOperating'}{$opIndex}{'index'} = $opIndex;
+                $data->{'jnxOperating'}{$opIndex}{'cpu'}   = $opCPU;
+                $data->{'jnxOperating'}{$opIndex}{'desc'}  = $opDesc;
+                $data->{'jnxOperating'}{$opIndex}{'isr'}   = $opISR;
+                $data->{'jnxOperating'}{$opIndex}{'mem'}   = $opMem;
+                $data->{'jnxOperating'}{$opIndex}{'temp'}  = $opTemp;
+            }
+        } # END: if $tableDesc
+    } # END: JunOS::disable-operating
+
+
+    # PROG: Firewall statistics
+    if( $devdetails->param('JunOS::disable-firewall') ne 'yes' )
+    {
+        my $tableFWFilter =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('jnxFWCounterDisplayFilterName'));
+        $devdetails->storeSnmpVars( $tableFWFilter );
+
+        if( $tableFWFilter )
+        {
+            # PROG: Set Capability flag
+            $devdetails->setCap('jnxFirewall');
+
+            # PROG: Poll tables for more info to match and index on
+            my $tableFWCounter =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef('jnxFWCounterDisplayName') );
+            $devdetails->storeSnmpVars( $tableFWCounter );
+
+            # Firewall Type (counter = 2, policer = 3)
+            my $tableFWType  =
+                $session->get_table( -baseoid =>
+                                     $dd->oiddef('jnxFWCounterDisplayType') );
+            $devdetails->storeSnmpVars( $tableFWType );
+
+            # PROG: Build tables for all the oids
+            #       We are using the FW Filter name as the Indexing
+            foreach my $fwIndex ( $devdetails->getSnmpIndices
+                                  ($dd->oiddef('jnxFWCounterDisplayName')) )
+            {
+                my $fwFilter = $devdetails->snmpVar
+                    ($dd->oiddef('jnxFWCounterDisplayFilterName') .
+                     '.' . $fwIndex);
+                my $fwCounter  = $devdetails->snmpVar
+                    ($dd->oiddef('jnxFWCounterDisplayName') .
+                     '.' . $fwIndex);
+                my $fwType = $devdetails->snmpVar
+                    ($dd->oiddef('jnxFWCounterDisplayType') .
+                     '.' . $fwIndex);
+                Debug("JunOS::fw Filter: $fwFilter");
+                Debug("JunOS::fw         Counter: $fwCounter");
+                Debug("JunOS::fw            Type: $fwType");
+
+                # Construct the data
+                $data->{'jnxFirewall'}{$fwFilter}{$fwCounter}{'oid'} =
+                    $fwIndex;
+                $data->{'jnxFirewall'}{$fwFilter}{$fwCounter}{'type'} =
+                    $fwType;
+            }
+        } # END: if $tableFWfilter
+    } # END: JunOS::diable-firewall
+
+
+    # PROG: Check for RPF availability
+    if( $devdetails->param('JunOS::disable-rpf') ne 'yes' )
+    {
+        my $tableRPF =
+            $session->get_table( -baseoid =>
+                                 $dd->oiddef('jnxRpfStatsPackets') );
+        $devdetails->storeSnmpVars( $tableRPF );
+
+        if( $tableRPF )
+        {
+            # PROG: Set capability flag
+            $devdetails->setCap('jnxRPF');
+
+            # PROG: Find all the relevent interfaces
+            foreach my $rpfIndex ( $devdetails->getSnmpIndices
+                                   ($dd->oiddef('jnxRpfStatsPackets')) )
+            {
+                my ($ifIndex,$addrFamily) = split('\.',$rpfIndex);
+                if( defined( $data->{'interfaces'}{$ifIndex} ) )
+                {
+                    my $ifAddrFam = $addrFamily == 1 ? 'ipv4' : 'ipv6';
+                    my $intName   = $data->{'interfaces'}{$ifIndex}{'ifName'};
+                    my $intNameT  = $data->{'interfaces'}{$ifIndex}{'ifNameT'};
+                    
+                    # Construct data
+                    $data->{'jnxRPF'}{$ifIndex}{'ifName'}  = $intName;
+                    $data->{'jnxRPF'}{$ifIndex}{'ifNameT'} = $intNameT;
+                    
+                    if( $addrFamily == 1 )
+                    {
+                        $data->{'jnxRPF'}{$ifIndex}{'ipv4'} = 1;
+                    }
+                    if( $addrFamily == 2 )
+                    {
+                        $data->{'jnxRPF'}{$ifIndex}{'ipv6'} = 2;
+                    }                    
+                }
+            }
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+
+    # PROG: Class of Service information
+    if( $devdetails->hasCap('jnxCoS') &&
+	( keys %{$data->{'jnxCos'}{'ifIndex'}} > 0 )
+       )
+    {
+	# PROG: Add CoS information if it exists.
+	my $nodeTop = $cb->addSubtree( $devNode, 'CoS', undef,
+                                  [ 'JunOS::junos-cos-subtree']);
+
+        foreach my $ifIndex ( sort {$a <=> $b} keys
+                              %{$data->{'jnxCos'}{'ifIndex'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            my $ifAlias   = $interface->{'ifAlias'};
+            my $ifDescr   = $interface->{'ifDescr'};
+            my $ifName    = $interface->{'ifNameT'};
+
+            next if( not $ifName );  # Skip since port is likely 'disabled'
+            # This might be better to match against ifType
+            # as well since not all of them support Q's.
+
+            # Add Subtree per port
+            my $nodePort =
+                $cb->addSubtree( $nodeTop, $ifName,
+                                 { 'comment'    => $ifAlias,
+                                   'precedence' => 1000 - $ifIndex },
+                                 [ 'JunOS::junos-cos-subtree-interface' ]);
+
+            # Loop to create subtree's for each QueueName/ID pair
+            foreach my $cosIndex ( sort keys %{$data->{'jnxCos'}{'queue'}} )
+            {
+                my $cosName  = $data->{'jnxCos'}{'queue'}{$cosIndex};
+                
+                # Add Leaf for each one
+                Debug("JunOS::CoS  ifIndex: $ifIndex ($ifName -> $cosName)");
+                my $nodeIFCOS =
+                    $cb->addSubtree( $nodePort, $cosName,
+                                     { 'comment'    => "Class: " . $cosName,
+                                       'cos-index'  => $cosIndex,
+                                       'cos-name'   => $cosName,
+                                       'ifDescr'    => $ifDescr,
+                                       'ifIndex'    => $ifIndex,
+                                       'ifName'     => $ifName,
+                                       'precedence' => 1000 - $cosIndex },
+                                     [ 'JunOS::junos-cos-leaf' ]);
+
+                if( $devdetails->param('JunOS::disable-cos-tail') ne 'yes' )
+                {
+                    $cb->addSubtree( $nodeIFCOS, "Tail_drop_stats",
+                                     { 'comment'  => 'Tail drop statistics' },
+                                     [ 'JunOS::junos-cos-tail' ]);
+                }
+
+                if( $devdetails->param('JunOS::disable-cos-red') ne 'yes' )
+                {
+                    $cb->addSubtree
+                        ( $nodeIFCOS, "RED_stats",
+                          { 'comment'  => 'Random Early Detection' },
+                          [ 'JunOS::junos-cos-red' ]);
+                }
+                
+            } # end foreach (INDEX of queue's [Q-ID])
+        } # end foreach (INDEX of port)
+    } # end if HasCap->{CoS}
+
+
+    # PROG: Firewall Table (filters and counters)
+    if( $devdetails->hasCap('jnxFirewall') )
+    {
+        # Add subtree first
+        my $nodeFW = $cb->addSubtree( $devNode, 'Firewall', undef,
+                                      [ 'JunOS::junos-firewall-subtree' ]);
+
+        # Loop through and find all the filter names
+        foreach my $fwFilter
+            ( sort {$a <=> $b} keys %{$data->{'jnxFirewall'}} )
+        {
+            my $firewall  = $data->{'jnxFirewall'}{$fwFilter};
+
+            # Add subtree for FilterName
+            my $nodeFWFilter =
+                $cb->addSubtree( $nodeFW, $fwFilter,
+                                 { 'comment' => 'Filter: ' . $fwFilter },
+                                 [ 'JunOS::junos-firewall-filter-subtree' ]);
+            
+            # Loop through and find all the counter names within the filter
+            foreach my $fwCounter ( sort {$a <=> $b} keys %{$firewall} )
+            {
+                my $fwOid     = $firewall->{$fwCounter}{'oid'};
+                my $fwType    = $firewall->{$fwCounter}{'type'};
+                my @templates = ( 'JunOS::junos-firewall-filter' );
+
+                # Figure out which templates to apply ...
+                if ($fwType == 2)
+                {
+                    # fwType is a counter ...
+                    push( @templates,
+                          'JunOS::junos-firewall-filter-counter',
+                          'JunOS::junos-firewall-filter-policer' );
+                }
+                elsif ($fwType == 3)
+                {
+                    # fwType is a policer ...
+                    push( @templates,
+                          'JunOS::junos-firewall-filter-policer' );
+                } # END: if $fwType
+
+                # Finally, add the subtree...
+                my $fwTypeName = $fwType == 2 ? 'Counter: ' : 'Policer: ';
+                my $nodeFWCounter =
+                    $cb->addSubtree($nodeFWFilter, $fwCounter,
+                                    { 'comment'    => $fwTypeName . $fwCounter,
+                                      'fw-counter' => $fwCounter,
+                                      'fw-filter'  => $fwFilter,
+                                      'fw-index'   => $fwOid }, \@templates );
+            } # END foreach $fwCounter
+        } # END foreach $fwFilter
+    } # END: if hasCap jnxFirewall
+
+
+    # PROG: Operating Status Table
+    # NOTE: According to the Juniper MIB, the following is a statement:
+    #       jnxOperatingTemp: The temperature in Celsius (degrees C) of this
+    #                         subject.  Zero if unavailable or inapplicable.
+    #       The same applies for all values under Operating status table, if
+    #       Zero is shown it might be considered unavail or N/A.  We will
+    #       also take that into consideration.
+    # NOTE: Also so poorly written, its great.
+    if( $devdetails->hasCap('jnxOperating') )
+    {
+        my $nodeCPU  = $cb->addSubtree( $devNode, 'CPU_Usage', undef,
+                                        [ 'JunOS::junos-cpu-subtree' ]);
+
+        my $nodeMem  = $cb->addSubtree( $devNode, 'Memory_Usage', undef,
+                                        [ 'JunOS::junos-memory-subtree' ]);
+
+        my $nodeTemp =
+            $cb->addSubtree( $devNode, 'Temperature_Sensors', undef,
+                             [ 'JunOS::junos-temperature-subtree' ]);
+
+        
+        foreach my $opIndex
+            ( sort {$a <=> $b} keys %{$data->{'jnxOperating'}} )
+        {
+            my $operating = $data->{'jnxOperating'}{$opIndex};
+            my $jnxCPU    = $operating->{'cpu'};
+            my $jnxDesc   = $operating->{'desc'};
+            my $jnxMem    = $operating->{'mem'};
+            my $jnxTemp   = $operating->{'temp'};
+            my $jnxTag = $jnxDesc;
+            $jnxTag =~ s/\W+/_/go;
+            $jnxTag =~ s/_$//go;
+            # Fix the .'s into _'s for the RRD-DS and name of leaf
+            my $opIndexFix = $opIndex;
+            $opIndexFix =~ s/\./_/g;
+
+            # PROG: Find CPU that does not equal 0
+            if ($jnxCPU > 0)
+            {
+                $cb->addSubtree( $nodeCPU, $jnxTag,
+                                 { 'comment'   => $jnxDesc,
+                                   'cpu-index' => $opIndex },
+                                 [ 'JunOS::junos-cpu' ]);
+            }
+
+            # PROG: Find memory that does not equal 0
+            if ($jnxMem > 0)
+            {
+                $cb->addSubtree( $nodeMem, $jnxTag,
+                                 { 'comment'      => $jnxDesc,
+                                   'mem-index'    => $opIndex,
+                                   'mem-indexFix' => $opIndexFix },
+                                 [ 'JunOS::junos-memory' ]);
+            }
+
+            # PROG: Find Temperature that does not equal 0
+            if ($jnxTemp > 0)
+            {
+                if ($jnxDesc =~ /(temp.* sensor|Engine)/) {
+                    # Small little hack to cleanup the sensor tags
+                    $jnxTag =~ s/_temp(erature|)_sensor//g;
+                    $cb->addLeaf( $nodeTemp, $jnxTag,
+                                  { 'comment'         => $jnxDesc,
+                                    'sensor-desc'     => $jnxDesc, 
+                                    'sensor-index'    => $opIndex,
+                                    'sensor-indexFix' => $opIndexFix },
+                                  [ 'JunOS::junos-temperature-sensor' ]);
+                }
+            }
+        } # END foreach $opIndex
+    } # END if jnxOperating
+
+
+    # PROG: Reverse Forwarding Path (RPF)
+    if( $devdetails->hasCap('jnxRPF') )
+    {
+        # Add subtree first
+        my $nodeRPF = $cb->addSubtree( $devNode, 'RPF', undef,
+                                       [ 'JunOS::junos-rpf-subtree' ]);
+
+        # Loop through and find all interfaces with RPF enabled
+        foreach my $ifIndex ( sort {$a <=> $b} keys %{$data->{'jnxRPF'}} )
+        {
+            # Set some names
+            my $ifAlias = $data->{'interfaces'}{$ifIndex}{'ifAlias'};
+            my $ifName  = $data->{'interfaces'}{$ifIndex}{'ifName'};
+            my $ifNameT = $data->{'interfaces'}{$ifIndex}{'ifNameT'};
+            my $hasIPv4 = $data->{'jnxRPF'}{$ifIndex}{'ipv4'};
+            my $hasIPv6 = $data->{'jnxRPF'}{$ifIndex}{'ipv6'};
+
+            Debug("JunOS:: RPF  int: $ifName  IPv4: $hasIPv4  IPv6: $hasIPv6");
+
+            # PROG: Process IPv4 first ... 
+            if( $hasIPv4 )
+            {
+                $cb->addSubtree( $nodeRPF, 'IPv4_' . $ifNameT,
+                                 { 'comment'    => $ifAlias,
+                                   'ifAddrType' => "ipv4",
+                                   'ifName'     => $ifName,
+                                   'ifNameT'    => $ifNameT,
+                                   'rpfIndex'   => $ifIndex . "." . $hasIPv4 },
+                                 [ 'JunOS::junos-rpf' ]);
+            }
+
+            if( $hasIPv6 )
+            {
+                $cb->addSubtree( $nodeRPF, 'IPv6_' . $ifNameT,
+                                 { 'comment'    => $ifAlias,
+                                   'ifAddrType' => "ipv6",
+                                   'ifName'     => $ifName,
+                                   'ifNameT'    => $ifNameT,
+                                   'rpfIndex'   => $ifIndex . "." . $hasIPv6 },
+                                 [ 'JunOS::junos-rpf' ]);
+            }
+        }
+    } # END: if jnxRPF
+}
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/Liebert.pm b/torrus/perllib/Torrus/DevDiscover/Liebert.pm
new file mode 100644
index 000000000..c8aa3d21b
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Liebert.pm
@@ -0,0 +1,313 @@
+#
+#  Discovery module for Liebert HVAC systems
+#
+#  Copyright (C) 2008 Jon Nistor
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Liebert.pm,v 1.1 2010-12-27 00:03:50 ivan Exp $
+# Jon Nistor <nistor at snickers.org>
+#
+# NOTE: Options for this module
+#       Liebert::use-fahrenheit
+#	Liebert::disable-temperature
+#	Liebert::disable-humidity
+#	Liebert::disable-state
+#	Liebert::disable-stats
+#
+# NOTE: This module supports both Fahrenheit and Celcius, but for ease of
+#       module and cleanliness we will convert Celcius into Fahrenheit
+#       instead of polling for Fahrenheit directly.
+#
+
+# Liebert discovery module
+package Torrus::DevDiscover::Liebert;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'Liebert'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef =
+    (
+     # LIEBERT-GP-REGISTRATION-MIB
+     'GlobalProducts'	  => '1.3.6.1.4.1.476.1.42',
+
+     # LIEBERT-GP-AGENT-MIB
+     'Manufacturer'       => '1.3.6.1.4.1.476.1.42.2.1.1.0',
+     'Model'              => '1.3.6.1.4.1.476.1.42.2.1.2.0',
+     'FirmwareVer'        => '1.3.6.1.4.1.476.1.42.2.1.3.0',
+     'SerialNum'          => '1.3.6.1.4.1.476.1.42.2.1.4.0',
+     'PartNum'            => '1.3.6.1.4.1.476.1.42.2.1.5.0',
+
+     'TemperatureIdDegF'  => '1.3.6.1.4.1.476.1.42.3.4.1.2.3.1.1',
+     'TemperatureIdDegC'  => '1.3.6.1.4.1.476.1.42.3.4.1.3.3.1.1',
+     'HumidityIdRel'      => '1.3.6.1.4.1.476.1.42.3.4.2.2.3.1.1',
+
+     'lgpEnvState'                => '1.3.6.1.4.1.476.1.42.3.4.3',
+     'lgpEnvStateCoolingCapacity' => '1.3.6.1.4.1.476.1.42.3.4.3.9.0',
+     'lgpEnvStatistics'           => '1.3.6.1.4.1.476.1.42.3.4.6',
+
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch ( 'GlobalProducts',
+            $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+   
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # PROG: Grab versions, serials and type of chassis.
+    my $Info = $dd->retrieveSnmpOIDs ( 'Manufacturer', 'Model',
+                        'FirmwareVer', 'SerialNum', 'PartNum' );
+
+    # SNMP: System comment
+    $data->{'param'}{'comment'} =
+            $Info->{'Manufacturer'} . " " . $Info->{'Model'} . ", Version: " .
+            $Info->{'FirmwareVer'} . ", Serial: " . $Info->{'SerialNum'};
+
+    # The Liebert HVAC snmp implementation requires a lower number
+    # of pdu's to be sent to it.
+    $data->{'param'}{'snmp-oids-per-pdu'} = 10;
+
+    # Temperature
+    if( $devdetails->param('Liebert::disable-temperature') ne 'yes' ) 
+    {
+        $devdetails->setCap('env-temperature');
+
+        if( $devdetails->param('Liebert::use-fahrenheit') ne 'yes' )
+        {
+            # ENV: Temperature in Celcius
+            my $idTable = $session->get_table(
+                 -baseoid => $dd->oiddef('TemperatureIdDegC') );
+            $devdetails->storeSnmpVars( $idTable );
+
+            if( defined( $idTable ) )
+            {
+                $devdetails->setCap('env-temperature-celcius');
+
+                foreach my $index ( $devdetails->getSnmpIndices(
+                                    $dd->oiddef('TemperatureIdDegC') ) )
+                {
+                    Debug("Liebert: Temp (degC) index: $index");
+                    $data->{'liebert'}{'tempidx'}{$index} = "celcius";
+                }
+            }
+        } else {
+            # ENV: Temperature in Fahrenheit
+            my $idTable = $session->get_table(
+                 -baseoid => $dd->oiddef('TemperatureIdDegF') );
+            $devdetails->storeSnmpVars( $idTable );
+
+            if( defined( $idTable ) )
+            {
+                $devdetails->setCap('env-temperature-fahrenheit');
+
+                foreach my $index ( $devdetails->getSnmpIndices(
+                                    $dd->oiddef('TemperatureIdDegF') ) )
+                {
+                    Debug("Liebert: Temp (degF) index: $index");
+                    $data->{'liebert'}{'tempidx'}{$index} = "fahrenheit";
+                }
+            }
+        }
+    }
+
+    # ENV: Humidity
+    if( $devdetails->param('Liebert::disable-humidity') ne 'yes' )
+    {
+        my $idTable = $session->get_table(
+                 -baseoid => $dd->oiddef('HumidityIdRel') );
+        $devdetails->storeSnmpVars( $idTable );
+
+        if( defined( $idTable ) )
+        {
+            $devdetails->setCap('env-humidity');
+            foreach my $index ( $devdetails->getSnmpIndices(
+                                $dd->oiddef('HumidityIdRel') ) )
+            {
+                Debug("Liebert: humidity index: $index");
+                $data->{'liebert'}{'humididx'}{$index} = "humidity";
+            }
+        }
+    }
+
+    # ENV: State
+    if( $devdetails->param('Liebert::disable-state') ne 'yes' )
+    {
+        my $stateTable = $session->get_table(
+                 -baseoid => $dd->oiddef('lgpEnvState') );
+        $devdetails->storeSnmpVars( $stateTable );
+
+        if( defined( $stateTable ) )
+        {
+            $devdetails->setCap('env-state');
+
+            # PROG: Check to see if Firmware is new enough for Capacity
+            if( $dd->checkSnmpOID('lgpEnvStateCoolingCapacity') )
+            {
+                $devdetails->setCap('env-state-capacity');
+            }
+        }
+    }
+
+    # Statistics
+    if( $devdetails->param('Liebert::disable-stats') ne 'yes' )
+    {
+        my $statsTable = $session->get_table(
+                 -baseoid => $dd->oiddef('lgpEnvStatistics') );
+        $devdetails->storeSnmpVars( $statsTable );
+
+        if( defined( $statsTable ) )
+        {
+            $devdetails->setCap('env-stats');
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    if( $devdetails->hasCap('env-temperature') )
+    {
+        # All place-setting variables default to Celcius
+        my @template;
+        my $dataFile   = "%system-id%_temperature.rrd";
+        my $fahrenheit = 0;
+        my $snmpVar    = 3;
+        my $tempUnit   = "C";
+        my $tempScale  = "Celcius";
+        my $tempLowLim = 15;
+        my $tempUppLim = 70;
+
+        if( $devdetails->hasCap('env-temperature-fahrenheit') )
+        {
+            $dataFile   = "%system-id%_temperature_f.rrd";
+            $fahrenheit	= 1;
+            $snmpVar    = 2;
+            $tempUnit   = "F";
+            $tempScale  = "Fahrenheit";
+            $tempLowLim = $tempLowLim * 1.8 + 32;
+            $tempUppLim = $tempUppLim * 1.8 + 32;
+            push(@template, "Liebert::temperature-sensor-fahrenheit");
+        } else {
+            push(@template, "Liebert::temperature-sensor");
+        }
+
+        my $paramSubTree = {
+            'data-file'      => $dataFile,
+            'temp-idx'       => $snmpVar,
+            'temp-lower'     => $tempLowLim,
+            'temp-scale'     => $tempUnit,
+            'temp-upper'     => $tempUppLim,
+            'vertical-label' => "degrees $tempScale"
+        };
+        my $nodeTemp = $cb->addSubtree( $devNode, 'Temperature', $paramSubTree,
+                                      [ 'Liebert::temperature-subtree' ] );
+
+	# ----------------------------------------------------------------
+        # PROG: Figure out how many indexes we have
+        foreach my $index ( keys %{$data->{'liebert'}{'tempidx'}} )
+        {
+            my $dataFile = "%system-id%_sensor_$index" . 
+                           ($fahrenheit ? '_fahrenheit':'') . ".rrd";
+            Debug("Liebert: Temperature idx: $index : $tempScale");
+            my $param = {
+                'comment'    => "Sensor: $index",
+                'data-file'  => $dataFile,
+                'sensor-idx' => $index
+            };
+
+            $cb->addSubtree( $nodeTemp, 'sensor_' . $index, $param,
+                        [ @template ] );
+        } # END: foreach my $index
+    } # END: env-temperature
+
+
+    # Humidity
+    if( $devdetails->hasCap('env-humidity') )
+    {
+        my $nodeHumidity = $cb->addSubtree( $devNode, "Humidity", undef,
+                                          [ 'Liebert::humidity-subtree' ] );
+
+        # PROG: Figure out how many sensors we have
+        foreach my $index ( keys %{$data->{'liebert'}{'humididx'}} )
+        {
+            Debug("Liebert: Humidity idx: $index");
+
+            my $param = {
+                'comment'   => "Sensor: " . $index,
+                'humid-idx' => $index
+            };
+
+            $cb->addSubtree( $nodeHumidity, 'sensor_' . $index, $param,
+                           [ 'Liebert::humidity-sensor' ] );
+        }
+
+    } # END of hasCap
+
+
+    # State of the system
+    if( $devdetails->hasCap('env-state') )
+    {
+        my $nodeState = $cb->addSubtree( $devNode, 'State', undef,
+                                       [ 'Liebert::state-subtree' ] );
+
+        if( $devdetails->hasCap('env-state-capacity') )
+        {
+            $cb->addSubtree( $devNode, 'State', undef,
+                           [ 'Liebert::state-capacity' ] );
+        }
+    }
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/MicrosoftWindows.pm b/torrus/perllib/Torrus/DevDiscover/MicrosoftWindows.pm
new file mode 100644
index 000000000..d924dc469
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/MicrosoftWindows.pm
@@ -0,0 +1,181 @@
+#  Copyright (C) 2003-2004  Stanislav Sinyagin, Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: MicrosoftWindows.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+
+# MS Windows 2000/XP SNMP agent discovery.
+# ifDescr does not give unique interace mapping, so MAC address mapping
+# is used.
+
+package Torrus::DevDiscover::MicrosoftWindows;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'MicrosoftWindows'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # MSFT-MIB
+     'windowsNT'                    => '1.3.6.1.4.1.311.1.1.3.1',
+
+     # FtpServer-MIB
+     'ms_ftpStatistics'             => '1.3.6.1.4.1.311.1.7.2.1',
+
+     # HttpServer-MIB
+     'ms_httpStatistics'            => '1.3.6.1.4.1.311.1.7.3.1',
+     );
+
+# Not all interfaces are normally needed to monitor.
+# You may override the interface filtering in devdiscover-siteconfig.pl:
+# redefine $Torrus::DevDiscover::MicrosoftWindows::interfaceFilter
+# or define $Torrus::DevDiscover::MicrosoftWindows::interfaceFilterOverlay
+
+our $interfaceFilter;
+our $interfaceFilterOverlay;
+my %winNTInterfaceFilter;
+
+if( not defined( $interfaceFilter ) )
+{
+    $interfaceFilter = \%winNTInterfaceFilter;
+}
+
+
+# Key is some unique symbolic name, does not mean anything
+# ifType is the number to match the interface type
+# ifDescr is the regexp to match the interface description
+%winNTInterfaceFilter =
+    (
+     'MS TCP Loopback interface' => {
+         'ifType'  => 24                        # softwareLoopback
+         },
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'windowsNT',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+
+    my $data = $devdetails->data();
+
+    &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+        ($devdetails, $interfaceFilter);
+
+    if( defined( $interfaceFilterOverlay ) )
+    {
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilterOverlay);
+    }
+
+    $devdetails->setCap('interfaceIndexingManaged');
+    
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # In Windows SNMP agent, ifDescr is not unique per interface.
+    # We use MAC address as a unique interface identifier.
+
+    $data->{'nameref'}{'ifComment'} = ''; # suggest?
+
+    $data->{'param'}{'ifindex-map'} = '$IFIDX_MAC';
+    Torrus::DevDiscover::RFC2863_IF_MIB::retrieveMacAddresses( $dd,
+                                                               $devdetails );
+
+    $data->{'nameref'}{'ifNick'} = 'MAC';
+    
+    # FTP and HTTP servers, if present
+    if( $dd->checkSnmpTable( 'ms_ftpStatistics' ) )
+    {
+        $devdetails->setCap( 'msIIS' );
+        $devdetails->setCap( 'msFtpStats' );
+    }
+
+    if( $dd->checkSnmpTable( 'ms_httpStatistics' ) )
+    {
+        $devdetails->setCap( 'msIIS' );
+        $devdetails->setCap( 'msHttpStats' );
+    }
+
+    return 1;
+}
+
+
+# Nothing really to do yet
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    if( $devdetails->hasCap( 'msIIS' ) )
+    {
+        my $iisParam = {
+            'precedence'    =>  -100000,
+            'comment'       => 'Microsoft Internet Information Server'
+            };
+
+        my @iisTemplates;
+        if( $devdetails->hasCap( 'msFtpStats' ) )
+        {
+            push( @iisTemplates,
+                  'MicrosoftWindows::microsoft-iis-ftp-stats' );
+        }
+        if( $devdetails->hasCap( 'msHttpStats' ) )
+        {
+            push( @iisTemplates,
+                  'MicrosoftWindows::microsoft-iis-http-stats' );
+        }
+
+
+        my $iisNode = $cb->addSubtree( $devNode, 'MS_IIS', $iisParam,
+                                       \@iisTemplates );
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/MotorolaBSR.pm b/torrus/perllib/Torrus/DevDiscover/MotorolaBSR.pm
new file mode 100644
index 000000000..dd061d5a5
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/MotorolaBSR.pm
@@ -0,0 +1,213 @@
+#
+#  Discovery module for Motorola Broadband Services Router (formely Riverdelta)
+#
+#  Copyright (C) 2006 Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: MotorolaBSR.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $
+#
+
+
+# Cisco SCE devices discovery
+package Torrus::DevDiscover::MotorolaBSR;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'MotorolaBSR'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+# pmodule-dependend OIDs are presented for module #1 only.
+# currently devices with more than one module do not exist
+
+our %oiddef =
+    (
+     'rdnProducts' => '1.3.6.1.4.1.4981.4.1',
+     # RDN-CMTS-MIB
+     'rdnCmtsUpstreamChannelTable' => '1.3.6.1.4.1.4981.2.1.2'     
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'rdnProducts',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) or
+        not $devdetails->isDevType('RFC2670_DOCS_IF') )
+    {
+        return 0;
+    }
+                
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    $data->{'param'}{'ifindex-map'} = '$IFIDX_IFINDEX';
+    Torrus::DevDiscover::RFC2863_IF_MIB::storeIfIndexParams( $devdetails );
+    
+    if( $dd->checkSnmpTable( 'rdnCmtsUpstreamChannelTable' ) )
+    {
+        $devdetails->setCap('rdnCmtsUpstreamChannelTable');
+
+        foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            
+            push( @{$interface->{'docsTemplates'}},
+                  'MotorolaBSR::motorola-bsr-docsis-upstream-util' );
+        }
+    }
+    
+    return 1;
+}
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    if( $devdetails->hasCap('rdnCmtsUpstreamChannelTable') and
+        scalar( @{$data->{'docsCableUpstream'}} ) > 0 )
+    {
+        my $upstrNode =
+            $cb->getChildSubtree( $devNode,
+                                  $data->{'docsConfig'}{'docsCableUpstream'}{
+                                      'subtreeName'} );
+        
+        my $shortcuts = 'snr,fec,freq,modems';
+        
+        my $param = {        
+            'overview-shortcuts' =>
+                $shortcuts,
+                
+                'overview-subleave-name-modems' => 'Modems',
+                'overview-direct-link-modems' => 'yes',
+                'overview-direct-link-view-modems' => 'expanded-dir-html',
+                'overview-shortcut-text-modems' => 'All modems',
+                'overview-shortcut-title-modems'=>
+                'Show modem quantities in one page',
+                'overview-page-title-modems' => 'Modem quantities',
+            };
+
+        $cb->addParams( $upstrNode, $param );
+        
+        # Build All_Modems summary graph
+        
+        my $param = {
+            'ds-type'              => 'rrd-multigraph',
+            'ds-names'             => 'registered,unregistered,offline',
+            'graph-lower-limit'    => '0',
+            'precedence'           => '1000',
+                
+            'vertical-label'       => 'Modems',
+            'descriptive-nickname'     => '%system-id%: All modems',
+            
+            'ds-expr-registered' => '{Modems_Registered}',
+            'graph-legend-registered' => 'Registered',
+            'line-style-registered' => 'AREA',
+            'line-color-registered' => '##blue',
+            'line-order-registered' => '1',
+            
+            'ds-expr-unregistered' => '{Modems_Unregistered}',
+            'graph-legend-unregistered' => 'Unregistered',
+            'line-style-unregistered' => 'STACK',
+            'line-color-unregistered' => '##crimson',
+            'line-order-unregistered' => '2',
+            
+            'ds-expr-offline' => '{Modems_Offline}',
+            'graph-legend-offline' => 'Offline',
+            'line-style-offline' => 'STACK',
+            'line-color-offline' => '##silver',
+            'line-order-offline' => '3',                
+        };
+        
+        $param->{'comment'} =
+            'Registered, Unregistered and Offline modems on CMTS';
+        
+        $param->{'nodeid'} =
+            $data->{'docsConfig'}{'docsCableUpstream'}{'nodeidCategory'} .
+            '//%nodeid-device%//modems';
+        
+        my $first = 1;
+        foreach my $ifIndex ( @{$data->{'docsCableUpstream'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            
+            my $intf = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+            
+            if( $first )
+            {
+                $param->{'ds-expr-registered'} =
+                    '{' . $intf . '/Modems_Registered}';
+                $param->{'ds-expr-unregistered'} =
+                    '{' . $intf . '/Modems_Unregistered}';
+                $param->{'ds-expr-offline'} =
+                    '{' . $intf . '/Modems_Offline}';
+                $first = 0;
+            }
+            else
+            {
+                $param->{'ds-expr-registered'} .=
+                    ',{' . $intf . '/Modems_Registered},+';
+                $param->{'ds-expr-unregistered'} .=
+                    ',{' . $intf . '/Modems_Unregistered},+';
+                $param->{'ds-expr-offline'} .=
+                    ',{' . $intf . '/Modems_Offline},+';
+            }
+        }
+
+        my $usNode =
+            $cb->getChildSubtree( $devNode,
+                                  $data->{'docsConfig'}{
+                                      'docsCableUpstream'}{
+                                          'subtreeName'} );
+        if( defined( $usNode ) )
+        {
+            $cb->addLeaf( $usNode, 'All_Modems', $param, [] );
+        }
+        else
+        {
+            Error('Could not find the Upstream subtree');
+            exit 1;
+        }
+    }
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/NetApp.pm b/torrus/perllib/Torrus/DevDiscover/NetApp.pm
new file mode 100644
index 000000000..331680358
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/NetApp.pm
@@ -0,0 +1,170 @@
+#  Copyright (C) 2004  Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: NetApp.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+
+# NetApp.com storage products
+
+package Torrus::DevDiscover::NetApp;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'NetApp'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef =
+    (
+     'netapp'                               => '1.3.6.1.4.1.789',
+     'netapp1'                              => '1.3.6.1.4.1.789.1',
+     'netappProducts'                       => '1.3.6.1.4.1.789.2',
+
+     # netapp product 
+     'netapp_product'                       => '1.3.6.1.4.1.789.1.1',
+     'netapp_productVersion'                => '1.3.6.1.4.1.789.1.1.2.0',
+     'netapp_productId'                     => '1.3.6.1.4.1.789.1.1.3.0',
+     'netapp_productModel'                  => '1.3.6.1.4.1.789.1.1.5.0',
+     'netapp_productFirmwareVersion'        => '1.3.6.1.4.1.789.1.1.6.0',
+     
+     # netapp sysstat
+     'netapp_sysStat'                       => '1.3.6.1.4.1.789.1.2',
+     'netapp_sysStat_cpuCount'              => '1.3.6.1.4.1.789.1.2.1.6.0',
+     
+     # netapp nfs
+     'netapp_nfs'                           => '1.3.6.1.4.1.789.1.3',
+     'netapp_nfsIsLicensed'                 => '1.3.6.1.4.1.789.1.3.3.1.0',
+     
+     # At a glance Lookup values seem to be the most common as opposed to
+     # collecting NFS stats for v2 and v3 (and eventually v4 ) if No lookups
+     # have been performed at discovery time we assume that vX is not in use.
+     'netapp_tv2cLookups'              => '1.3.6.1.4.1.789.1.3.2.2.3.1.5.0',
+     'netapp_tv3cLookups'              => '1.3.6.1.4.1.789.1.3.2.2.4.1.4.0',
+     
+     # netapp CIFS
+     'netapp_cifs'                     => '1.3.6.1.4.1.789.1.7',
+     'netapp_cifsIsLicensed'           => '1.3.6.1.4.1.789.1.7.21.0',
+     
+     # 4 - 19 should also be interesting
+     # particularly cluster netcache stats
+     );
+
+#       netappFiler     OBJECT IDENTIFIER ::= { netappProducts 1 }
+#       netappNetCache  OBJECT IDENTIFIER ::= { netappProducts 2 }
+#       netappClusteredFiler    OBJECT IDENTIFIER ::= { netappProducts 3 }
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    return $dd->checkSnmpTable( 'netapp' );
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    my $result = $dd->retrieveSnmpOIDs
+        ( 'netapp_productModel',  'netapp_productId',
+          'netapp_productVersion', 'netapp_productFirmwareVersion',
+          'netapp_nfsIsLicensed', 'netapp_cifsIsLicensed',
+          'netapp_tv2cLookups', 'netapp_tv3cLookups' );
+    
+    $data->{'param'}->{'comment'} =
+        sprintf('%s %s: %s %s',
+                $result->{'netapp_productModel'},
+                $result->{'netapp_productId'},
+                $result->{'netapp_productVersion'},
+                $result->{'netapp_productFirmwareVersion'});
+    
+    # At a glance Lookup values seem to be the most common as opposed to
+    # collecting NFS stats for v2 and v3 (and eventually v4 ) if No lookups
+    # have been performed at discovery time we assume that nfsvX is not in use.
+    
+    if( $result->{'netapp_nfsIsLicensed'} == 2 )
+    {
+        if( $result->{'netapp_tv2cLookups'} > 0 )
+        {
+            $devdetails->setCap('NetApp::nfsv2');
+        }
+
+        if( $result->{'netapp_tv3cLookups'} > 0 )
+        {
+            $devdetails->setCap('NetApp::nfsv3');
+        }
+    }
+
+    if( $result->{'netapp_cifsIsLicensed'} == 2 )
+    {
+        $devdetails->setCap('NetApp::cifs');
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    $cb->addParams( $devNode, $data->{'params'} );
+
+    # Add CPU Template
+    $cb->addTemplateApplication( $devNode, 'NetApp::CPU');
+    
+    # Add Misc Stats
+    $cb->addTemplateApplication( $devNode, 'NetApp::misc');
+
+    if( $devdetails->hasCap('NetApp::nfsv2') )
+    {
+        $cb->addTemplateApplication( $devNode, 'NetApp::nfsv2');
+    }
+
+    if( $devdetails->hasCap('NetApp::nfsv3') )
+    {
+        $cb->addTemplateApplication( $devNode, 'NetApp::nfsv3');
+    }
+
+    if( $devdetails->hasCap('NetApp::cifs') )
+    {
+        Debug("Would add cifs here\n");
+        #$cb->addTemplateApplication( $devNode, 'NetApp::cifs');
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/NetBotz.pm b/torrus/perllib/Torrus/DevDiscover/NetBotz.pm
new file mode 100644
index 000000000..f91af5e25
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/NetBotz.pm
@@ -0,0 +1,197 @@
+#  Copyright (C) 2009 Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# $Id: NetBotz.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $
+
+# NetBotz modular sensors
+
+package Torrus::DevDiscover::NetBotz;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'NetBotz'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     'netBotzV2Products'     => '1.3.6.1.4.1.5528.100.20',
+     );
+
+
+our %sensor_types =
+    ('temp'   => {
+        'oid' => '1.3.6.1.4.1.5528.100.4.1.1.1',
+        'template' => 'NetBotz::netbotz-temp-sensor',
+        'max' => 'NetBotz::temp-max',
+        },
+     'humi'   => {
+         'oid' => '1.3.6.1.4.1.5528.100.4.1.2.1',
+         'template' => 'NetBotz::netbotz-humi-sensor',
+         'max' => 'NetBotz::humi-max',
+         },
+     'dew'    => {
+         'oid' => '1.3.6.1.4.1.5528.100.4.1.3.1',
+         'template' => 'NetBotz::netbotz-dew-sensor',
+         'max' => 'NetBotz::dew-max',
+         },
+     'audio'  => {
+         'oid' => '1.3.6.1.4.1.5528.100.4.1.4.1',
+         'template' => 'NetBotz::netbotz-audio-sensor'
+         },
+     'air' => {
+         'oid' => '1.3.6.1.4.1.5528.100.4.1.5.1',
+         'template' => 'NetBotz::netbotz-air-sensor'
+         },
+     'door' => {
+         'oid' => '1.3.6.1.4.1.5528.100.4.2.2.1',
+         'template' => 'NetBotz::netbotz-door-sensor'
+         },
+     );
+     
+     
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'netBotzV2Products',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+    
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    foreach my $stype (sort keys %sensor_types)
+    {
+        my $oid = $sensor_types{$stype}{'oid'};
+        
+        my $sensorTable = $session->get_table( -baseoid => $oid );
+        
+        if( defined( $sensorTable ) )
+        {
+            $devdetails->storeSnmpVars( $sensorTable );
+
+            # store the sensor names to guarantee uniqueness
+            my %sensorNames;
+            
+            foreach my $INDEX ($devdetails->getSnmpIndices($oid . '.1'))
+            {
+                my $label = $devdetails->snmpVar( $oid . '.4.' . $INDEX );
+                
+                if( $sensorNames{$label} )
+                {
+                    Warn('Duplicate sensor names: ' . $label);
+                    $sensorNames{$label}++;
+                }
+                else
+                {
+                    $sensorNames{$label} = 1;
+                }
+                
+                if( $sensorNames{$label} > 1 )
+                {
+                    $label .= sprintf(' %d', $sensorNames{$label});
+                }
+                
+                my $leafName = $label;
+                $leafName =~ s/\W/_/g;
+
+                my $param = {
+                    'netbotz-sensor-index' => $INDEX,
+                    'node-display-name' => $label,
+                    'graph-title' => $label,
+                    'precedence' => sprintf('%d', 1000 - $INDEX)
+                };
+
+                if( defined( $sensor_types{$stype}{'max'} ) )
+                {
+                    my $max =
+                        $devdetails->param($sensor_types{$stype}{'max'});
+                    
+                    if( defined($max) and $max > 0 )
+                    {
+                        $param->{'upper-limit'} = $max;
+                    }
+                }
+                
+
+                $data->{'NetBotz'}{$INDEX} = {
+                    'param'    => $param,
+                    'leafName' => $leafName,
+                    'template' => $sensor_types{$stype}{'template'}};
+            }
+        }        
+    }
+    
+    if( not defined($data->{'param'}{'comment'}) or
+        length($data->{'param'}{'comment'}) == 0 )
+    {
+        $data->{'param'}{'comment'} = 'NetBotz environment sensors';
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'NetBotz'}} )
+    {
+        my $ref = $data->{'NetBotz'}{$INDEX};
+        
+        $cb->addLeaf( $devNode, $ref->{'leafName'}, $ref->{'param'},
+                      [$ref->{'template'}] );
+    }
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/NetScreen.pm b/torrus/perllib/Torrus/DevDiscover/NetScreen.pm
new file mode 100644
index 000000000..9541daa6c
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/NetScreen.pm
@@ -0,0 +1,152 @@
+#  Copyright (C) 2003  Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: NetScreen.pm,v 1.1 2010-12-27 00:03:50 ivan Exp $
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+
+# NetScreen
+
+package Torrus::DevDiscover::NetScreen;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'NetScreen'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef =
+    (
+     'netscreen'         => '1.3.6.1.4.1.3224',
+     'nsResSessMaxium'   => '1.3.6.1.4.1.3224.16.3.3.0',
+     'nsIfFlowTable'     => '1.3.6.1.4.1.3224.9.3',
+
+     'nsIfMonTable'      => '1.3.6.1.4.1.3224.9.4',
+     'nsIfMonIfIdx'      => '1.3.6.1.4.1.3224.9.4.1.1',
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->checkSnmpTable( 'netscreen' ) )
+    {
+        return 0;
+    }
+
+    my $data = $devdetails->data();
+
+    $devdetails->setCap('interfaceIndexingManaged');
+    
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    $data->{'nameref'}{'ifDescr'} = '';
+    $data->{'param'}{'ifindex-map'} = '$IFIDX_MAC';
+    Torrus::DevDiscover::RFC2863_IF_MIB::retrieveMacAddresses( $dd,
+                                                               $devdetails );
+
+    # TODO: do something about these tables in buildConfig
+
+    if( $dd->checkSnmpTable( 'nsIfFlowTable' ) )
+    {
+        $devdetails->setCap('nsIfFlowTable');
+    }
+
+    if( $dd->checkSnmpTable( 'nsIfMonTable' ) )
+    {
+        $devdetails->setCap('nsIfMonTable');
+    }
+
+    if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) )
+    {
+        my $oidsPerPDU = $devdetails->param('NetScreen::snmp-oids-per-pdu');
+        if( $oidsPerPDU == 0 )
+        {
+            $oidsPerPDU = 10;
+        }
+        Debug("Setting snmp-oids-per-pdu to $oidsPerPDU");
+        $data->{'param'}{'snmp-oids-per-pdu'} = $oidsPerPDU;
+    }
+
+    my $result = $dd->retrieveSnmpOIDs('nsResSessMaxium');
+    if( defined($result) and $result->{'nsResSessMaxium'} > 0 )
+    {
+        $devdetails->setCap('NetScreen::SessMax');
+
+        my $param = {};
+        my $max = $result->{'nsResSessMaxium'};
+
+        $param->{'hrule-value-max'} = $max;
+        $param->{'hrule-legend-max'} = 'Maximum Sessions';
+        # upper limit of graph is 5% higher than max sessions
+        $param->{'graph-upper-limit'} =
+            sprintf('%e', 
+                    ( $max * 5 / 100 ) + $max );
+        
+        $data->{'netScreenSessions'} = {
+            'param' => $param,
+        };        
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+
+    { #Allocated Sessions
+
+        my $ref = $data->{'netScreenSessions'};
+
+        $cb->addSubtree( $devNode, "NetScreen_Sessions", $ref->{'param'}, 
+            [ 'NetScreen::netscreen-sessions-stats' ] );
+
+    }
+
+    $cb->addTemplateApplication($devNode, 'NetScreen::netscreen-cpu-stats');
+    $cb->addTemplateApplication($devNode, 'NetScreen::netscreen-memory-stats');
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/OracleDatabase.pm b/torrus/perllib/Torrus/DevDiscover/OracleDatabase.pm
new file mode 100644
index 000000000..313c73e5c
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/OracleDatabase.pm
@@ -0,0 +1,395 @@
+#  Copyright (C) 2003  Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: OracleDatabase.pm,v 1.1 2010-12-27 00:03:49 ivan Exp $
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+
+# Oracle Database MIB
+
+package Torrus::DevDiscover::OracleDatabase;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'OracleDatabase'} = {
+    'sequence'     => 600,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef =
+    (
+     # Oracle Database
+     'oraDb'                            => '1.3.6.1.4.1.111.4.1',
+
+     'oraDbConfigDbBlockSize'           => '1.3.6.1.4.1.111.4.1.7.1.3',
+
+     'oraDbSysTable'                    => '1.3.6.1.4.1.111.4.1.1.1',
+
+     'oraDbTablespace'                  => '1.3.6.1.4.1.111.4.1.2.1',
+     'oraDbTablespaceIndex'             => '1.3.6.1.4.1.111.4.1.2.1.1',
+     'oraDbTablespaceName'              => '1.3.6.1.4.1.111.4.1.2.1.2',
+
+     'oraDbDataFile'                    => '1.3.6.1.4.1.111.4.1.3.1',
+     'oraDbDataFileIndex'               => '1.3.6.1.4.1.111.4.1.3.1.1',
+     'oraDbDataFileName'                => '1.3.6.1.4.1.111.4.1.3.1.2',
+
+     'oraDbLibraryCache'                => '1.3.6.1.4.1.111.4.1.4.1',
+     'oraDbLibraryCacheIndex'           => '1.3.6.1.4.1.111.4.1.4.1.1',
+     'oraDbLibraryCacheNameSpace'       => '1.3.6.1.4.1.111.4.1.4.1.2',
+
+     'oraDbLibraryCacheSumTable'        => '1.3.6.1.4.1.111.4.1.5.1',
+
+     'oraDbSGATable'                    => '1.3.6.1.4.1.111.4.1.6.1',
+
+     );
+
+my $DbInfoSizeUnits =
+{
+    1 => '1',                       # bytes
+    2 => '1024',                    # kbytes
+    3 => '1048576',                 # mbytes
+    4 => '1073741824',              # gbytes
+    5 => '1099511627776',           # tbytes
+};
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    return $dd->checkSnmpTable('oraDb');
+}
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) )
+    {
+        $data->{'param'}{'snmp-oids-per-pdu'} = '10';
+    }
+    
+    my $dbType = $data->{'ora'};
+
+    # my $oraTableSpaceCols = (
+    #     $dd->oiddef('oraDbTablespaceIndex'),
+    #     $dd->oiddef('oraDbTablespaceName'),
+    #     );
+
+    # my $oraTableSpace = $session->get_entries( -columns => [
+    #         $dd->oiddef('oraDbTablespaceIndex'),
+    #         $dd->oiddef('oraDbTablespaceName'),
+    #         ], );
+
+    my $oraTableSpace = $session->get_table( -baseoid =>
+                                             $dd->oiddef('oraDbTablespace'),
+                                             );
+
+
+    if( defined($oraTableSpace) )
+    {
+        $devdetails->setCap('oraTableSpace');
+        $devdetails->storeSnmpVars($oraTableSpace);
+
+    }
+
+    ##
+
+    # my @oraDbDataFileCols = (
+    #     $dd->oiddef('oraDbDataFileIndex'),
+    #     $dd->oiddef('oraDbDataFileName'),
+    #     );
+
+    # my $oraDbDataFile = $session->get_entries( -columns => [
+    #     @oraDbDataFileCols ], );
+
+    my $oraDbDataFile =
+        $session->get_table( -baseoid => $dd->oiddef('oraDbDataFile') );
+
+    if( defined($oraDbDataFile) )
+    {
+        $devdetails->setCap('oraDbDataFile');
+        $devdetails->storeSnmpVars($oraDbDataFile);
+    }
+
+    ##
+
+    # my @oraDbLibraryCacheCols = (
+    #     $dd->oiddef('oraDbLibraryCacheIndex'),
+    #     $dd->oiddef('oraDbLibraryCacheNameSpace'),
+    #     );
+
+    # my $oraDbLibraryCache = $session->get_entries( -columns => [
+    #     @oraDbLibraryCacheCols ], );
+
+    my $oraDbLibraryCache =
+        $session->get_table( -baseoid => $dd->oiddef('oraDbLibraryCache') );
+
+    if( defined($oraDbLibraryCache) )
+    {
+        $devdetails->setCap('oraDbLibraryCache');
+        $devdetails->storeSnmpVars($oraDbLibraryCache);
+    }
+
+    Debug("Looking For dbNames");
+
+    foreach my $dbName ( keys %{ $dbType } )
+    {
+        Debug("DBName: $dbName");
+
+        my $dbIndex = $dbType->{$dbName}->{'index'};
+        Debug("DBIndex: $dbIndex");
+
+        my $db = {};
+        $dbType->{$dbName} = $db;
+
+        my $oid = $dd->oiddef('oraDbConfigDbBlockSize') . '.' .  $dbIndex;
+        my $result = $session->get_request( -varbindlist => [ $oid ] );
+        
+        
+        if( $session->error_status() == 0 and $result->{$oid} > 0 )
+        {
+            my $blocksize = $result->{$oid};
+            $dbType->{$dbName}->{'dbBlockSize'} = $blocksize;
+            Debug("DB Block Size: $blocksize");
+        }
+        Debug($session->error());
+
+        if( $devdetails->hasCap('oraTableSpace') )
+        {
+            my $ref = {};
+            $db->{'oraTableSpace'} = $ref;
+
+            # Table Space
+            foreach my $tsIndex
+                ( $devdetails->
+                  getSnmpIndices( $dd->oiddef('oraDbTablespaceIndex') .
+                                  '.' . $dbIndex ) )
+            {
+                my $tsName =
+                    $devdetails->snmpVar( $dd->oiddef('oraDbTablespaceName') .
+                                          '.' . $dbIndex . '.' . $tsIndex );
+                
+                $ref->{$tsName} = $tsIndex;
+            }
+        }
+
+        if( $devdetails->hasCap('oraDbDataFile') )
+        {
+            my $ref = {};
+            $db->{'oraDbDataFile'} = $ref;
+
+            # Data File
+            foreach my $dfIndex
+                ( $devdetails->
+                  getSnmpIndices( $dd->oiddef('oraDbDataFileIndex') .
+                                  '.' . $dbIndex ) )
+            {
+                my $dfName =
+                    $devdetails->snmpVar( $dd->oiddef('oraDbDataFileName') .
+                                          '.' . $dbIndex . '.' . $dfIndex );
+
+                $ref->{$dfName} = $dfIndex;
+            }
+        }
+        
+        if( $devdetails->hasCap('oraDbLibraryCache') )
+        {
+            my $ref = {};
+            $db->{'oraDbLibraryCache'} = $ref;
+
+            # Library Cache
+            foreach my $lcIndex
+                ( $devdetails->
+                  getSnmpIndices( $dd->oiddef('oraDbLibraryCacheIndex') .
+                                  '.' . $dbIndex ) )
+            {
+                my $lcName =
+                    $devdetails->
+                    snmpVar( $dd->oiddef('oraDbLibraryCacheNameSpace') .
+                             '.' . $dbIndex . '.' . $lcIndex );
+                
+                $ref->{$lcName} = $lcIndex;
+            }
+        }
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    my $dbType = $data->{'ora'};
+
+    my $appNode = $cb->addSubtree($devNode, 'Applications' );
+    my $vendorNode = $cb->addSubtree($appNode, 'Oracle' );
+
+    foreach my $dbName ( keys %{ $dbType } )
+    {
+        my $db = $dbType->{$dbName};
+        my $dbIndex = $dbType->{$dbName}->{'index'};
+        my $dbBlockSize = $dbType->{$dbName}->{'dbBlockSize'};
+
+        my $dbNick = $dbName;
+        $dbNick =~ s/^\///;
+        $dbNick =~ s/\W/_/g;
+        $dbNick =~ s/_+/_/g;
+
+        my $dbParam = {
+            'dbName' => $dbName,
+            'precedence' => sprintf("%d", 10000 - $dbIndex),
+            'vendor' => 'Oracle',
+            'dbNick' => $dbNick,
+        };
+
+        my @dbTemplates = (
+                           'OracleDatabase::Sys',
+                           'OracleDatabase::CacheSum',
+                           'OracleDatabase::SGA',
+                           );
+
+        my $dbNode = $cb->addSubtree($vendorNode, "Vendor_Oracle_DB_$dbNick",
+                                     $dbParam, [ @dbTemplates ] );
+
+        if( $devdetails->hasCap('oraTableSpace') )
+        {
+            my $tsParam = {
+                'comment' => "Table space for $dbName",
+                'precedence' => "600",
+            };
+
+            my $tsNode = $cb->addSubtree($dbNode, 'Table_Space', $tsParam );
+
+            foreach my $tsName ( keys %{ $db->{'oraTableSpace'} } )
+            {
+                my $INDEX = $db->{'oraTableSpace'}->{$tsName};
+
+                my $nick = $tsName;
+                $nick =~ s/^\///;
+                $nick =~ s/\W/_/g;
+                $nick =~ s/_+/_/g;
+
+                my $title = '%system-id%' . " $dbName $tsName";
+
+                my $tsParam = {
+                    'comment'   => "Table Space: $tsName",
+                    'precedence' => sprintf("%d", 10000 - $INDEX),
+                    'table-space-nick' => $nick,
+                    'table-space-name' => $tsName,
+                    'graph-title' => $title,
+                    'descriptive-nickname' => $title,
+                };
+
+                $cb->addSubtree( $tsNode, $nick, $tsParam,
+                                 [ 'OracleDatabase::table-space' ] );
+                Debug("Will add TableSpace: $tsName");
+            }
+        }
+
+        if( $devdetails->hasCap('oraDbDataFile') )
+        {
+            my $dfParam = {
+                'comment' => "Data Files for $dbName",
+                'precedence' => "500",
+            };
+
+            my $dfNode = $cb->addSubtree($dbNode, 'Data_Files', $dfParam );
+
+            foreach my $dfName ( keys %{ $db->{'oraDbDataFile'} } )
+            {
+                my $INDEX = $db->{'oraDbDataFile'}->{$dfName};
+
+                my $nick = $dfName;
+                $nick =~ s/^\///;
+                $nick =~ s/\W/_/g;
+                $nick =~ s/_+/_/g;
+
+                my $title = '%system-id%' . " $dbName $dfName";
+
+
+                my $dfParam = {
+                    'comment'   => "Data File: $dfName",
+                    'precedence' => sprintf("%d", 10000 - $INDEX),
+                    'data-file-nick' => $nick,
+                    'data-file-name' => $dfName,
+                    'graph-title' => $title,
+                    'dbBlockSize' => $dbBlockSize,
+                };
+
+                $cb->addSubtree( $dfNode, $nick, $dfParam,
+                                 ['OracleDatabase::data-file' ] );
+                Debug("Will add DataFile: $dfName");
+            }
+        }
+
+        if( $devdetails->hasCap('oraDbLibraryCache') )
+        {
+            my $lcParam = {
+                'comment' => "Library Cache for $dbName",
+                'precedence' => "400",
+            };
+
+            my $lcNode = $cb->addSubtree($dbNode, 'Library_Cache', $lcParam );
+
+            foreach my $lcName ( keys %{ $db->{'oraDbLibraryCache'} } )
+            {
+                my $INDEX = $db->{'oraDbLibraryCache'}->{$lcName};
+
+                my $nick = $lcName;
+                $nick =~ s/^\///;
+                $nick =~ s/\W/_/g;
+                $nick =~ s/_+/_/g;
+
+                my $title = '%system-id%' . " $dbName $lcName";
+
+                my $lcParam = {
+                    'comment'   => "Library Cache: $lcName",
+                    'precedence' => sprintf("%d", 10000 - $INDEX),
+                    'library-cache-nick' => $nick,
+                    'library-cache-name' => $lcName,
+                    'graph-title' => $title,
+                };
+
+                $cb->addSubtree( $lcNode, $nick, $lcParam,
+                                 ['OracleDatabase::library-cache'] );
+                Debug("Will add LibraryCache: $lcName");
+            }
+        }
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/Paradyne.pm b/torrus/perllib/Torrus/DevDiscover/Paradyne.pm
new file mode 100644
index 000000000..5e45f1782
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Paradyne.pm
@@ -0,0 +1,200 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Paradyne.pm,v 1.1 2010-12-27 00:03:48 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Paradyne devices discovery
+# A typical Paradyne device has several slots, and all slots are managed
+# through the same IP address, with different community strings.
+# That's why you have to configure "Paradyne::slot-name" parameter
+# in your discovery file, uniquely for each slot. A slot name should
+# not contain special characters.
+
+
+# Tested with:
+#
+#   - Paradyne GranDSLAM 2.0 DSLAM - Hotwire DSL;
+#     Model: 8000-B2-211; S/W Release : M04.02.27
+#
+#   - Paradyne Hotwire ATM ADSL Line Card;
+#     Model: 8365-B1-000; S/W Release: 02.03.54
+#
+#   - Paradyne Hotwire ATM G.SHDSL Line Card;
+#     Model: 8385-B1-000; S/W Release: 02.03.45
+#
+#   - Hotwire IP ReachDSL Line Card;
+#     Model: 8314-B3-000; S/W Release: 04.03.10
+
+
+package Torrus::DevDiscover::Paradyne;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'Paradyne'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # PDN-HEADER-MIB
+     'paradyne-products'                    => '1.3.6.1.4.1.1795.1.14',
+     'xdslDevIfStatsElapsedTimeLinkUp'      =>
+     '1.3.6.1.4.1.1795.2.24.2.6.8.1.1.1.1.4'
+     );
+
+our $statsInterval;
+if( not defined $statsInterval )
+{
+    $statsInterval = 6; # current15Minutes (GORD)
+}
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'paradyne-products',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+
+    if( length( $devdetails->param('Paradyne::slot-name') ) == 0 )
+    {
+        Error('Mandatory discovery parameter "Paradyne::slot-number" ' .
+              'is not defined for a Paradyne device: ' .
+              $devdetails->param('snmp-host') . ':' .
+              $devdetails->param('snmp-port') . ':' .
+              $devdetails->param('snmp-community'));
+        return 0;
+    }
+    
+    $devdetails->setCap('interfaceIndexingManaged');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    $data->{'nameref'}{'ifReferenceName'} = 'ifName';
+    $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT';
+    $data->{'param'}{'ifindex-table'} = '$ifName';
+    $data->{'nameref'}{'ifNick'} = 'ParadyneIfNick';
+
+    $data->{'nameref'}{'ifComment'} = 'ifDescr';
+
+    if( not defined( $data->{'param'}{'snmp-oids-per-pdu'} ) )
+    {
+        $data->{'param'}{'snmp-oids-per-pdu'} = '10';
+    }
+    
+    my $slot = $devdetails->param('Paradyne::slot-name');    
+    foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+        $interface->{'ParadyneIfNick'} =
+            $slot . '_' . $interface->{'ifNameT'};
+    }
+    
+    my $xdslOID = $dd->oiddef('xdslDevIfStatsElapsedTimeLinkUp');
+
+    my $xdslTable = $session->get_table( -baseoid => $xdslOID );
+    if( defined $xdslTable )
+    {
+        $devdetails->storeSnmpVars( $xdslTable );
+        $devdetails->setCap('paradyneXDSL');
+
+        foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+        {
+            if( $devdetails->hasOID( $xdslOID .'.'. $ifIndex .'.'.
+                                     $statsInterval ) )
+            {
+                push( @{$data->{'paradyneXDSLInterfaces'}}, $ifIndex );
+            }
+        }
+    }
+
+    return 1;
+}
+
+
+# Nothing really to do yet
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    if( $devdetails->hasCap('paradyneXDSL') )
+    {
+        my $subtreeName = 'XDSL_Line_Stats';
+
+        my $param = {
+            'precedence'           => '-600',
+            'comment'              => 'Paradyne XDSL line statistics',
+            'xdsl-stats-interval'  => $statsInterval
+            };
+        my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, $param );
+
+        my $data = $devdetails->data();
+
+        foreach my $ifIndex
+            ( sort {$a<=>$b} @{$data->{'paradyneXDSLInterfaces'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+
+            my $ifSubtreeName =
+                $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+
+            my $templates = ['Paradyne::paradyne-xdsl-interface'];
+
+            my $param = {
+                'interface-name' => $interface->{'param'}{'interface-name'},
+                'interface-nick' => $interface->{'param'}{'interface-nick'},
+                'comment'        => $interface->{'param'}{'comment'}
+            };
+
+            $cb->addSubtree( $subtreeNode, $ifSubtreeName,
+                             $param, $templates );
+        }
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/RFC1628_UPS_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC1628_UPS_MIB.pm
new file mode 100644
index 000000000..890843f47
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/RFC1628_UPS_MIB.pm
@@ -0,0 +1,180 @@
+#  Copyright (C) 2008  Jon Nistor
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RFC1628_UPS_MIB.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $
+# Jon Nistor <nistor at snickers dot org>
+
+# Discovery module for UPS-MIB (RFC 1628)
+#
+# Tested with:
+#     ConnectUPS Web/SNMP Card V4.20 [powerware 9390]
+#
+# Issues with:
+#     ConnectUPS Web/SNMP Card V3.16 [powerware 9155]
+#      - InputFrequency and InputTruePower are missing from RFC UPS-MIB
+#
+
+package Torrus::DevDiscover::RFC1628_UPS_MIB;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'RFC1628_UPS_MIB'} = {
+    'sequence'     => 100,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # UPS-MIB
+     'upsIdent'                     => '1.3.6.1.2.1.33.1.1',
+     'upsIdentManufacturer'         => '1.3.6.1.2.1.33.1.1.1.0',
+     'upsIdentModel'                => '1.3.6.1.2.1.33.1.1.2.0',
+     'upsIdentUPSSoftwareVersion'   => '1.3.6.1.2.1.33.1.1.3.0',
+     'upsIdentAgentSoftwareVersion' => '1.3.6.1.2.1.33.1.1.4.0',
+     'upsIdentName'                 => '1.3.6.1.2.1.33.1.1.5.0',
+
+     'upsInputNumLines'             => '1.3.6.1.2.1.33.1.3.2.0',
+     'upsOutputNumLines'            => '1.3.6.1.2.1.33.1.4.3.0',
+     'upsBypassNumLines'            => '1.3.6.1.2.1.33.1.5.2.0'
+     );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    return $dd->checkSnmpTable( 'upsIdent' );
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    my $upsInfo = $dd->retrieveSnmpOIDs('upsIdentManufacturer',
+                  'upsIdentModel', 'upsIdentUPSSoftwareVersion',
+                  'upsIdentAgentSoftwareVersion', 'upsIdentName',
+                  'upsInputNumLines', 'upsOutputNumLines', 'upsBypassNumLines');
+
+    $data->{'param'}{'comment'} = $upsInfo->{'upsIdentManufacturer'} . " " .
+                            $upsInfo->{'upsIdentModel'} . " " . 
+                            $upsInfo->{'upsIdentUPSSoftwareVersion'};
+
+    # PROG: Discover number of lines (in,out,bypass)...
+    $data->{'numInput'}  = $upsInfo->{'upsInputNumLines'};
+    $data->{'numOutput'} = $upsInfo->{'upsOutputNumLines'};
+    $data->{'numBypass'} = $upsInfo->{'upsBypassNumLines'};
+
+    Debug("UPS Lines  Input: " . $data->{'numInput'} .
+                  ", Output: " . $data->{'numOutput'} .
+                  ", Bypass: " . $data->{'numBypass'} );
+
+    if( $devdetails->param('RFC1628_UPS::disable-input') ne 'yes' )
+    {
+        $devdetails->setCap('UPS-input');
+    }
+
+    if( $devdetails->param('RFC1628_UPS::disable-output') ne 'yes' )
+    {
+        $devdetails->setCap('UPS-output');
+    }
+
+    if( $devdetails->param('RFC1628_UPS::disable-bypass') ne 'yes' )
+    {
+        $devdetails->setCap('UPS-bypass');
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    # PROG: Add static battery information
+    $cb->addSubtree( $devNode, 'Battery',
+                   { 'precedence' => 999 },
+                   [ 'RFC1628_UPS_MIB::battery-subtree' ] );
+    
+    if( $devdetails->hasCap('UPS-input') )
+    {
+        my $nodeInput = $cb->addSubtree( $devNode, 'Input',
+                                  { 'comment' => 'Input feeds' },
+                                  [ 'RFC1628_UPS_MIB::ups-input-subtree' ] );
+
+        foreach my $INDEX ( 1 .. $data->{'numInput'} )
+        {
+            $cb->addSubtree( $nodeInput, sprintf('Phase_%d', $INDEX),
+                             { 'ups-input-idx' => $INDEX },
+                             [ 'RFC1628_UPS::ups-input-leaf' ] );
+        }
+    }
+
+    if( $devdetails->hasCap('UPS-output') )
+    {
+        my $nodeOutput = $cb->addSubtree( $devNode, 'Output',
+                                   { 'comment' => 'Output feeds' },
+                                   [ 'RFC1628_UPS_MIB::ups-output-subtree' ] );
+
+        foreach my $INDEX ( 1 .. $data->{'numOutput'} )
+        {
+            $cb->addSubtree( $nodeOutput, sprintf('Phase_%d', $INDEX),
+                             { 'ups-output-idx' => $INDEX },
+                             [ 'RFC1628_UPS::ups-output-leaf' ] );
+        }
+    }
+
+    if( $devdetails->hasCap('UPS-bypass') )
+    {
+        my $nodeBypass = $cb->addSubtree( $devNode, 'Bypass',
+                                   { 'comment' => 'Bypass feeds' },
+                                   [ 'RFC1628_UPS_MIB::ups-bypass-subtree' ] );
+
+        foreach my $INDEX ( 1 .. $data->{'numBypass'} )
+        {
+            $cb->addSubtree( $nodeBypass, sprintf('Phase_%d', $INDEX),
+                             { 'ups-bypass-idx' => $INDEX },
+                             [ 'RFC1628_UPS::ups-bypass-leaf' ] );
+        }
+    }
+
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/RFC1657_BGP4_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC1657_BGP4_MIB.pm
new file mode 100644
index 000000000..c0a80399e
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/RFC1657_BGP4_MIB.pm
@@ -0,0 +1,85 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RFC1657_BGP4_MIB.pm,v 1.1 2010-12-27 00:03:54 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Discovery module for BGP4-MIB (RFC 1657)
+# This module does not generate any XML, but provides information
+# for other discovery modules. For the sake of discovery time and traffic,
+# it is not implicitly executed during the normal discovery process.
+
+package Torrus::DevDiscover::RFC1657_BGP4_MIB;
+
+use strict;
+use Torrus::Log;
+
+
+our %oiddef =
+    (
+     # BGP4-MIB
+     'bgpPeerRemoteAs'       => '1.3.6.1.2.1.15.3.1.9',
+     );
+
+
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    my $table = $session->get_table( -baseoid =>
+                                     $dd->oiddef('bgpPeerRemoteAs'));
+    
+    if( not defined( $table ) or scalar( %{$table} ) == 0 )
+    {
+        return 0;
+    }
+    
+    $devdetails->storeSnmpVars( $table );
+    $devdetails->setCap('bgpPeerTable');
+
+
+    foreach my $INDEX
+        ( $devdetails->
+          getSnmpIndices( $dd->oiddef('bgpPeerRemoteAs') ) )
+    {
+        my $ipAddr = $INDEX;
+
+        my $asNum =
+            $devdetails->snmpVar($dd->oiddef('bgpPeerRemoteAs') .
+                                 '.' . $INDEX);
+
+        $data->{'bgpPeerAS'}{$ipAddr} = $asNum;
+    }
+                            
+    return 1;
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/RFC1697_RDBMS.pm b/torrus/perllib/Torrus/DevDiscover/RFC1697_RDBMS.pm
new file mode 100644
index 000000000..56d348f6e
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/RFC1697_RDBMS.pm
@@ -0,0 +1,241 @@
+#  Copyright (C) 2003  Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RFC1697_RDBMS.pm,v 1.1 2010-12-27 00:03:52 ivan Exp $
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+
+# RDBMS MIB
+
+package Torrus::DevDiscover::RFC1697_RDBMS;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'RFC1697_RDBMS'} = {
+    'sequence'     => 100,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef =
+    (
+     # RDBMS-MIB
+     'rdbms'                            => '1.3.6.1.2.1.39',
+
+     'rdbmsDbTable'                     => '1.3.6.1.2.1.39.1.1.1',
+     'rdbmsDbIndex'                     => '1.3.6.1.2.1.39.1.1.1.1',
+     'rdbmsDbVendorName'                => '1.3.6.1.2.1.39.1.1.1.3',
+     'rdbmsDbName'                      => '1.3.6.1.2.1.39.1.1.1.4',
+     'rdbmsDbContact'                   => '1.3.6.1.2.1.39.1.1.1.5',
+     'rdbmsDbPrivateMIBOID'             => '1.3.6.1.2.1.39.1.1.1.2',
+
+     'rdbmsDbInfoTable'                 => '1.3.6.1.2.1.39.1.2.1',
+     'rdbmsDbInfoProductName'           => '1.3.6.1.2.1.39.1.2.1.1',
+     'rdbmsDbInfoVersion'               => '1.3.6.1.2.1.39.1.2.1.2',
+     'rdbmsDbInfoSizeUnits'             => '1.3.6.1.2.1.39.1.2.1.3',
+
+     # currently ignored, generally identical to rdbmsDb for oracle
+     'rdbmsSrvTable'                    => '1.3.6.1.2.1.39.1.5.1',
+     'rdbmsSrvVendorName'               => '1.3.6.1.2.1.39.1.5.1.2',
+     'rdbmsSrvProductName'              => '1.3.6.1.2.1.39.1.5.1.3',
+     'rdbmsSrvContact'                  => '1.3.6.1.2.1.39.1.5.1.4',
+     'rdbmsSrvPrivateMIBOID'            => '1.3.6.1.2.1.39.1.5.1.1',
+
+     # Oracle MIB base
+     'ora'                              => '1.3.6.1.4.1.111',
+
+     );
+
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    return $dd->checkSnmpTable('rdbms');
+}
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    my $DbInfoSizeUnits = {
+        1 => '1',                       # bytes
+        2 => '1024',                    # kbytes
+        3 => '1048576',                 # mbytes
+        4 => '1073741824',              # gbytes
+        5 => '1099511627776',           # tbytes
+    };
+
+    my $dbTypes = {
+        ora => $dd->oiddef('ora'),
+    };
+
+
+    my $rdbmsDbTable = $session->get_table( -baseoid =>
+                                            $dd->oiddef('rdbmsDbTable') );
+
+    my $rdbmsDbInfoTable =
+        $session->get_table( -baseoid =>
+                             $dd->oiddef('rdbmsDbInfoTable') );
+
+    if( defined( $rdbmsDbTable ) )
+    {
+        $devdetails->storeSnmpVars($rdbmsDbTable);
+        $devdetails->setCap('RDBMS::DbTable');
+
+        if( defined( $rdbmsDbInfoTable ) )
+        {
+            $devdetails->storeSnmpVars($rdbmsDbInfoTable);
+            $devdetails->setCap('RDBMS::DbInfoTable');
+        }
+        else
+        {
+            Debug("No Actively Opened Instances");
+        }
+
+        my $ref = {};
+        $ref->{'indices'} = [];
+        $data->{'DbTable'} = $ref;
+
+        foreach my $INDEX
+            ( $devdetails->getSnmpIndices( $dd->oiddef('rdbmsDbIndex') ) )
+        {
+            
+            push( @{$ref->{'indices'}}, $INDEX );
+            
+            my $vendor =
+                $devdetails->snmpVar( $dd->oiddef('rdbmsDbVendorName') .
+                                      '.' . $INDEX );
+
+            my $product =
+                $devdetails->snmpVar( $dd->oiddef('rdbmsDbInfoProductName') .
+                                      '.' . $INDEX );
+
+            my $version =
+                $devdetails->snmpVar( $dd->oiddef('rdbmsDbInfoVersion') .
+                                      '.' . $INDEX );
+
+            my $sizeUnits =
+                $devdetails->snmpVar( $dd->oiddef('rdbmsDbInfoSizeUnits') .
+                                      '.' . $INDEX );
+            $sizeUnits = $DbInfoSizeUnits->{$sizeUnits};
+
+            my $dbName =
+                $devdetails->snmpVar( $dd->oiddef('rdbmsDbName') .
+                                      '.' . $INDEX );
+
+            my $dbContact =
+                $devdetails->snmpVar( $dd->oiddef('rdbmsDbContact') .
+                                      '.' . $INDEX );
+
+            my $dbMIBOID =
+                $devdetails->snmpVar( $dd->oiddef('rdbmsDbPrivateMIBOID')
+                                      . '.' . $INDEX );
+
+            my $nick = "Vendor_" . $vendor . "_DB_" . $dbName;
+            $nick =~ s/^\///;
+            $nick =~ s/\W/_/g;
+            $nick =~ s/_+/_/g; 
+
+            my $descr = "Vendor: $vendor DB: $dbName";
+            $descr .= " Contact: $dbContact" if $dbContact;
+            $descr .= " Version: $version" if $version;
+
+            my $param = {};
+            $ref->{$INDEX}->{'param'} = $param;
+            $param->{'vendor'} = $vendor;
+            $param->{'product'} = $product;
+            $param->{'dbVersion'} = $version;
+            $param->{'dbSizeUnits'} = $sizeUnits;
+            $param->{'dbName'} = $dbName;
+            $param->{'dbMIBOID'} = $dbMIBOID;
+            $param->{'nick'} = $nick;
+            $param->{'comment'} = $descr;
+            $param->{'precedence'} = 1000 - $INDEX;
+
+            foreach my $dbType ( keys %{ $dbTypes } )
+            {
+                if( Net::SNMP::oid_base_match
+                    ( $dbTypes->{$dbType}, $dbMIBOID ) )
+                {
+                    if( not exists $data->{$dbType} )
+                    {
+                        $data->{$dbType} = {};
+                    }
+                    $data->{$dbType}->{$dbName}->{'index'} = $INDEX;
+                    Debug(" Added $dbName -> $INDEX to $dbType ");
+                    last;
+                }
+            }
+
+        }
+
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    return unless $devdetails->isDevType("RDBMS");
+
+    my $appParam = {
+        'precedence'    =>  -100000,
+    };
+
+    my $appNode = $cb->addSubtree( $devNode, 'Applications', $appParam );
+
+    my $param = { };
+    my $oraNode = $cb->addSubtree( $appNode, 'Oracle', $param );
+
+    if( $devdetails->hasCap('RDBMS::DbTable') )
+    {
+        my $ref = $data->{'DbTable'};
+
+        foreach my $INDEX ( @{ $ref->{'indices'} } )
+        {
+            my $param = $ref->{$INDEX}->{'param'};
+            $cb->addSubtree( $oraNode, $param->{'nick'}, $param,
+                             [ 'RFC1697_RDBMS::rdbms-dbtable' ], );
+        }
+
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2011_IP_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC2011_IP_MIB.pm
new file mode 100644
index 000000000..c7745b5e6
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/RFC2011_IP_MIB.pm
@@ -0,0 +1,94 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RFC2011_IP_MIB.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Discovery module for IP-MIB (RFC 2011)
+# This module does not generate any XML, but provides information
+# for other discovery modules. For the sake of discovery time and traffic,
+# it is not implicitly executed during the normal discovery process.
+
+package Torrus::DevDiscover::RFC2011_IP_MIB;
+
+use strict;
+use Torrus::Log;
+
+
+our %oiddef =
+    (
+     # IP-MIB
+     'ipNetToMediaTable'       => '1.3.6.1.2.1.4.22',
+     'ipNetToMediaPhysAddress' => '1.3.6.1.2.1.4.22.1.2',
+     );
+
+
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    my $table = $session->get_table( -baseoid =>
+                                     $dd->oiddef('ipNetToMediaPhysAddress'));
+    
+    if( not defined( $table ) or scalar( %{$table} ) == 0 )
+    {
+        return 0;
+    }
+    
+    $devdetails->storeSnmpVars( $table );
+
+    foreach my $INDEX
+        ( $devdetails->
+          getSnmpIndices( $dd->oiddef('ipNetToMediaPhysAddress') ) )
+    {
+        my( $ifIndex, @ipAddrOctets ) = split( '\.', $INDEX );
+        my $ipAddr = join('.', @ipAddrOctets);
+
+        my $interface = $data->{'interfaces'}{$ifIndex};
+        next if not defined( $interface );
+
+        my $phyAddr =
+            $devdetails->snmpVar($dd->oiddef('ipNetToMediaPhysAddress') .
+                                 '.' . $INDEX);
+
+        $interface->{'ipNetToMedia'}{$ipAddr} = $phyAddr;
+        $interface->{'mediaToIpNet'}{$phyAddr} = $ipAddr;
+
+        # Cisco routers assign ARP to subinterfaces, but MAC accounting
+        # to main interfaces. Let them search in a global table
+        $data->{'ipNetToMedia'}{$ipAddr} = $phyAddr;
+        $data->{'mediaToIpNet'}{$phyAddr} = $ipAddr;
+    }
+                            
+    return 1;
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2662_ADSL_LINE.pm b/torrus/perllib/Torrus/DevDiscover/RFC2662_ADSL_LINE.pm
new file mode 100644
index 000000000..1c69714ea
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/RFC2662_ADSL_LINE.pm
@@ -0,0 +1,140 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RFC2662_ADSL_LINE.pm,v 1.1 2010-12-27 00:03:53 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# ADSL Line statistics.
+
+# We assume that adslAturPhysTable is always present when adslAtucPhysTable
+# is there. Probably that's wrong, and needs to be redesigned.
+
+package Torrus::DevDiscover::RFC2662_ADSL_LINE;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'RFC2662_ADSL_LINE'} = {
+    'sequence'     => 100,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # ADSL-LINE-MIB
+     'adslAtucPhysTable'  => '1.3.6.1.2.1.10.94.1.1.2',
+     'adslAtucCurrSnrMgn' => '1.3.6.1.2.1.10.94.1.1.2.1.4',
+     'adslAturPhysTable' => '1.3.6.1.2.1.10.94.1.1.3'
+     );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    my $atucTable =
+        $session->get_table( -baseoid => $dd->oiddef('adslAtucPhysTable') );
+    if( not defined $atucTable )
+    {
+        return 0;
+    }
+    $devdetails->storeSnmpVars( $atucTable );
+
+    ## Do we need to check adslAtucPhysTable ? ##
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+
+    $data->{'adslAtucPhysTable'} = [];
+
+    foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+    {
+        if( $devdetails->hasOID( $dd->oiddef('adslAtucCurrSnrMgn') .
+                                 '.' . $ifIndex ) )
+        {
+            push( @{$data->{'adslAtucPhysTable'}}, $ifIndex );
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    # Build SNR subtree
+    my $subtreeName = 'ADSL_Line_Stats';
+
+    my $param = {
+        'precedence'         => '-600',
+        'comment'            => 'ADSL line statistics'
+        };
+    my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName, $param );
+
+    my $data = $devdetails->data();
+
+    foreach my $ifIndex ( sort {$a<=>$b} @{$data->{'adslAtucPhysTable'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        my $ifSubtreeName = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+
+        my $templates = ['RFC2662_ADSL_LINE::adsl-line-interface'];
+
+        my $param = {
+            'interface-name' => $interface->{'param'}{'interface-name'},
+            'interface-nick' => $interface->{'param'}{'interface-nick'},
+            'collector-timeoffset-hashstring' =>'%system-id%:%interface-nick%',
+            'comment'        => $interface->{'param'}{'comment'}
+        };
+        
+        $param->{'node-display-name'} =
+            $interface->{$data->{'nameref'}{'ifReferenceName'}};
+        
+        $cb->addSubtree( $subtreeNode, $ifSubtreeName, $param, $templates );
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2670_DOCS_IF.pm b/torrus/perllib/Torrus/DevDiscover/RFC2670_DOCS_IF.pm
new file mode 100644
index 000000000..91e30a555
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/RFC2670_DOCS_IF.pm
@@ -0,0 +1,307 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RFC2670_DOCS_IF.pm,v 1.1 2010-12-27 00:03:55 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# DOCSIS interface statistics
+
+package Torrus::DevDiscover::RFC2670_DOCS_IF;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'RFC2670_DOCS_IF'} = {
+    'sequence'     => 100,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{
+    'DocsisUpSNRMonitor'} = 'RFC2670_DOCS_IF';
+$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{
+    'DocsisUpSNRTokenset'} = 'RFC2670_DOCS_IF';
+
+$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{
+    'DocsisUpFECCorMonitor'} = 'RFC2670_DOCS_IF';
+$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{
+    'DocsisUpFECUncorMonitor'} = 'RFC2670_DOCS_IF';
+
+$Torrus::DevDiscover::RFC2863_IF_MIB::knownSelectorActions{
+    'DocsisDownUtilMonitor'} = 'RFC2670_DOCS_IF';
+
+
+our %oiddef =
+    (
+     # DOCS-IF-MIB
+     'docsIfDownstreamChannelTable' => '1.3.6.1.2.1.10.127.1.1.1',
+     'docsIfCmtsDownChannelCounterTable' => '1.3.6.1.2.1.10.127.1.3.10',
+     'docsIfSigQSignalNoise' => '1.3.6.1.2.1.10.127.1.1.4.1.5',
+     );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    if( $dd->checkSnmpTable( 'docsIfDownstreamChannelTable' ) )
+    {
+        return 1;
+    }
+
+    return 0;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    if( $dd->checkSnmpTable( 'docsIfCmtsDownChannelCounterTable' ) )
+    {
+        $devdetails->setCap('docsDownstreamUtil');
+    }
+
+    my $snrTable =
+        $session->get_table( -baseoid =>
+                             $dd->oiddef('docsIfSigQSignalNoise') );
+    if( defined( $snrTable ) )
+    {
+        $devdetails->storeSnmpVars( $snrTable );
+    }
+    
+    $data->{'docsCableMaclayer'} = [];
+    $data->{'docsCableDownstream'} = [];
+    $data->{'docsCableUpstream'} = [];
+
+    foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+        my $ifType = $interface->{'ifType'};
+
+        $interface->{'docsTemplates'} = [];
+        $interface->{'docsParams'} = {};
+
+        if( $devdetails->hasCap('interfaceIndexingPersistent') )
+        {
+            $interface->{'docsParams'}{'interface-index'} = $ifIndex;
+        }
+        
+        if( $ifType == 127 )
+        {
+            push( @{$data->{'docsCableMaclayer'}}, $ifIndex );
+        }
+        elsif(  $ifType == 128 )
+        {
+            push( @{$data->{'docsCableDownstream'}}, $ifIndex );
+            if( $devdetails->hasCap('docsDownstreamUtil') )
+            {
+                push( @{$interface->{'docsTemplates'}},
+                      'RFC2670_DOCS_IF::docsis-downstream-util' );
+            }
+        }
+        elsif( $ifType == 129 or $ifType == 205 )
+        {
+            if( $devdetails->hasOID( $dd->oiddef('docsIfSigQSignalNoise') .
+                                     '.' . $ifIndex ) )
+            {
+                push( @{$data->{'docsCableUpstream'}}, $ifIndex );
+                push( @{$interface->{'docsTemplates'}},
+                      'RFC2670_DOCS_IF::docsis-upstream-stats' );
+                
+            }
+        }
+    }
+    
+    if( $devdetails->param('RFC2670_DOCS_IF::upstreams-only') eq 'yes' )
+    {
+        $data->{'docsCableMaclayer'} = [];
+        $data->{'docsCableDownstream'} = [];
+    }
+
+    $data->{'docsConfig'} = {
+        'docsCableMaclayer' => {
+            'subtreeName' => 'Docsis_MAC_Layer',
+            'nodeidCategory' => 'docsmac',
+            'templates' => [],
+            'param' => {
+                'node-display-name' => 'DOCSIS MAC Layer',
+            },            
+        },
+        'docsCableDownstream' => {
+            'subtreeName' => 'Docsis_Downstream',
+            'nodeidCategory' => 'docsds',
+            'templates' => [],
+            'param' => {
+                'node-display-name' => 'DOCSIS Downstream',
+            },            
+        },
+        'docsCableUpstream' => {
+            'subtreeName' => 'Docsis_Upstream',
+            'nodeidCategory' => 'docsus',
+            'templates' => ['RFC2670_DOCS_IF::docsis-upstream-subtree'],
+            'param' => {
+                'node-display-name' => 'DOCSIS Upstream',
+            },            
+        },
+    };
+
+    if( $devdetails->hasCap('docsDownstreamUtil') )
+    {
+        push( @{$data->{'docsConfig'}{'docsCableDownstream'}{'templates'}},
+              'RFC2670_DOCS_IF::docsis-downstream-subtree' );        
+    }
+    
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    foreach my $category ( sort keys %{$data->{'docsConfig'}} )
+    {
+        if( scalar( @{$data->{$category}} ) > 0 and
+            scalar( @{$data->{'docsConfig'}{$category}{'templates'}} ) > 0 )
+        {
+            # Count non-excluded interfaces
+            my $updatedInterfaceList = [];
+            foreach my $ifIndex ( @{$data->{$category}} )
+            {
+                my $interface = $data->{'interfaces'}{$ifIndex};
+                next if $interface->{'excluded'};
+                push( @{$updatedInterfaceList}, $ifIndex );
+            }
+            $data->{$category} = $updatedInterfaceList;
+            
+            next if scalar( @{$data->{$category}} ) == 0;
+
+            my $subtreeNode =
+                $cb->addSubtree( $devNode,
+                                 $data->{'docsConfig'}{$category}{
+                                     'subtreeName'},
+                                 $data->{'docsConfig'}{$category}{
+                                     'param'},
+                                 $data->{'docsConfig'}{$category}{
+                                     'templates'});
+
+            foreach my $ifIndex ( @{$data->{$category}} )
+            {
+                my $interface = $data->{'interfaces'}{$ifIndex};
+
+                my $param = $interface->{'docsParams'};
+
+                $param->{'searchable'} = 'yes';
+
+                # Copy some parameters from IF-MIB discovery results
+                
+                foreach my $p ('interface-name', 'interface-nick',
+                               'node-display-name', 'comment')
+                {
+                    $param->{$p} = $interface->{'param'}{$p};
+                }
+                
+                $param->{'nodeid-docsif'} =
+                    $data->{'docsConfig'}{$category}{'nodeidCategory'} .
+                    '//%nodeid-device%//' .
+                    $interface->{$data->{'nameref'}{'ifNodeid'}};
+                
+                $param->{'nodeid'} = '%nodeid-docsif%';
+                
+                my $intfNode = $cb->addSubtree
+                    ( $subtreeNode,
+                      $interface->{$data->{'nameref'}{'ifSubtreeName'}},
+                      $param, 
+                      $interface->{'docsTemplates'} );
+
+                # Apply selector actions
+                if( $category eq 'docsCableUpstream' )
+                {
+                    my $monitor =
+                        $interface->{'selectorActions'}{'DocsisUpSNRMonitor'};
+                    my $tset =
+                        $interface->{'selectorActions'}{'DocsisUpSNRTokenset'};
+                    if( defined( $monitor ) or defined( $tset ) )
+                    {
+                        my $param = {};
+                        if( defined( $monitor ) )
+                        {
+                            $param->{'monitor'} = $monitor;
+                        }
+                        if( defined( $tset ) )
+                        {
+                            $param->{'tokenset-member'} = $tset;
+                        }
+                        $cb->addLeaf( $intfNode, 'SNR', $param );
+                    }
+
+                    $monitor = $interface->{'selectorActions'}{
+                        'DocsisUpFECCorMonitor'};
+                    if( defined( $monitor ) )
+                    {
+                        $cb->addLeaf( $intfNode, 'Correctable',
+                                      {'monitor' => $monitor } );
+                    }
+
+                    $monitor = $interface->{'selectorActions'}{
+                        'DocsisUpFECUncorMonitor'};
+                    if( defined( $monitor ) )
+                    {
+                        $cb->addLeaf( $intfNode, 'Uncorrectable',
+                                      {'monitor' => $monitor } );
+                    }                                        
+                }
+                elsif( $category eq 'docsCableDownstream')
+                {
+                    my $monitor = $interface->{'selectorActions'}{
+                        'DocsisDownUtilMonitor'};
+                    if( defined( $monitor ) )
+                    {
+                        $cb->addLeaf( $intfNode, 'UsedBytes',
+                                      {'monitor' => $monitor } );
+                    }
+                }
+            }
+        }
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2737_ENTITY_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC2737_ENTITY_MIB.pm
new file mode 100644
index 000000000..596152f01
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/RFC2737_ENTITY_MIB.pm
@@ -0,0 +1,152 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RFC2737_ENTITY_MIB.pm,v 1.1 2010-12-27 00:03:56 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Discovery module for ENTITY-MIB (RFC 2737)
+# This module does not generate any XML, but provides information
+# for other discovery modules
+
+package Torrus::DevDiscover::RFC2737_ENTITY_MIB;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'RFC2737_ENTITY_MIB'} = {
+    'sequence'     => 100,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # ENTITY-MIB
+     'entPhysicalDescr'        => '1.3.6.1.2.1.47.1.1.1.1.2',
+     'entPhysicalContainedIn'  => '1.3.6.1.2.1.47.1.1.1.1.4',
+     'entPhysicalName'         => '1.3.6.1.2.1.47.1.1.1.1.7'
+     );
+
+
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    my $descrTable =
+        $session->get_table( -baseoid =>
+                             $dd->oiddef('entPhysicalDescr') );
+    if( defined $descrTable )
+    {
+        $devdetails->storeSnmpVars( $descrTable );
+    }
+
+    my $nameTable =
+        $session->get_table( -baseoid =>
+                             $dd->oiddef('entPhysicalName') );
+    if( defined $nameTable )
+    {
+        $devdetails->storeSnmpVars( $nameTable );
+    }
+
+    return( defined($descrTable) or defined($nameTable) );
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    $data->{'entityPhysical'} = {};
+
+    my $chassisIndex = 0;
+    my $oidContainedIn = $dd->oiddef('entPhysicalContainedIn');
+
+    foreach my $phyIndex
+        ( $devdetails->getSnmpIndices($dd->oiddef('entPhysicalDescr')) )
+    {
+        my $ref = {};
+        $data->{'entityPhysical'}{$phyIndex} = $ref;
+
+        # Find the chassis. It is not contained in anything.
+        if( not $chassisIndex )
+        {
+            my $oid = $oidContainedIn . '.' . $phyIndex;
+            my $result = $session->get_request( -varbindlist => [ $oid ] );
+            if( $session->error_status() == 0 and $result->{$oid} == 0 )
+            {
+                $chassisIndex = $phyIndex;
+            }
+        }
+
+        my $descr = $devdetails->snmpVar( $dd->oiddef('entPhysicalDescr') .
+                                          '.' . $phyIndex );
+        if( $descr )
+        {
+            $ref->{'descr'} = $descr;
+        }
+
+        my $name = $devdetails->snmpVar( $dd->oiddef('entPhysicalName') .
+                                         '.' . $phyIndex );
+        if( $name )
+        {
+            $ref->{'name'} = $name;
+        }
+    }
+
+    if( $chassisIndex )
+    {
+        $data->{'entityChassisPhyIndex'} = $chassisIndex;
+        my $chassisDescr = $data->{'entityPhysical'}{$chassisIndex}{'descr'};
+        if( length( $chassisDescr ) > 0 and
+            not defined( $data->{'param'}{'comment'} ) )
+        {
+            Debug('ENTITY-MIB: found chassis description: ' . $chassisDescr);
+            $data->{'param'}{'comment'} = $chassisDescr;
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2790_HOST_RESOURCES.pm b/torrus/perllib/Torrus/DevDiscover/RFC2790_HOST_RESOURCES.pm
new file mode 100644
index 000000000..8e79d9d78
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/RFC2790_HOST_RESOURCES.pm
@@ -0,0 +1,263 @@
+#  Copyright (C) 2003 Shawn Ferry, Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RFC2790_HOST_RESOURCES.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Standard HOST_RESOURCES_MIB discovery, which should apply to most hosts
+
+package Torrus::DevDiscover::RFC2790_HOST_RESOURCES;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'RFC2790_HOST_RESOURCES'} = {
+    'sequence'     => 100,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+# define the oids that are needed to determine support,
+# capabilities and information about the device
+our %oiddef =
+    (
+     'hrSystemUptime'               => '1.3.6.1.2.1.25.1.1.0',
+     'hrSystemNumUsers'             => '1.3.6.1.2.1.25.1.5.0',
+     'hrSystemProcesses'            => '1.3.6.1.2.1.25.1.6.0',
+     'hrSystemMaxProcesses'         => '1.3.6.1.2.1.25.1.7.0',
+     'hrMemorySize'                 => '1.3.6.1.2.1.25.2.2.0',
+     'hrStorageTable'               => '1.3.6.1.2.1.25.2.3.1',
+     'hrStorageIndex'               => '1.3.6.1.2.1.25.2.3.1.1',
+     'hrStorageType'                => '1.3.6.1.2.1.25.2.3.1.2',
+     'hrStorageDescr'               => '1.3.6.1.2.1.25.2.3.1.3',
+     'hrStorageAllocationUnits'     => '1.3.6.1.2.1.25.2.3.1.4',
+     'hrStorageSize'                => '1.3.6.1.2.1.25.2.3.1.5',
+     'hrStorageUsed'                => '1.3.6.1.2.1.25.2.3.1.6',
+     'hrStorageAllocationFailures'  => '1.3.6.1.2.1.25.2.3.1.7'
+     );
+
+
+our %storageDescTranslate =  ( '/' => {'subtree' => 'root' } );
+
+# storage type names from MIB
+my %storageTypes =
+    (
+     1  => 'Other Storage',
+     2  => 'Physical Memory (RAM)',
+     3  => 'Virtual Memory',
+     4  => 'Fixed Disk',
+     5  => 'Removable Disk',
+     6  => 'Floppy Disk',
+     7  => 'Compact Disk',
+     8  => 'RAM Disk',
+     9  => 'Flash Memory',
+     10 => 'Network File System'
+     );
+
+our $storageGraphTop;
+our $storageHiMark;
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    return $dd->checkSnmpOID('hrSystemUptime');
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    if( $dd->checkSnmpOID('hrSystemNumUsers') )
+    {
+        $devdetails->setCap('hrSystemNumUsers');
+    }
+
+    if( $dd->checkSnmpOID('hrSystemProcesses') )
+    {
+        $devdetails->setCap('hrSystemProcesses');
+    }
+
+    # hrStorage support
+    my $hrStorageTable = $session->get_table( -baseoid =>
+                                              $dd->oiddef('hrStorageTable') );
+    if( defined( $hrStorageTable ) )
+    {
+        $devdetails->storeSnmpVars( $hrStorageTable );
+
+        my $ref = {};
+        $data->{'hrStorage'} = $ref;
+
+        foreach my $INDEX
+            ( $devdetails->getSnmpIndices($dd->oiddef('hrStorageIndex') ) )
+        {
+            my $typeNum = $devdetails->snmpVar( $dd->oiddef('hrStorageType') .
+                                                '.' . $INDEX );
+            $typeNum =~ s/^[0-9.]+\.(\d+)$/$1/;
+
+            my $descr = $devdetails->snmpVar($dd->oiddef('hrStorageDescr')
+                                             . '.' . $INDEX);
+
+            my $used =  $devdetails->snmpVar($dd->oiddef('hrStorageUsed')
+                                             . '.' . $INDEX);
+
+            if( defined( $used ) and $storageTypes{$typeNum} )
+            {
+                my $ref = { 'param' => {}, 'templates' => [] };
+                $data->{'hrStorage'}{$INDEX} = $ref;
+                my $param = $ref->{'param'};
+
+                $param->{'storage-description'} = $descr;
+
+                my $comment = $storageTypes{$typeNum};
+                if( $descr =~ /^\// )
+                {
+                    $comment .= ' (' . $descr . ')';
+                }
+                $param->{'comment'} = $comment;
+
+                if( $storageDescTranslate{$descr}{'subtree'} )
+                {
+                    $descr = $storageDescTranslate{$descr}{'subtree'};
+                }
+                $descr =~ s/^\///;
+                $descr =~ s/\W/_/g;
+                $param->{'storage-nick'} = $descr;
+
+                my $units =
+                    $devdetails->snmpVar
+                    ($dd->oiddef('hrStorageAllocationUnits') . '.' . $INDEX);
+
+                $param->{'collector-scale'} = sprintf('%d,*', $units);
+
+                my $size =
+                    $devdetails->snmpVar
+                    ($dd->oiddef('hrStorageSize') . '.' . $INDEX);
+
+                if( $size )
+                {
+                    if( $storageGraphTop > 0 )
+                    {
+                        $param->{'graph-upper-limit'} =
+                            sprintf('%e',
+                                    $units * $size * $storageGraphTop / 100 );
+                    }
+
+                    if( $storageHiMark > 0 )
+                    {
+                        $param->{'upper-limit'} =
+                            sprintf('%e',
+                                    $units * $size * $storageHiMark / 100 );
+                    }
+                }
+
+                push( @{ $ref->{'templates'} },
+                      'RFC2790_HOST_RESOURCES::hr-storage-usage' );
+            }
+        }
+
+        if( scalar( keys %{$data->{'hrStorage'}} ) > 0 )
+        {
+            $devdetails->setCap('hrStorage');
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    { # Anon sub for System Info
+        my $subtreeName =
+            $devdetails->param('RFC2790_HOST_RESOURCES::sysperf-subtree-name');
+        if( not defined( $subtreeName ) )
+        {
+            $subtreeName = 'System_Performance';
+            $devdetails->setParam
+                ('RFC2790_HOST_RESOURCES::sysperf-subtree-name', $subtreeName);
+        }
+
+        my $param = {};
+
+        my @templates =
+            ('RFC2790_HOST_RESOURCES::hr-system-performance-subtree',
+             'RFC2790_HOST_RESOURCES::hr-system-uptime');
+        if( $devdetails->hasCap('hrSystemNumUsers') )
+        {
+            push( @templates, 'RFC2790_HOST_RESOURCES::hr-system-num-users' );
+        }
+
+        if( $devdetails->hasCap('hrSystemProcesses') )
+        {
+            push( @templates, 'RFC2790_HOST_RESOURCES::hr-system-processes' );
+        }
+
+        my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName,
+                                           $param, \@templates );
+    }
+
+    if( $devdetails->hasCap('hrStorage') )
+    {
+        # Build hrstorage subtree
+        my $subtreeName = 'Storage_Used';
+
+        my $param = {};
+        my @templates = ('RFC2790_HOST_RESOURCES::hr-storage-subtree');
+        my $subtreeNode = $cb->addSubtree( $devNode, $subtreeName,
+                                           $param, \@templates  );
+
+        foreach my $INDEX ( sort {$a<=>$b} keys %{$data->{'hrStorage'}} )
+        {
+            my $ref = $data->{'hrStorage'}{$INDEX};
+
+            #Display in index order, This is generally good(tm)
+            $ref->{'param'}->{'precedence'} = sprintf("%d", 1000 - $INDEX);
+
+            $cb->addLeaf( $subtreeNode, $ref->{'param'}{'storage-nick'},
+                          $ref->{'param'}, $ref->{'templates'} );
+        }
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/RFC2863_IF_MIB.pm b/torrus/perllib/Torrus/DevDiscover/RFC2863_IF_MIB.pm
new file mode 100644
index 000000000..a3ae8013f
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/RFC2863_IF_MIB.pm
@@ -0,0 +1,1404 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RFC2863_IF_MIB.pm,v 1.1 2010-12-27 00:03:57 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Standard IF_MIB discovery, which should apply to most devices
+
+package Torrus::DevDiscover::RFC2863_IF_MIB;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'RFC2863_IF_MIB'} = {
+    'sequence'     => 50,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig,
+    'buildGlobalConfig' => \&buildGlobalConfig
+    };
+
+
+our %oiddef =
+    (
+     'ifTable'          => '1.3.6.1.2.1.2.2',
+     'ifDescr'          => '1.3.6.1.2.1.2.2.1.2',
+     'ifType'           => '1.3.6.1.2.1.2.2.1.3',
+     'ifSpeed'          => '1.3.6.1.2.1.2.2.1.5',
+     'ifPhysAddress'    => '1.3.6.1.2.1.2.2.1.6',
+     'ifAdminStatus'    => '1.3.6.1.2.1.2.2.1.7',
+     'ifOperStatus'     => '1.3.6.1.2.1.2.2.1.8',
+     'ifInOctets'       => '1.3.6.1.2.1.2.2.1.10',
+     'ifInUcastPkts'    => '1.3.6.1.2.1.2.2.1.11',
+     'ifInDiscards'     => '1.3.6.1.2.1.2.2.1.13',
+     'ifInErrors'       => '1.3.6.1.2.1.2.2.1.14',
+     'ifOutOctets'      => '1.3.6.1.2.1.2.2.1.16',
+     'ifOutUcastPkts'   => '1.3.6.1.2.1.2.2.1.17',
+     'ifOutDiscards'    => '1.3.6.1.2.1.2.2.1.19',
+     'ifOutErrors'      => '1.3.6.1.2.1.2.2.1.20',
+     'ifXTable'         => '1.3.6.1.2.1.31.1.1',
+     'ifName'           => '1.3.6.1.2.1.31.1.1.1.1',
+     'ifHCInOctets'     => '1.3.6.1.2.1.31.1.1.1.6',
+     'ifHCInUcastPkts'  => '1.3.6.1.2.1.31.1.1.1.7',
+     'ifHCOutOctets'    => '1.3.6.1.2.1.31.1.1.1.10',
+     'ifHCOutUcastPkts' => '1.3.6.1.2.1.31.1.1.1.11',
+     'ifHighSpeed'      => '1.3.6.1.2.1.31.1.1.1.15',     
+     'ifAlias'          => '1.3.6.1.2.1.31.1.1.1.18'
+     );
+
+
+
+# Just curious, are there any devices without ifTable?
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    return $dd->checkSnmpTable('ifTable');
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+    
+    my $session = $dd->session();
+    
+    my $ifTable =
+        $session->get_table( -baseoid => $dd->oiddef('ifTable') );
+    if( not defined $ifTable )
+    {
+        Error('Cannot retrieve ifTable');
+        return 0;
+    }
+    $devdetails->storeSnmpVars( $ifTable );
+
+    my $ifXTable =
+        $session->get_table( -baseoid => $dd->oiddef('ifXTable') );
+    if( defined $ifXTable )
+    {
+        $devdetails->storeSnmpVars( $ifXTable );
+        $devdetails->setCap('ifXTable');
+
+        if( $devdetails->hasOID( $dd->oiddef('ifName') ) )
+        {
+            $devdetails->setCap('ifName');
+        }
+
+        if( $devdetails->hasOID( $dd->oiddef('ifAlias') ) )
+        {
+            $devdetails->setCap('ifAlias');
+        }
+        
+        if( $devdetails->hasOID( $dd->oiddef('ifHighSpeed') ) )
+        {
+            $devdetails->setCap('ifHighSpeed');
+        }
+    }
+
+    ## Fill in per-interface data. This is normally done within discover(),
+    ## but in our case we want to give other modules more control as early
+    ## as possible.
+
+    # Define the tables used for subtree naming, interface indexing,
+    # and RRD file naming
+    my $data = $devdetails->data();
+
+    $data->{'param'}{'has-inout-leaves'} = 'yes';
+
+    ## Set default interface index mapping
+    
+    $data->{'nameref'}{'ifSubtreeName'} = 'ifDescrT';
+    $data->{'nameref'}{'ifReferenceName'}   = 'ifDescr';
+
+    if( $devdetails->hasCap('ifName') )
+    {
+        $data->{'nameref'}{'ifNick'} = 'ifNameT';
+    }
+    else
+    {
+        $data->{'nameref'}{'ifNick'} = 'ifDescrT';
+    }
+
+    if( $devdetails->hasCap('ifAlias') )
+    {
+        $data->{'nameref'}{'ifComment'} = 'ifAlias';
+    }
+    
+    # Pre-populate the interfaces table, so that other modules may
+    # delete unneeded interfaces
+    my $includeAdmDown =
+        $devdetails->param('RFC2863_IF_MIB::list-admindown-interfaces')
+        eq 'yes';
+    my $includeNotpresent =
+        $devdetails->param('RFC2863_IF_MIB::list-notpresent-interfaces')
+        eq 'yes';
+    my $excludeOperDown =
+        $devdetails->param('RFC2863_IF_MIB::exclude-down-interfaces')
+        eq 'yes';
+    foreach my $ifIndex
+        ( $devdetails->getSnmpIndices( $dd->oiddef('ifDescr') ) )
+    {
+        my $admStatus =
+            $devdetails->snmpVar($dd->oiddef('ifAdminStatus') .'.'. $ifIndex);
+        my $operStatus =
+            $devdetails->snmpVar($dd->oiddef('ifOperStatus') .'.'. $ifIndex);
+        
+        if( ( $admStatus == 1 or $includeAdmDown ) and
+            ( $operStatus != 6 or $includeNotpresent ) and
+            ( $operStatus != 2 or not $excludeOperDown ) )
+        {
+            my $interface = {};
+            $data->{'interfaces'}{$ifIndex} = $interface;
+
+            $interface->{'param'} = {};
+            $interface->{'vendor_templates'} = [];
+
+            $interface->{'ifType'} =
+                $devdetails->snmpVar($dd->oiddef('ifType') . '.' . $ifIndex);
+
+            my $descr = $devdetails->snmpVar($dd->oiddef('ifDescr') .
+                                             '.' . $ifIndex);
+            $interface->{'ifDescr'} = $descr;
+            $descr =~ s/\W/_/g;
+            # Some SNMP agents send extra zero byte at the end
+            $descr =~ s/_+$//;
+            $interface->{'ifDescrT'} = $descr;
+
+            if( $devdetails->hasCap('ifName') )
+            {
+                my $iname = $devdetails->snmpVar($dd->oiddef('ifName') .
+                                                 '.' . $ifIndex);
+                if( $iname !~ /\w/ )
+                {
+                    $iname = $interface->{'ifDescr'};
+                    Warn('Empty or invalid ifName for interface ' . $iname);
+                }
+                $interface->{'ifName'} = $iname;
+                $iname =~ s/\W/_/g;
+                $interface->{'ifNameT'} = $iname;
+            }
+
+            if( $devdetails->hasCap('ifAlias') )
+            {
+                $interface->{'ifAlias'} =
+                    $devdetails->snmpVar($dd->oiddef('ifAlias') .
+                                         '.' . $ifIndex);
+            }
+
+            my $bw = 0;
+            if( $devdetails->hasCap('ifHighSpeed') )
+            {
+                my $hiBW = 
+                    $devdetails->snmpVar($dd->oiddef('ifHighSpeed') . '.' .
+                                         $ifIndex);
+                if( $hiBW >= 10 )
+                {
+                    $bw = 1e6 * $hiBW;
+                }
+            }
+
+            if( $bw == 0 )
+            {
+                $bw = 
+                    $devdetails->snmpVar($dd->oiddef('ifSpeed') . '.' .
+                                         $ifIndex);
+            }
+            
+            if( $bw > 0 )
+            {
+                $interface->{'ifSpeed'} = $bw;
+            }
+        }
+    }
+
+    ## Process hints on interface indexing
+    ## The capability 'interfaceIndexingManaged' disables the hints
+    ## and lets the vendor discovery module to operate the indexing
+    
+    if( not $devdetails->hasCap('interfaceIndexingManaged') and
+        not $devdetails->hasCap('interfaceIndexingPersistent') )
+    {
+        my $hint =
+            $devdetails->param('RFC2863_IF_MIB::ifindex-map-hint');
+        if( defined( $hint ) )
+        {
+            if( $hint eq 'ifName' )
+            {
+                if( not $devdetails->hasCap('ifName') )
+                {
+                    Error('Cannot use ifName interface mapping: ifName is '.
+                          'not supported by device');
+                    return 0;
+                }
+                else
+                {
+                    $data->{'nameref'}{'ifReferenceName'} = 'ifName';
+                    $data->{'param'}{'ifindex-table'} = '$ifName';
+                }
+            }
+            elsif( $hint eq 'ifPhysAddress' )
+            {
+                $data->{'param'}{'ifindex-map'} = '$IFIDX_MAC';
+                retrieveMacAddresses( $dd, $devdetails );
+            }
+            elsif( $hint eq 'ifIndex' )
+            {
+                $devdetails->setCap('interfaceIndexingPersistent');
+            }
+            else
+            {
+                Error('Unknown value of RFC2863_IF_MIB::ifindex-map-hint: ' .
+                      $hint);
+            }
+        }
+            
+        $hint =
+            $devdetails->param('RFC2863_IF_MIB::subtree-name-hint');
+        if( defined( $hint ) )
+        {
+            if( $hint eq 'ifName' )
+            {
+                $data->{'nameref'}{'ifSubtreeName'} = 'ifNameT';
+            }
+            else
+            {
+                Error('Unknown value of RFC2863_IF_MIB::subtree-name-hint: ' .
+                      $hint);
+            }
+        }
+        
+        $hint =
+            $devdetails->param('RFC2863_IF_MIB::nodeid-hint');
+        if( defined( $hint ) )
+        {
+            $data->{'nameref'}{'ifNodeid'} = $hint;
+        }
+    }
+    
+    if( $devdetails->hasCap('interfaceIndexingPersistent') )
+    {
+        $data->{'param'}{'ifindex-map'} = '$IFIDX_IFINDEX';
+        storeIfIndexParams( $devdetails );
+    }
+
+    if( not defined( $data->{'nameref'}{'ifNodeid'} ) )
+    {
+        $data->{'nameref'}{'ifNodeid'} = 'ifNodeid';
+    }
+    
+    if( not defined( $data->{'nameref'}{'ifNodeidPrefix'} ) )
+    {
+        $data->{'nameref'}{'ifNodeidPrefix'} = 'ifNodeidPrefix';
+    }
+    
+    # Filter out the interfaces if needed
+
+    if( ref( $data->{'interfaceFilter'} ) )
+    {
+        foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} )
+        {
+            my $interface = $data->{'interfaces'}{$ifIndex};
+            my $match = 0;
+
+            foreach my $filterHash ( @{$data->{'interfaceFilter'}} )
+            {
+                last if $match;
+                foreach my $filter ( values %{$filterHash} )
+                {
+                    last if $match;
+
+                    if( defined( $filter->{'ifType'} ) and
+                        $interface->{'ifType'} == $filter->{'ifType'} )
+                    {
+                        if( not defined( $filter->{'ifDescr'} ) or
+                            $interface->{'ifDescr'} =~ $filter->{'ifDescr'} )
+                        {
+                            $match = 1;
+                        }
+                    }
+                }
+            }
+
+            if( $match )
+            {
+                Debug('Excluding interface: ' .
+                      $interface->{$data->{'nameref'}{'ifReferenceName'}});
+                delete $data->{'interfaces'}{$ifIndex};
+            }
+        }
+    }
+
+    my $suppressHCCounters =
+        $devdetails->param('RFC2863_IF_MIB::suppress-hc-counters') eq 'yes';
+
+    # Explore each interface capability
+
+    foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        if( $devdetails->hasOID( $dd->oiddef('ifInOctets') .
+                                 '.' . $ifIndex )
+            and
+            $devdetails->hasOID( $dd->oiddef('ifOutOctets') .
+                                 '.' . $ifIndex ) )
+        {
+            $interface->{'hasOctets'} = 1;
+        }
+
+        if( $devdetails->hasOID( $dd->oiddef('ifInUcastPkts') .
+                                 '.' . $ifIndex )
+            and
+            $devdetails->hasOID( $dd->oiddef('ifOutUcastPkts') .
+                                 '.' . $ifIndex ) )
+        {
+            $interface->{'hasUcastPkts'} = 1;
+        }
+
+        if( $devdetails->hasOID( $dd->oiddef('ifInDiscards') .
+                                 '.' . $ifIndex ) )
+        {
+            $interface->{'hasInDiscards'} = 1;
+        }
+
+        if( $devdetails->hasOID( $dd->oiddef('ifOutDiscards') .
+                                 '.' . $ifIndex ) )
+        {
+            $interface->{'hasOutDiscards'} = 1;
+        }
+
+        if( $devdetails->hasOID( $dd->oiddef('ifInErrors') .
+                                 '.' . $ifIndex ) )
+        {
+            $interface->{'hasInErrors'} = 1;
+        }
+
+        if( $devdetails->hasOID( $dd->oiddef('ifOutErrors') .
+                                 '.' . $ifIndex ) )
+        {
+            $interface->{'hasOutErrors'} = 1;
+        }
+
+        if( $devdetails->hasCap('ifXTable') and not $suppressHCCounters )
+        {
+            if( $devdetails->hasOID( $dd->oiddef('ifHCInOctets') .
+                                     '.' . $ifIndex )
+                and
+                $devdetails->hasOID( $dd->oiddef('ifHCOutOctets') .
+                                     '.' . $ifIndex ) )
+            {
+                $interface->{'hasHCOctets'} = 1;
+            }
+
+            if( $devdetails->hasOID( $dd->oiddef('ifHCInUcastPkts') .
+                                     '.' . $ifIndex )
+                and
+                $devdetails->hasOID( $dd->oiddef('ifHCOutUcastPkts') .
+                                     '.' . $ifIndex ) )
+            {
+                $interface->{'hasHCUcastPkts'} = 1;
+            }
+        }
+    }
+
+    push( @{$data->{'templates'}}, 'RFC2863_IF_MIB::rfc2863-ifmib-hostlevel' );
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $globalData = shift;
+
+    my $data = $devdetails->data();
+
+    if( scalar( keys %{$data->{'interfaces'}} ) == 0 )
+    {
+        return;
+    }   
+    
+    # Make sure that ifNick and ifSubtreeName are unique across interfaces
+
+    uniqueEntries( $devdetails, $data->{'nameref'}{'ifNick'} );
+    uniqueEntries( $devdetails, $data->{'nameref'}{'ifSubtreeName'} );
+
+    # If other discovery modules don't set nodeid reference, fall back to
+    # default interface reference
+    
+    
+    # Build interface parameters
+
+    my $nInterfaces = 0;
+   
+    foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        next if $interface->{'excluded'};
+        $nInterfaces++;
+
+        $interface->{'param'}{'searchable'} = 'yes';
+        
+        $interface->{'param'}{'interface-iana-type'} = $interface->{'ifType'};
+
+        $interface->{'param'}{'interface-name'} =
+            $interface->{$data->{'nameref'}{'ifReferenceName'}};
+
+        $interface->{'param'}{'node-display-name'} =
+            $interface->{$data->{'nameref'}{'ifReferenceName'}};
+
+        $interface->{'param'}{'interface-nick'} =
+            $interface->{$data->{'nameref'}{'ifNick'}};
+
+        if( not defined( $interface->{$data->{'nameref'}{'ifNodeidPrefix'}} ) )
+        {
+            $interface->{$data->{'nameref'}{'ifNodeidPrefix'}} =
+                'if//%nodeid-device%//';
+        }
+        
+        if( not defined( $interface->{$data->{'nameref'}{'ifNodeid'}} ) )
+        {
+            $interface->{$data->{'nameref'}{'ifNodeid'}} =
+                $interface->{$data->{'nameref'}{'ifReferenceName'}};
+        }
+
+        # A per-interface value which is used by leafs in IF-MIB templates
+        $interface->{'param'}{'nodeid-interface'} =
+            $interface->{$data->{'nameref'}{'ifNodeidPrefix'}} .
+            $interface->{$data->{'nameref'}{'ifNodeid'}};
+        
+        $interface->{'param'}{'nodeid'} = '%nodeid-interface%';        
+
+        if( defined $data->{'nameref'}{'ifComment'} and
+            not defined( $interface->{'param'}{'comment'} ) and
+            length( $interface->{$data->{'nameref'}{'ifComment'}} ) > 0 )
+        {
+            my $comment = $interface->{$data->{'nameref'}{'ifComment'}};
+            $interface->{'param'}{'comment'} = $comment;
+            $interface->{'param'}{'interface-comment'} = $comment;
+        }
+
+        # Order the interfaces by ifIndex, not by interface name
+        $interface->{'param'}{'precedence'} = sprintf('%d', 100000-$ifIndex);
+
+        $interface->{'param'}{'devdiscover-nodetype'} =
+            'RFC2863_IF_MIB::interface';
+    }
+
+    if( $nInterfaces == 0 )
+    {
+        return;
+    }
+
+    if( $devdetails->param('RFC2863_IF_MIB::noout') eq 'yes' )
+    {
+        return;
+    }
+
+    # explicitly excluded interfaces    
+    my %excludeName;
+    my $excludeNameList =
+        $devdetails->param('RFC2863_IF_MIB::exclude-interfaces');
+    my $nExplExcluded = 0;
+        
+    if( defined( $excludeNameList ) and length( $excludeNameList ) > 0 )
+    {
+        foreach my $name ( split( /\s*,\s*/, $excludeNameList ) )
+        {
+            $excludeName{$name} = 1;
+        }
+    }
+
+    # explicitly listed interfaces
+    my %onlyName;
+    my $onlyNamesList =
+        $devdetails->param('RFC2863_IF_MIB::only-interfaces');
+    my $onlyNamesDefined = 0;
+    if( defined( $onlyNamesList ) and length( $onlyNamesList ) > 0 )
+    {
+        $onlyNamesDefined = 1;
+        foreach my $name ( split( /\s*,\s*/, $onlyNamesList ) )
+        {
+            $onlyName{$name} = 1;
+        }
+    }
+
+    # Bandwidth usage
+    my %bandwidthLimits;
+    if( $devdetails->param('RFC2863_IF_MIB::bandwidth-usage') eq 'yes' )
+    {
+        my $limits = $devdetails->param('RFC2863_IF_MIB::bandwidth-limits');
+        foreach my $intfLimit ( split( /\s*;\s*/, $limits ) )
+        {
+            my( $intf, $limitIn, $limitOut ) = split( /\s*:\s*/, $intfLimit );
+            $bandwidthLimits{$intf}{'In'} = $limitIn;
+            $bandwidthLimits{$intf}{'Out'} = $limitOut;
+        }
+    }
+
+    # tokenset member interfaces of the form
+    # Format: tset:intf,intf; tokenset:intf,intf;
+    # Format for global parameter:
+    #     tset:host/intf,host/intf; tokenset:host/intf,host/intf;
+    my %tsetMember;
+    my %tsetMemberApplied;
+    my $tsetMembership =
+        $devdetails->param('RFC2863_IF_MIB::tokenset-members');
+    if( defined( $tsetMembership ) and length( $tsetMembership ) > 0 )
+    {
+        foreach my $memList ( split( /\s*;\s*/, $tsetMembership ) )
+        {
+            my ($tset, $list) = split( /\s*:\s*/, $memList );
+            foreach my $intfName ( split( /\s*,\s*/, $list ) )
+            {
+                if( $intfName =~ /\// )
+                {
+                    my( $host, $intf ) = split( '/', $intfName );
+                    if( $host eq $devdetails->param('snmp-host') )
+                    {
+                        $tsetMember{$intf}{$tset} = 1;
+                    }
+                }
+                else
+                {
+                    $tsetMember{$intfName}{$tset} = 1;
+                }
+            }
+        }
+    }
+       
+        
+    # External storage serviceid assignment
+    my $extSrv =
+        $devdetails->param('RFC2863_IF_MIB::external-serviceid');
+    my %extStorage;
+    my %extStorageTrees;
+    
+    if( defined( $extSrv ) and length( $extSrv ) > 0 )
+    {
+        foreach my $srvDef ( split( /\s*,\s*/, $extSrv ) )
+        {
+            my ( $serviceid, $intfName, $direction, $trees ) =
+                split( /\s*:\s*/, $srvDef );
+
+            if( $intfName =~ /\// )
+            {
+                my( $host, $intf ) = split( '/', $intfName );
+                if( $host eq $devdetails->param('snmp-host') )
+                {
+                    $intfName = $intf;
+                }
+                else
+                {
+                    $intfName = undef;
+                }
+            }
+
+            if( defined( $intfName ) and length( $intfName ) > 0 )
+            {
+                if( defined( $trees ) )
+                {
+                    # Trees are listed with '|' as separator,
+                    # whereas compiler expects commas
+                    
+                    $trees =~ s/\s*\|\s*/,/g;
+                }
+                            
+                if( $direction eq 'Both' )
+                {
+                    $extStorage{$intfName}{'In'} = $serviceid . '_IN';
+                    $extStorageTrees{$serviceid . '_IN'} = $trees;
+                    
+                    $extStorage{$intfName}{'Out'} = $serviceid . '_OUT';
+                    $extStorageTrees{$serviceid . '_OUT'} = $trees;
+                }
+                else
+                {
+                    $extStorage{$intfName}{$direction} = $serviceid;
+                    $extStorageTrees{$serviceid} = $trees;
+                }
+            }
+        }
+    }
+
+    # Sums of several interfaces into single graphs (via CDef collector)
+    # RFC2863_IF_MIB::traffic-summaries: the list of sums to create;
+    # RFC2863_IF_MIB::traffic-XXX-path: the full path of the summary leaf
+    # RFC2863_IF_MIB::traffic-XXX-comment: description
+    # RFC2863_IF_MIB::traffic-XXX-interfaces: list of interfaces to add
+    #   format: "intf,intf" or "host/intf, host/intf"
+    my $trafficSums = $devdetails->param('RFC2863_IF_MIB::traffic-summaries');
+    my %trafficSummary;
+    if( defined( $trafficSums ) )
+    {
+        foreach my $summary ( split( /\s*,\s*/, $trafficSums ) )
+        {
+            $globalData->{'RFC2863_IF_MIB::summaryAttr'}{
+                $summary}{'path'} =
+                    $devdetails->param
+                    ('RFC2863_IF_MIB::traffic-' . $summary . '-path');
+            $globalData->{'RFC2863_IF_MIB::summaryAttr'}{
+                $summary}{'comment'} =
+                    $devdetails->param
+                    ('RFC2863_IF_MIB::traffic-' . $summary . '-comment');
+            
+            $globalData->{'RFC2863_IF_MIB::summaryAttr'}{
+                $summary}{'data-dir'} = $devdetails->param('data-dir');
+                    
+            my $intfList = $devdetails->param
+                ('RFC2863_IF_MIB::traffic-' . $summary . '-interfaces');
+
+            # get the intreface names for this host
+            foreach my $intfName ( split( /\s*,\s*/, $intfList ) )
+            {
+                if( $intfName =~ /\// )
+                {
+                    my( $host, $intf ) = split( '/', $intfName );
+                    if( $host eq $devdetails->param('snmp-host') )
+                    {
+                        $trafficSummary{$intf}{$summary} = 1;
+                    }
+                }
+                else
+                {
+                    $trafficSummary{$intfName}{$summary} = 1;
+                }
+            }
+        }
+    }
+    
+    # interface-level parameters to copy
+    my @intfCopyParams = ();
+    my $copyParams = $devdetails->param('RFC2863_IF_MIB::copy-params');
+    if( defined( $copyParams ) and length( $copyParams ) > 0 )
+    {
+        @intfCopyParams = split( /\s*,\s*/m, $copyParams );
+    }
+    
+    # Build configuration tree
+
+    my $subtreeName = $devdetails->param('RFC2863_IF_MIB::subtree-name');
+    if( length( $subtreeName ) == 0 )
+    {
+        $subtreeName = 'Interface_Counters';
+    }
+    my $subtreeParams = {};
+    my $subtreeComment = $devdetails->param('RFC2863_IF_MIB::subtree-comment');
+
+    if( length( $subtreeComment ) > 0 )
+    {
+        $subtreeParams->{'comment'} = $subtreeComment;
+    }
+
+    if( $devdetails->param('RFC2863_IF_MIB::bandwidth-usage') eq 'yes' )
+    {
+        $subtreeParams->{'overview-shortcuts'} = 'traffic,errors,bandwidth';
+    }
+    
+    my $countersNode =
+        $cb->addSubtree( $devNode, $subtreeName, $subtreeParams,
+                         ['RFC2863_IF_MIB::rfc2863-ifmib-subtree'] );
+    
+    foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        if( $interface->{'selectorActions'}{'RemoveInterface'} )
+        {
+            $interface->{'excluded'} = 1;
+            Debug('Removing interface by selector action: ' .
+                  $interface->{$data->{'nameref'}{'ifReferenceName'}});
+        }
+
+        # Some vendor-specific modules may exclude some interfaces
+        next if $interface->{'excluded'};
+
+        # Create a subtree for the interface
+        my $subtreeName = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+
+        if( $onlyNamesDefined )
+        {
+            if( not $onlyName{$subtreeName} )
+            {
+                $interface->{'excluded'} = 1;
+                $nExplExcluded++;
+                next;
+            }
+        }
+        
+        if( $excludeName{$subtreeName} )
+        {
+            $interface->{'excluded'} = 1;
+            $nExplExcluded++;
+            next;
+        }
+        elsif( length( $subtreeName ) == 0 )
+        {
+            Warn('Excluding an interface with empty name: ifIndex=' .
+                 $ifIndex);
+            next;
+        }
+
+        my @templates = ();
+
+        if( $interface->{'hasHCOctets'} )
+        {
+            push( @templates, 'RFC2863_IF_MIB::ifxtable-hcoctets' );
+        }
+        elsif( $interface->{'hasOctets'} )
+        {
+            push( @templates, 'RFC2863_IF_MIB::iftable-octets' );
+        }
+
+        if( $interface->{'hasOctets'} or $interface->{'hasHCOctets'} )
+        {
+            $interface->{'hasChild'}{'Bytes_In'} = 1;
+            $interface->{'hasChild'}{'Bytes_Out'} = 1;
+            $interface->{'hasChild'}{'InOut_bps'} = 1;            
+
+            foreach my $dir ( 'In', 'Out' )
+            {
+                if( defined( $interface->{'selectorActions'}->
+                             {$dir . 'BytesMonitor'} ) )
+                {
+                    $interface->{'childCustomizations'}->{
+                        'Bytes_' . $dir}->{'monitor'} =
+                            $interface->{'selectorActions'}->{
+                                $dir . 'BytesMonitor'};
+                }
+
+                if( defined( $interface->{'selectorActions'}->
+                             {$dir . 'BytesParameters'} ) )
+                {
+                    my @pairs =
+                        split('\s*;\s*',
+                              $interface->{'selectorActions'}{
+                                  $dir . 'BytesParameters'});
+                    
+                    foreach my $pair( @pairs )
+                    {
+                        my ($param, $val) = split('\s*=\s*', $pair);
+                        $interface->{'childCustomizations'}->{
+                            'Bytes_' . $dir}->{$param} = $val;
+                    }
+                }
+            }
+
+            if( defined( $interface->{'selectorActions'}{'HoltWinters'} ) )
+            {
+                push( @templates, '::holt-winters-defaults' );
+            }
+
+            if( defined( $interface->{'selectorActions'}{'NotifyPolicy'} ) )
+            {
+                $interface->{'param'}{'notify-policy'} =
+                    $interface->{'selectorActions'}{'NotifyPolicy'};
+            }
+        }
+
+        if( not $interface->{'selectorActions'}{'NoPacketCounters'} )
+        {
+            my $has_someting = 0;
+            if( $interface->{'hasHCUcastPkts'} )
+            {
+                push( @templates, 'RFC2863_IF_MIB::ifxtable-hcucast-packets' );
+                $has_someting = 1;
+            }
+            elsif( $interface->{'hasUcastPkts'} )
+            {
+                push( @templates, 'RFC2863_IF_MIB::iftable-ucast-packets' );
+                $has_someting = 1;
+            }
+
+            if( $has_someting )
+            {
+                $interface->{'hasChild'}{'Packets_In'} = 1;            
+                $interface->{'hasChild'}{'Packets_Out'} = 1;            
+            }
+        }
+
+        if( not $interface->{'selectorActions'}{'NoDiscardCounters'} )
+        {
+            if( $interface->{'hasInDiscards'} )
+            {
+                push( @templates, 'RFC2863_IF_MIB::iftable-discards-in' );
+                $interface->{'hasChild'}{'Discards_In'} = 1;            
+
+                if( defined
+                    ($interface->{'selectorActions'}->{'InDiscardsMonitor'}) )
+                {
+                    $interface->{'childCustomizations'}->{
+                        'Discards_In'}->{'monitor'} =
+                            $interface->{'selectorActions'}{
+                                'InDiscardsMonitor'};
+                }
+            }
+            
+            if( $interface->{'hasOutDiscards'} )
+            {
+                push( @templates, 'RFC2863_IF_MIB::iftable-discards-out' );
+                $interface->{'hasChild'}{'Discards_Out'} = 1;
+                
+                if( defined( $interface->{'selectorActions'}->{
+                    'OutDiscardsMonitor'} ) )
+                {
+                    $interface->{'childCustomizations'}->{
+                        'Discards_Out'}->{'monitor'} =
+                            $interface->{'selectorActions'}{
+                                'OutDiscardsMonitor'};
+                }
+            }
+        }
+        
+
+        if( not $interface->{'selectorActions'}{'NoErrorCounters'} )
+        {
+            if( $interface->{'hasInErrors'} )
+            {
+                push( @templates, 'RFC2863_IF_MIB::iftable-errors-in' );
+                $interface->{'hasChild'}{'Errors_In'} = 1;            
+
+                if( defined( $interface->{'selectorActions'}->{
+                    'InErrorsMonitor'} ) )
+                {
+                    $interface->{'childCustomizations'}->{
+                        'Errors_In'}->{'monitor'} =
+                            $interface->{'selectorActions'}{'InErrorsMonitor'};
+                }
+            }
+
+            if( $interface->{'hasOutErrors'} )
+            {
+                push( @templates, 'RFC2863_IF_MIB::iftable-errors-out' );
+                $interface->{'hasChild'}{'Errors_Out'} = 1;            
+
+                if( defined( $interface->{'selectorActions'}->{
+                    'OutErrorsMonitor'} ) )
+                {
+                    $interface->{'childCustomizations'}->{
+                        'Errors_Out'}->{'monitor'} =
+                            $interface->{'selectorActions'}{
+                                'OutErrorsMonitor'};
+                }
+            }
+        }
+        
+        if( defined( $interface->{'selectorActions'}{'TokensetMember'} ) )
+        {
+            foreach my $tset
+                ( split('\s*,\s*',
+                        $interface->{'selectorActions'}{'TokensetMember'}) )
+            {
+                $tsetMember{$subtreeName}{$tset} = 1;
+            }
+        }
+        
+        if( defined( $interface->{'selectorActions'}{'Parameters'} ) )
+        {
+            my @pairs = split('\s*;\s*',
+                              $interface->{'selectorActions'}{'Parameters'});
+            foreach my $pair( @pairs )
+            {
+                my ($param, $val) = split('\s*=\s*', $pair);
+                $interface->{'param'}{$param} = $val;
+            }
+        }
+
+        if( $devdetails->param('RFC2863_IF_MIB::bandwidth-usage') eq 'yes' )
+        {
+            if( defined( $bandwidthLimits{$subtreeName} ) )
+            {
+                $interface->{'param'}{'bandwidth-limit-in'} =
+                    $bandwidthLimits{$subtreeName}{'In'};
+                $interface->{'param'}{'bandwidth-limit-out'} =
+                    $bandwidthLimits{$subtreeName}{'Out'};
+            }
+
+            # We accept that parameters may be added by some other ways
+
+            if( defined( $interface->{'param'}{'bandwidth-limit-in'} ) and
+                defined( $interface->{'param'}{'bandwidth-limit-out'} ) )
+            {
+                push( @templates,
+                      'RFC2863_IF_MIB::interface-bandwidth-usage' );
+            }
+        }
+
+        if( ref( $interface->{'templates'} ) )
+        {
+            push( @templates, @{$interface->{'templates'}} );
+        }
+
+        # Add vendor templates
+        push( @templates, @{$interface->{'vendor_templates'}} );
+        
+        # Add subtree only if there are template references
+
+        if( scalar( @templates ) > 0 )
+        {
+            # process interface-level parameters to copy
+
+            foreach my $param ( @intfCopyParams )
+            {
+                my $val = $devdetails->param('RFC2863_IF_MIB::' .
+                                             $param . '::' . $subtreeName );
+                if( defined( $val ) and length( $val ) > 0 )
+                {
+                    $interface->{'param'}{$param} = $val;
+                }
+            }
+
+            if( defined( $tsetMember{$subtreeName} ) )
+            {
+                my $tsetList =
+                    join( ',', sort keys %{$tsetMember{$subtreeName}} );
+                
+                $interface->{'childCustomizations'}->{'InOut_bps'}->{
+                    'tokenset-member'} = $tsetList;
+                $tsetMemberApplied{$subtreeName} = 1;
+            }
+
+            if( defined( $extStorage{$subtreeName} ) )
+            {
+                foreach my $dir ( 'In', 'Out' )
+                {
+                    if( defined( $extStorage{$subtreeName}{$dir} ) )
+                    {
+                        my $serviceid = $extStorage{$subtreeName}{$dir};
+
+                        my $params = {
+                            'storage-type'      => 'rrd,ext',
+                            'ext-service-id'    => $serviceid,
+                            'ext-service-units' => 'bytes' };
+                        
+                        if( defined( $extStorageTrees{$serviceid} )
+                            and length( $extStorageTrees{$serviceid} ) > 0 )
+                        {
+                            $params->{'ext-service-trees'} =
+                                $extStorageTrees{$serviceid};
+                        }
+
+                        foreach my $param ( keys %{$params} )
+                        {
+                            $interface->{'childCustomizations'}->{
+                                'Bytes_' . $dir}{$param} = $params->{$param};
+                        }
+                    }
+                }
+            }
+            
+            my $intfNode =
+                $cb->addSubtree( $countersNode, $subtreeName,
+                                 $interface->{'param'}, \@templates );
+
+            if( defined( $interface->{'childCustomizations'} ) )
+            {
+                foreach my $childName
+                    ( sort keys %{$interface->{'childCustomizations'}} )
+                {
+                    if( $interface->{'hasChild'}{$childName} )
+                    {
+                        $cb->addLeaf
+                            ( $intfNode, $childName,
+                              $interface->{'childCustomizations'}->{
+                                  $childName} );
+                    }
+                }
+            }
+
+            # If the interafce is a member of traffic summary
+            if( defined( $trafficSummary{$subtreeName} ) )
+            {
+                foreach my $summary ( keys %{$trafficSummary{$subtreeName}} )
+                {
+                    addTrafficSummaryElement( $globalData,
+                                              $summary, $intfNode );
+                }
+            }
+        }
+    }
+    
+    if( $nExplExcluded > 0 )
+    {
+        Debug('Explicitly excluded ' . $nExplExcluded .
+              ' RFC2863_IF_MIB interfaces');
+    }
+
+    if( scalar( %tsetMember ) > 0 )
+    {
+        my @failedIntf;
+        foreach my $intfName ( keys %tsetMember )
+        {
+            if( not $tsetMemberApplied{$intfName} )
+            {
+                push( @failedIntf, $intfName );
+            }
+        }
+
+        if( scalar( @failedIntf ) > 0 )
+        {
+            Warn('The following interfaces were not added to tokensets, ' .
+                 'probably because they do not exist or are explicitly ' .
+                 'excluded: ' .
+                 join(' ', sort @failedIntf));
+        }
+    }                 
+    
+    $cb->{'statistics'}{'interfaces'} += $nInterfaces;
+    if( $cb->{'statistics'}{'max-interfaces-per-host'} < $nInterfaces )
+    {
+        $cb->{'statistics'}{'max-interfaces-per-host'} = $nInterfaces;
+    }
+}
+
+
+sub addTrafficSummaryElement
+{
+    my $globalData = shift;
+    my $summary = shift;
+    my $node = shift;
+
+    if( not defined( $globalData->{
+        'RFC2863_IF_MIB::summaryMembers'}{$summary} ) )
+    {
+        $globalData->{'RFC2863_IF_MIB::summaryMembers'}{$summary} = [];
+    }
+
+    push( @{$globalData->{'RFC2863_IF_MIB::summaryMembers'}{$summary}},
+          $node );
+}
+      
+
+sub buildGlobalConfig
+{
+    my $cb = shift;
+    my $globalData = shift;
+
+    if( not defined( $globalData->{'RFC2863_IF_MIB::summaryMembers'} ) )
+    {
+        return;
+    }
+    
+    foreach my $summary ( keys %{$globalData->{
+        'RFC2863_IF_MIB::summaryMembers'}} )
+    {
+        next if scalar( @{$globalData->{
+            'RFC2863_IF_MIB::summaryMembers'}{$summary}} ) == 0;
+
+        my $attr = $globalData->{'RFC2863_IF_MIB::summaryAttr'}{$summary};
+        my $path = $attr->{'path'};
+
+        if( not defined( $path ) )
+        {
+            Error('Missing the path for traffic summary ' . $summary);
+            next;
+        }
+
+        Debug('Building summary: ' . $summary);
+        
+        # Chop the first and last slashes
+        $path =~ s/^\///;
+        $path =~ s/\/$//;
+        
+        # generate subtree path XML
+        my $subtreeNode = undef;
+        foreach my $subtreeName ( split( '/', $path ) )
+        {
+            $subtreeNode = $cb->addSubtree( $subtreeNode, $subtreeName, {
+                'comment'  => $attr->{'comment'},
+                'data-dir' => $attr->{'data-dir'} } );
+        }
+
+        foreach my $dir ('In', 'Out')
+        {
+            my $rpn = '';
+            foreach my $member ( @{$globalData->{
+                'RFC2863_IF_MIB::summaryMembers'}{$summary}} )
+            {
+                my $memRef = '{' . $cb->getElementPath($member) .
+                    'Bytes_' . $dir . '}';
+                if( length( $rpn ) == 0 )
+                {
+                    $rpn = $memRef;
+                }
+                else
+                {
+                    $rpn .= ',' . $memRef . ',+';
+                }
+            }
+            
+            my $param = {
+                'rpn-expr' => $rpn,
+                'data-file' => 'summary_' . $summary . '.rrd',
+                'rrd-ds' => 'Bytes' . $dir };
+          
+            $cb->addLeaf( $subtreeNode, 'Bytes_' . $dir, $param,
+                          ['::cdef-collector-defaults'] );
+        }
+    }
+}
+
+                       
+
+        
+
+# $filterHash is a hash reference
+# Key is some unique symbolic name, does not mean anything
+# $filterHash->{$key}{'ifType'} is the number to match the interface type
+# $filterHash->{$key}{'ifDescr'} is the regexp to match the interface
+# description
+
+sub addInterfaceFilter
+{
+    my $devdetails = shift;
+    my $filterHash = shift;
+
+    my $data = $devdetails->data();
+
+    if( not ref( $data->{'interfaceFilter'} ) )
+    {
+        $data->{'interfaceFilter'} = [];
+    }
+
+    push( @{$data->{'interfaceFilter'}}, $filterHash );
+}
+
+
+sub uniqueEntries
+{
+    my $devdetails = shift;
+    my $nameref = shift;
+
+    my $data = $devdetails->data();
+    my %count = ();
+
+    foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        my $entry = $interface->{$nameref};
+        if( length($entry) == 0 )
+        {
+            $entry = $interface->{$nameref} = '_';
+        }
+        if( int( $count{$entry} ) > 0 )
+        {
+            my $new_entry = sprintf('%s%d', $entry, int( $count{$entry} ) );
+            $interface->{$nameref} = $new_entry;
+            $count{$new_entry}++;
+        }
+        $count{$entry}++;
+    }
+}
+
+# For devices which require MAC address-to-interface mapping,
+# this function fills in the appropriate interface-macaddr parameters.
+# To get use of MAC mapping, set
+#     $data->{'param'}{'ifindex-map'} = '$IFIDX_MAC';
+
+
+sub retrieveMacAddresses
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+
+    foreach my $ifIndex ( sort {$a<=>$b} keys %{$data->{'interfaces'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        my $macaddr = $devdetails->snmpVar($dd->oiddef('ifPhysAddress') .
+                                           '.' . $ifIndex);
+
+        if( defined( $macaddr ) and length( $macaddr ) > 0 )
+        {
+            $interface->{'MAC'} = $macaddr;
+            $interface->{'param'}{'interface-macaddr'} = $macaddr;
+        }
+        else
+        {
+            Warn('Excluding interface without MAC address: ' .
+                  $interface->{$data->{'nameref'}{'ifReferenceName'}});
+            delete $data->{'interfaces'}{$ifIndex};
+        }
+    }
+}
+
+
+# For devices with fixed ifIndex mapping it populates interface-index parameter
+
+
+sub storeIfIndexParams
+{
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+
+    foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+        $interface->{'param'}{'interface-index'} = $ifIndex;        
+    }
+}
+
+#######################################
+# Selectors interface
+#
+
+$Torrus::DevDiscover::selectorsRegistry{'RFC2863_IF_MIB'} = {
+    'getObjects'      => \&getSelectorObjects,
+    'getObjectName'   => \&getSelectorObjectName,
+    'checkAttribute'  => \&checkSelectorAttribute,
+    'applyAction'     => \&applySelectorAction,
+};
+
+
+## Objects are interface indexes
+
+sub getSelectorObjects
+{
+    my $devdetails = shift;
+    my $objType = shift;
+    return sort {$a<=>$b} keys ( %{$devdetails->data()->{'interfaces'}} );
+}
+
+
+sub checkSelectorAttribute
+{
+    my $devdetails = shift;
+    my $object = shift;
+    my $objType = shift;
+    my $attr = shift;
+    my $checkval = shift;
+
+    my $data = $devdetails->data();
+    my $interface = $data->{'interfaces'}{$object};
+    
+    if( $attr =~ /^ifSubtreeName\d*$/ )
+    {
+        my $value = $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+        my $match = 0;
+        foreach my $chkexpr ( split( /\s+/, $checkval ) )
+        {
+            if( $value =~ $chkexpr )
+            {
+                $match = 1;
+                last;
+            }
+        }
+        return $match;        
+    }
+    else
+    {
+        my $value;
+        my $operator = '=~';
+        if( $attr eq 'ifComment' )
+        {
+            $value = $interface->{$data->{'nameref'}{'ifComment'}};
+        }
+        elsif( $attr eq 'ifType' )
+        {
+            $value = $interface->{'ifType'};
+            $operator = '==';
+        }
+        else
+        {
+            Error('Unknown RFC2863_IF_MIB selector attribute: ' . $attr);
+            $value = '';
+        }
+
+        return eval( '$value' . ' ' . $operator . '$checkval' ) ? 1:0;
+    }
+}
+
+
+sub getSelectorObjectName
+{
+    my $devdetails = shift;
+    my $object = shift;
+    my $objType = shift;
+    
+    my $data = $devdetails->data();
+    my $interface = $data->{'interfaces'}{$object};
+    return $interface->{$data->{'nameref'}{'ifSubtreeName'}};
+}
+
+
+# Other discovery modules can add their interface actions here
+our %knownSelectorActions =
+    ( 'InBytesMonitor'    => 'RFC2863_IF_MIB',
+      'OutBytesMonitor'   => 'RFC2863_IF_MIB',
+      'InDiscardsMonitor'  => 'RFC2863_IF_MIB',
+      'OutDiscardsMonitor' => 'RFC2863_IF_MIB',
+      'InErrorsMonitor'   => 'RFC2863_IF_MIB',
+      'OutErrorsMonitor'  => 'RFC2863_IF_MIB',
+      'NotifyPolicy'      => 'RFC2863_IF_MIB',
+      'HoltWinters'       => 'RFC2863_IF_MIB',
+      'NoPacketCounters'  => 'RFC2863_IF_MIB',
+      'NoDiscardCounters' => 'RFC2863_IF_MIB',
+      'NoErrorCounters'   => 'RFC2863_IF_MIB',
+      'RemoveInterface'   => 'RFC2863_IF_MIB',
+      'TokensetMember'    => 'RFC2863_IF_MIB',
+      'Parameters'        => 'RFC2863_IF_MIB',
+      'InBytesParameters' => 'RFC2863_IF_MIB',
+      'OutBytesParameters' => 'RFC2863_IF_MIB',);
+
+                            
+sub applySelectorAction
+{
+    my $devdetails = shift;
+    my $object = shift;
+    my $objType = shift;
+    my $action = shift;
+    my $arg = shift;
+
+    my $data = $devdetails->data();
+    my $interface = $data->{'interfaces'}{$object};
+
+    if( defined( $knownSelectorActions{$action} ) )
+    {
+        if( not $devdetails->isDevType( $knownSelectorActions{$action} ) )
+        {
+            Error('Action ' . $action . ' is applied to a device that is ' .
+                  'not of type ' . $knownSelectorActions{$action} .
+                  ': ' . $devdetails->param('system-id'));
+        }
+        $interface->{'selectorActions'}{$action} = $arg;
+    }
+    else
+    {
+        Error('Unknown RFC2863_IF_MIB selector action: ' . $action);
+    }
+}
+   
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/Symmetricom.pm b/torrus/perllib/Torrus/DevDiscover/Symmetricom.pm
new file mode 100644
index 000000000..cc7ff3a12
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Symmetricom.pm
@@ -0,0 +1,104 @@
+#
+#  Discovery module for Symmetricom
+#
+#  Copyright (C) 2007 Jon Nistor
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Symmetricom.pm,v 1.1 2010-12-27 00:03:46 ivan Exp $
+# Jon Nistor <nistor at snickers dot org>
+#
+
+
+# Symmetricom
+package Torrus::DevDiscover::Symmetricom;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'Symmetricom'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef = (
+     # SYMM-SMI
+     'syncServer'           => '1.3.6.1.4.1.9070.1.2.3.1.5',
+     'sysDescr'             => '1.3.6.1.2.1.1.1.0',
+     'ntpSysSystem'         => '1.3.6.1.4.1.9070.1.2.3.1.5.1.1.14.0',
+     'etcSerialNbr'         => '1.3.6.1.4.1.9070.1.2.3.1.5.1.6.2.0',
+     'etcModel'             => '1.3.6.1.4.1.9070.1.2.3.1.5.1.6.3.0',
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'syncServer',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+    
+    $devdetails->setCap('interfaceIndexingPersistent');
+    $devdetails->setDevType('UcdSnmp'); # Force load Ucd
+
+    return 1;
+}
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    # SNMP: Get the system info and display it in the comment
+    my $ntpComment = $dd->retrieveSnmpOIDs
+        ( 'sysDescr', 'ntpSysSystem', 'etcSerialNbr', 'etcModel' );
+
+    $data->{'ntp'} = $ntpComment;
+
+    $data->{'param'}{'comment'} =
+        $ntpComment->{'ntpSysSystem'} . " " . $ntpComment->{'etcModel'} . 
+        ", Hw Serial#: " . $ntpComment->{'etcSerialNbr'};
+  
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+    my $data = $devdetails->data();
+
+    $cb->addTemplateApplication($devNode, 'Symmetricom::ntp-stats');
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/UcdSnmp.pm b/torrus/perllib/Torrus/DevDiscover/UcdSnmp.pm
new file mode 100644
index 000000000..9c9ce733d
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/UcdSnmp.pm
@@ -0,0 +1,265 @@
+#  Copyright (C) 2003  Shawn Ferry
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: UcdSnmp.pm,v 1.1 2010-12-27 00:03:47 ivan Exp $
+# Shawn Ferry <sferry at sevenspace dot com> <lalartu at obscure dot org>
+
+# Ucd Snmp Discovery
+
+package Torrus::DevDiscover::UcdSnmp;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'UcdSnmp'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+our %oiddef =
+    (
+     # ucd
+     'ucd'                      => '1.3.6.1.4.1.2021',
+     'net_snmp'                 => '1.3.6.1.4.1.8072',
+
+     # We assume that if we have Avail we also have Total
+     'ucd_memAvailSwap'         => '1.3.6.1.4.1.2021.4.4.0',
+     'ucd_memAvailReal'         => '1.3.6.1.4.1.2021.4.6.0',
+
+     # If we have in we assume out
+     'ucd_ssSwapIn'             => '1.3.6.1.4.1.2021.11.3.0',
+
+     # If we have User we assume System and Idle
+     'ucd_ssCpuRawUser'         => '1.3.6.1.4.1.2021.11.50.0',
+     'ucd_ssCpuRawNice'         => '1.3.6.1.4.1.2021.11.51.0',
+     'ucd_ssCpuRawWait'         => '1.3.6.1.4.1.2021.11.54.0',
+     'ucd_ssCpuRawKernel'       => '1.3.6.1.4.1.2021.11.55.0',
+     'ucd_ssCpuRawInterrupts'   => '1.3.6.1.4.1.2021.11.56.0',
+     'ucd_ssCpuRawSoftIRQ'      => '1.3.6.1.4.1.2021.11.61.0',
+
+     # if we have Sent we assume Received
+     'ucd_ssIORawSent'          => '1.3.6.1.4.1.2021.11.57.0',
+
+     'ucd_ssRawInterrupts'      => '1.3.6.1.4.1.2021.11.59.0',
+     'ucd_ssRawContexts'        => '1.3.6.1.4.1.2021.11.60.0',
+
+     'ucd_laTable'              => '1.3.6.1.4.1.2021.10'
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $sysObjectID = $devdetails->snmpVar( $dd->oiddef('sysObjectID') );
+    
+    if( not $dd->oidBaseMatch( 'ucd', $sysObjectID )
+        and
+        not $dd->oidBaseMatch( 'net_snmp', $sysObjectID ) )
+    {
+        return 0;
+    }
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $session = $dd->session();
+    my $data = $devdetails->data();
+
+    my @checkOids = (
+                     'ucd_memAvailSwap',
+                     'ucd_memAvailReal',
+                     'ucd_ssSwapIn',
+                     'ucd_ssCpuRawUser',
+                     'ucd_ssCpuRawWait',
+                     'ucd_ssCpuRawKernel',
+                     'ucd_ssCpuRawInterrupts',
+                     'ucd_ssCpuRawNice',
+                     'ucd_ssCpuRawSoftIRQ',
+                     'ucd_ssIORawSent',
+                     'ucd_ssRawInterrupts',
+                     );
+
+
+    my $result = $dd->retrieveSnmpOIDs( @checkOids );
+    if( defined( $result ) )
+    {
+        foreach my $oid ( @checkOids )
+        {
+            if( defined($result->{$oid}) and length($result->{$oid}) > 0 )
+            {
+                $devdetails->setCap($oid);
+            }
+        }
+    }
+
+    if( $dd->checkSnmpTable('ucd_laTable') )
+    {
+        $devdetails->setCap('ucd_laTable');
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+    my $data = $devdetails->data();
+
+    # Hostresources MIB is optional in net-snmp. We try and use the same
+    # subtree name for UCD and Hostresources statistics.
+    
+    my $subtreeName =
+        $devdetails->param('RFC2790_HOST_RESOURCES::sysperf-subtree-name');
+    if( not defined( $subtreeName ) )
+    {
+        $subtreeName = 'System_Performance';
+        $devdetails->setParam
+            ('RFC2790_HOST_RESOURCES::sysperf-subtree-name', $subtreeName);
+    }
+
+    my @templates;
+    if( $devdetails->hasCap('ucd_ssIORawSent') )
+    {
+        push( @templates, 'UcdSnmp::ucdsnmp-blockio' );
+    }
+
+    if( $devdetails->hasCap('ucd_ssRawInterrupts') )
+    {
+        push( @templates,  'UcdSnmp::ucdsnmp-raw-interrupts' );
+    }
+
+    if( $devdetails->hasCap('ucd_laTable') )
+    {
+        push( @templates, 'UcdSnmp::ucdsnmp-load-average' );
+    }
+
+    if( $devdetails->hasCap('ucd_memAvailSwap') )
+    {
+        push( @templates, 'UcdSnmp::ucdsnmp-memory-swap' );
+    }
+
+    if( $devdetails->hasCap('ucd_memAvailReal') )
+    {
+        push( @templates, 'UcdSnmp::ucdsnmp-memory-real' );
+    }
+
+    my $cpuMultiParam;
+    my @cpuMultiTemplates;
+
+    if( $devdetails->hasCap('ucd_ssCpuRawUser') )
+    {
+        $cpuMultiParam = {
+            'graph-lower-limit' => '0',
+            'rrd-hwpredict'     => 'disabled',
+            'vertical-label'    => 'Cpu Usage',
+            'comment'           => 'Cpu Idle, Sys, User',
+            'ds-names'          => 'idle,sys,user',
+            'ds-type'           => 'rrd-multigraph'
+            };
+
+        push( @templates,
+              'UcdSnmp::ucdsnmp-cpu-user',
+              'UcdSnmp::ucdsnmp-cpu-system',
+              'UcdSnmp::ucdsnmp-cpu-idle' );
+
+        push( @cpuMultiTemplates,
+              'UcdSnmp::ucdsnmp-cpu-user-multi',
+              'UcdSnmp::ucdsnmp-cpu-system-multi',
+              'UcdSnmp::ucdsnmp-cpu-idle-multi' );
+
+        if( $devdetails->hasCap('ucd_ssCpuRawWait') )
+        {
+            push( @templates, 'UcdSnmp::ucdsnmp-cpu-wait' );
+            push( @cpuMultiTemplates, 'UcdSnmp::ucdsnmp-cpu-wait-multi' );
+
+            $cpuMultiParam->{'comment'}  .= ', Wait';
+            $cpuMultiParam->{'ds-names'} .= ',wait';
+        }
+
+        if( $devdetails->hasCap('ucd_ssCpuRawKernel') )
+        {
+            push( @templates, 'UcdSnmp::ucdsnmp-cpu-kernel' );
+            push( @cpuMultiTemplates, 'UcdSnmp::ucdsnmp-cpu-kernel-multi' );
+
+            $cpuMultiParam->{'comment'}  .= ', Kernel';
+            $cpuMultiParam->{'ds-names'} .= ',kernel';
+        }
+
+        if( $devdetails->hasCap('ucd_ssCpuRawNice') )
+        {
+            push( @templates, 'UcdSnmp::ucdsnmp-cpu-nice' );
+            push( @cpuMultiTemplates, 'UcdSnmp::ucdsnmp-cpu-nice-multi' );
+
+            $cpuMultiParam->{'comment'}  .= ', Nice';
+            $cpuMultiParam->{'ds-names'} .= ',nice';
+        }
+
+        if( $devdetails->hasCap('ucd_ssCpuRawInterrupts') )
+        {
+            push( @templates, 'UcdSnmp::ucdsnmp-cpu-interrupts' );
+            push( @cpuMultiTemplates,
+                  'UcdSnmp::ucdsnmp-cpu-interrupts-multi' );
+
+            $cpuMultiParam->{'comment'}  .= ', Interrupts';
+            $cpuMultiParam->{'ds-names'} .= ',int';
+        }
+
+        if( $devdetails->hasCap('ucd_ssCpuRawSoftIRQ') )
+        {
+            push( @templates, 'UcdSnmp::ucdsnmp-cpu-softirq' );
+            push( @cpuMultiTemplates,
+                  'UcdSnmp::ucdsnmp-cpu-softirq-multi' );
+
+            $cpuMultiParam->{'comment'}  .= ', SoftIRQs';
+            $cpuMultiParam->{'ds-names'} .= ',softirq';
+        }
+
+        $cpuMultiParam->{'comment'} =~ s/\,\s+(\w+)$/ and $1/;
+    }
+
+    my $perfNode = $cb->addSubtree( $devNode, $subtreeName,
+                                    undef, \@templates);
+
+    if( $cpuMultiParam )
+    {
+        $cb->addLeaf( $perfNode, 'Cpu_Stats',
+                      $cpuMultiParam, \@cpuMultiTemplates );
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/DevDiscover/Xylan.pm b/torrus/perllib/Torrus/DevDiscover/Xylan.pm
new file mode 100644
index 000000000..6d1c89406
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover/Xylan.pm
@@ -0,0 +1,199 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Xylan.pm,v 1.1 2010-12-27 00:03:50 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Xylan (Alcatel) switch discovery.
+
+# Tested with:
+#
+# Xylan OmniSwitch 9x
+# Xylan OmniStack 5024
+# Switch software: X/OS 4.3.3
+#
+# Virtual ports are not processed yet
+
+
+package Torrus::DevDiscover::Xylan;
+
+use strict;
+use Torrus::Log;
+
+
+$Torrus::DevDiscover::registry{'Xylan'} = {
+    'sequence'     => 500,
+    'checkdevtype' => \&checkdevtype,
+    'discover'     => \&discover,
+    'buildConfig'  => \&buildConfig
+    };
+
+
+our %oiddef =
+    (
+     # XYLAN-BASE-MIB
+     'xylanSwitchDevice'           => '1.3.6.1.4.1.800.3.1.1',
+     # PORT-MIB::phyPortTable
+     'xylanPhyPortTable'           => '1.3.6.1.4.1.800.2.3.3.1',
+     # PORT-MIB::phyPortDescription
+     'xylanPhyPortDescription'     => '1.3.6.1.4.1.800.2.3.3.1.1.4',
+     # PORT-MIB::phyPortToInterface
+     'xylanPhyPortToInterface'     => '1.3.6.1.4.1.800.2.3.3.1.1.19'
+     );
+
+# Not all interfaces are normally needed to monitor.
+# You may override the interface filtering in devdiscover-siteconfig.pl:
+# redefine $Torrus::DevDiscover::Xylan::interfaceFilter
+# or define $Torrus::DevDiscover::Xylan::interfaceFilterOverlay
+
+our $interfaceFilter;
+our $interfaceFilterOverlay;
+my %xylInterfaceFilter;
+
+if( not defined( $interfaceFilter ) )
+{
+    $interfaceFilter = \%xylInterfaceFilter;
+}
+
+
+# Key is some unique symbolic name, does not mean anything
+# ifType is the number to match the interface type
+# ifDescr is the regexp to match the interface description
+%xylInterfaceFilter =
+    (
+     'vnN' => {
+         'ifType'  => 53                     # propVirtual
+         },
+     'loN' => {
+         'ifType'  => 24                     # softwareLoopback
+         }
+     );
+
+sub checkdevtype
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    if( not $dd->oidBaseMatch
+        ( 'xylanSwitchDevice',
+          $devdetails->snmpVar( $dd->oiddef('sysObjectID') ) ) )
+    {
+        return 0;
+    }
+
+    &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+        ($devdetails, $interfaceFilter);
+
+    if( defined( $interfaceFilterOverlay ) )
+    {
+        &Torrus::DevDiscover::RFC2863_IF_MIB::addInterfaceFilter
+            ($devdetails, $interfaceFilterOverlay);
+    }
+
+    $devdetails->setCap('interfaceIndexingPersistent');
+
+    return 1;
+}
+
+
+sub discover
+{
+    my $dd = shift;
+    my $devdetails = shift;
+
+    my $data = $devdetails->data();
+    my $session = $dd->session();
+
+    $data->{'nameref'}{'ifNick'}        = 'xylanInterfaceNick';
+    $data->{'nameref'}{'ifSubtreeName'} = 'xylanInterfaceNick';
+    $data->{'nameref'}{'ifComment'}     = 'xylanInterfaceComment';
+    $data->{'nameref'}{'ifReferenceName'}   = 'xylanInterfaceHumanName';
+    
+    my $phyPortTable =
+        $session->get_table( -baseoid => $dd->oiddef('xylanPhyPortTable') );
+
+    if( not defined $phyPortTable )
+    {
+        Error('Error retrieving PORT-MIB::phyPortTable from Xylan device');
+        return 0;
+    }
+
+    $devdetails->storeSnmpVars( $phyPortTable );
+
+    foreach my $slotDotPort
+        ( $devdetails->
+          getSnmpIndices( $dd->oiddef('xylanPhyPortDescription') ) )
+    {
+        my ( $slot, $port ) = split( '\.', $slotDotPort );
+
+        my $ifIndex =
+            $devdetails->snmpVar($dd->oiddef('xylanPhyPortToInterface') .
+                                 '.' . $slotDotPort);
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        if( defined $interface )
+        {
+            $interface->{'xylanInterfaceNick'} =
+                sprintf( '%d_%d', $slot, $port );
+
+            $interface->{'xylanInterfaceHumanName'} =
+                sprintf( '%d/%d', $slot, $port );
+
+            $interface->{'xylanInterfaceComment'} =
+                $devdetails->snmpVar($dd->oiddef('xylanPhyPortDescription') .
+                                     '.' . $slotDotPort);
+        }
+    }
+
+    # verify if all interfaces are processed
+
+    foreach my $ifIndex ( keys %{$data->{'interfaces'}} )
+    {
+        my $interface = $data->{'interfaces'}{$ifIndex};
+
+        if( not defined( $interface->{'xylanInterfaceNick'} ) )
+        {
+            Warn('Interface ' . $ifIndex . ' is not in phyPortTable');
+
+            my $nick = sprintf( 'PORT%d', $ifIndex );
+            $interface->{'xylanInterfaceNick'} = $nick;
+            $interface->{'xylanInterfaceHumanName'} = $nick;
+
+            $interface->{'xylanInterfaceComment'} = $interface->{'ifDescr'};
+        }
+    }
+
+    return 1;
+}
+
+
+sub buildConfig
+{
+    my $devdetails = shift;
+    my $cb = shift;
+    my $devNode = shift;
+
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Log.pm b/torrus/perllib/Torrus/Log.pm
new file mode 100644
index 000000000..3c2c824ee
--- /dev/null
+++ b/torrus/perllib/Torrus/Log.pm
@@ -0,0 +1,136 @@
+#    This file was initially taken from Cricket, and reworked later
+#
+#    Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc.
+#    Copyright (C) 2002  Stanislav Sinyagin
+#
+#    This program is free software; you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation; either version 2 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details.
+#
+#    You should have received a copy of the GNU General Public License
+#    along with this program; if not, write to the Free Software
+#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Log.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# 2002/06/25 11:35:00  ssinyagin
+# Taken from Cricket lib/Common/Log.pm
+#
+# 2004/06/25 ssinyagin
+# Finally reworked in 2 years!
+#
+
+package Torrus::Log;
+
+use strict;
+
+require Exporter;
+our @ISA = qw(Exporter);
+
+our @EXPORT = qw(Debug Warn Info Error Verbose isDebug);
+
+my @monthNames = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul',
+                   'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
+
+my %logLevel = (
+                'debug'    => 9,
+                'verbose'  => 8,
+                'info'     => 7,
+                'warn'     => 5,
+                'error'    => 1 );
+
+my $currentLogLevel = $logLevel{'info'};
+
+sub Log
+{
+    my( $level, @msg ) = @_;    
+
+    $level = $logLevel{$level};
+    
+    if( $level <= $currentLogLevel )
+    {
+        my $severity = ( $level <= $logLevel{'warn'} ) ? '*' : ' ';
+        printf STDERR ( "[%s%s] %s\n",
+                        timeStr( time() ), $severity, join( '', @msg ) );
+    }
+    return undef;
+}
+
+
+sub Error
+{
+    Log( 'error', @_ );
+}
+
+sub Warn
+{
+    Log( 'warn', @_);
+}
+
+sub Info
+{
+    Log( 'info', @_ );
+}
+
+sub Verbose
+{
+    Log( 'verbose', @_ );
+}
+
+our $TID = 0;
+sub setTID
+{
+    $TID = shift;
+}
+
+sub Debug
+{
+    Log( 'debug', $$ . '.' . $TID . ' ', join('|', @_) );
+}
+
+
+sub isDebug
+{
+    return $currentLogLevel >= $logLevel{'debug'};
+}
+
+sub timeStr
+{
+    my $t = shift;
+    
+    my( $sec, $min, $hour, $mday, $mon, $year) = localtime( $t );
+    
+    return sprintf('%02d-%s-%04d %02d:%02d:%02d',
+                   $mday, $monthNames[$mon], $year + 1900, $hour, $min, $sec);
+}
+
+sub setLevel
+{
+    my $level = lc( shift );
+
+    if( defined( $logLevel{$level} ) )
+    {
+        $currentLogLevel = $logLevel{$level};
+    }
+    else
+    {
+        Error("Log level name '$level' unknown. Defaulting to 'info'");
+        $currentLogLevel = $logLevel{'info'};
+    }
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# tab-width: 4
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Monitor.pm b/torrus/perllib/Torrus/Monitor.pm
new file mode 100644
index 000000000..72e5c2433
--- /dev/null
+++ b/torrus/perllib/Torrus/Monitor.pm
@@ -0,0 +1,700 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Monitor.pm,v 1.1 2010-12-27 00:03:37 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Monitor;
+@Torrus::Monitor::ISA = qw(Torrus::Scheduler::PeriodicTask);
+
+use strict;
+
+use Torrus::DB;
+use Torrus::ConfigTree;
+use Torrus::Scheduler;
+use Torrus::DataAccess;
+use Torrus::TimeStamp;
+use Torrus::Log;
+
+
+sub new
+{
+    my $proto = shift;
+    my %options = @_;
+
+    if( not $options{'-Name'} )
+    {
+        $options{'-Name'} = "Monitor";
+    }
+
+    my $class = ref($proto) || $proto;
+    my $self  = $class->SUPER::new( %options );
+    bless $self, $class;
+
+
+    $self->{'tree_name'} = $options{'-TreeName'};
+    $self->{'sched_data'} = $options{'-SchedData'};
+    $self->{'delay'} = $options{'-Delay'} * 60;
+    
+    return $self;
+}
+
+
+sub addTarget
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+
+    if( not defined( $self->{'targets'} ) )
+    {
+        $self->{'targets'} = [];
+    }
+    push( @{$self->{'targets'}}, $token );
+}
+
+
+
+
+sub run
+{
+    my $self = shift;
+    
+    my $config_tree =
+        new Torrus::ConfigTree( -TreeName => $self->{'tree_name'},
+                                -Wait => 1 );
+    if( not defined( $config_tree ) )
+    {
+        return;
+    }
+
+    my $da = new Torrus::DataAccess;
+    
+    $self->{'db_alarms'} = new Torrus::DB('monitor_alarms',
+                                          -Subdir => $self->{'tree_name'},
+                                          -WriteAccess => 1);
+
+    foreach my $token ( @{$self->{'targets'}} )
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        my $mlist = $self->{'sched_data'}{'mlist'}{$token};
+        
+        foreach my $mname ( @{$mlist} )
+        {
+            my $obj = { 'token' => $token, 'mname' => $mname };
+
+            $obj->{'da'} = $da;
+            
+            my $mtype = $config_tree->getParam($mname, 'monitor-type');
+            $obj->{'mtype'} = $mtype;
+            
+            my $method = 'check_' . $mtype;
+            my( $alarm, $timestamp ) = $self->$method( $config_tree, $obj );
+            $obj->{'alarm'} = $alarm;
+            $obj->{'timestamp'} = $timestamp;
+            
+            Debug("Monitor $mname returned ($alarm, $timestamp) ".
+                  "for token $token");
+            
+            $self->setAlarm( $config_tree, $obj );
+            undef $obj;
+        }
+    }
+
+    $self->cleanupExpired();
+    
+    undef $self->{'db_alarms'};
+}
+
+
+sub check_failures
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $obj = shift;
+
+    my $token = $obj->{'token'};
+    my $file = $config_tree->getNodeParam( $token, 'data-file' );
+    my $dir = $config_tree->getNodeParam( $token, 'data-dir' );
+    my $ds = $config_tree->getNodeParam( $token, 'rrd-ds' );
+
+    my ($value, $timestamp) = $obj->{'da'}->read_RRD_DS( $dir.'/'.$file,
+                                                         'FAILURES', $ds );
+    return( $value > 0 ? 1:0, $timestamp );
+
+}
+
+
+sub check_expression
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $obj = shift;
+
+    my $token = $obj->{'token'};
+    my $mname = $obj->{'mname'};
+
+    my ($value, $timestamp) = $obj->{'da'}->read( $config_tree, $token );
+    $value = 'UNKN' unless defined($value);
+    
+    my $expr = $value . ',' . $config_tree->getParam($mname,'rpn-expr');
+    $expr = $self->substitute_vars( $config_tree, $obj, $expr );
+
+    my $display_expr = $config_tree->getParam($mname,'display-rpn-expr');
+    if( defined( $display_expr ) )
+    {
+        $display_expr =
+            $self->substitute_vars( $config_tree, $obj,
+                                    $value . ',' . $display_expr );
+        my ($dv, $dt) = $obj->{'da'}->read_RPN( $config_tree, $token,
+                                                $display_expr, $timestamp );
+        $obj->{'display_value'} = $dv;
+    }
+    else
+    {
+        $obj->{'display_value'} = $value;
+    }
+    
+    return $obj->{'da'}->read_RPN( $config_tree, $token, $expr, $timestamp );
+}
+
+
+sub substitute_vars
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $obj = shift;
+    my $expr = shift;
+    
+    my $token = $obj->{'token'};
+    my $mname = $obj->{'mname'};
+
+    if( index( $expr, '#' ) >= 0 )
+    {
+        my $vars;
+        if( exists( $self->{'varscache'}{$token} ) )
+        {
+            $vars = $self->{'varscache'}{$token};
+        }
+        else
+        {
+            my $varstring =
+                $config_tree->getNodeParam( $token, 'monitor-vars' );
+            foreach my $pair ( split( '\s*;\s*', $varstring ) )
+            {
+                my( $var, $value ) = split( '\s*\=\s*', $pair );
+                $vars->{$var} = $value;
+            }
+            $self->{'varscache'}{$token} = $vars;
+        }
+
+        my $ok = 1;
+        while( index( $expr, '#' ) >= 0 and $ok )
+        {
+            if( not $expr =~ /\#(\w+)/ )
+            {
+                Error("Error in monitor expression: $expr for monitor $mname");
+                $ok = 0;
+            }
+            else
+            {
+                my $var = $1;
+                my $val = $vars->{$var};
+                if( not defined $val )
+                {
+                    Error("Unknown variable $var in monitor $mname");
+                    $ok = 0;
+                }
+                else
+                {
+                    $expr =~ s/\#$var/$val$1/g;
+                }
+            }
+        }
+
+    }
+
+    return $expr;
+}
+    
+
+
+sub setAlarm
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $obj = shift;
+
+    my $token = $obj->{'token'};
+    my $mname = $obj->{'mname'};
+    my $alarm = $obj->{'alarm'};
+    my $timestamp = $obj->{'timestamp'};
+
+    my $key = $mname . ':' . $config_tree->path($token);
+    
+    my $prev_values = $self->{'db_alarms'}->get( $key );
+    my ($t_set, $t_expires, $prev_status, $t_last_change);
+    if( defined($prev_values) )
+    {
+        Debug("Previous state found, Alarm: $alarm, ".
+              "Token: $token, Monitor: $mname");
+        ($t_set, $t_expires, $prev_status, $t_last_change) =
+            split(':', $prev_values);
+    }
+
+    my $event;
+
+    $t_last_change = time();
+    
+    if( $alarm )
+    {
+        if( not $prev_status )
+        {
+            $t_set = $timestamp;
+            $event = 'set';
+        }
+        else
+        {
+            $event = 'repeat';
+        }
+    }
+    else
+    {
+        if( $prev_status )
+        {
+            $t_expires = $t_last_change +
+                $config_tree->getParam($mname, 'expires');
+            $event = 'clear';
+        }
+        else
+        {
+            if( defined($t_expires) and time() > $t_expires )
+            {
+                $self->{'db_alarms'}->del( $key );
+                $event = 'forget';
+            }
+        }
+    }
+
+    if( $event )
+    {
+        Debug("Event: $event, Monitor: $mname, Token: $token");
+        $obj->{'event'} = $event;
+        
+        my $action_token = $token;
+        
+        my $action_target =
+            $config_tree->getNodeParam($token, 'monitor-action-target');
+        if( defined( $action_target ) )
+        {
+            Debug('Action target redirected to ' . $action_target);
+            $action_token = $config_tree->getRelative($token, $action_target);
+            Debug('Redirected to token ' . $action_token);
+        }
+        $obj->{'action_token'} = $action_token;
+
+        foreach my $aname (split(',',
+                                 $config_tree->getParam($mname, 'action')))
+        {
+            &Torrus::DB::checkInterrupted();
+            
+            Debug("Running action: $aname");
+            my $method = 'run_event_' .
+                $config_tree->getParam($aname, 'action-type');
+            $self->$method( $config_tree, $aname, $obj );
+        }
+
+        if( $event ne 'forget' )
+        {
+            $self->{'db_alarms'}->put( $key,
+                                       join(':', ($t_set,
+                                                  $t_expires,
+                                                  ($alarm ? 1:0),
+                                                  $t_last_change)) );
+        }
+    }
+}
+
+
+# If an alarm is no longer in ConfigTree, it is not cleaned by setAlarm.
+# We clean them up explicitly after they expire
+
+sub cleanupExpired
+{
+    my $self = shift;
+
+    &Torrus::DB::checkInterrupted();
+    
+    my $cursor = $self->{'db_alarms'}->cursor(-Write => 1);
+    while( my ($key, $timers) = $self->{'db_alarms'}->next($cursor) )
+    {
+        my ($t_set, $t_expires, $prev_status, $t_last_change) =
+            split(':', $timers);
+        
+        if( $t_last_change and
+            time() > ( $t_last_change + $Torrus::Monitor::alarmTimeout ) and
+            ( (not $t_expires) or (time() > $t_expires) ) )
+        {            
+            my ($mname, $path) = split(':', $key);
+            
+            Info('Cleaned up an orphaned alarm: monitor=' . $mname .
+                 ', path=' . $path);
+            $self->{'db_alarms'}->c_del( $cursor );            
+        }
+    }
+    undef $cursor;
+    
+    &Torrus::DB::checkInterrupted();
+}
+    
+
+
+    
+
+sub run_event_tset
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $aname = shift;
+    my $obj = shift;
+
+    my $token = $obj->{'action_token'};
+    my $event = $obj->{'event'};
+    
+    if( $event eq 'set' or $event eq 'forget' )
+    {
+        my $tset = 'S'.$config_tree->getParam($aname, 'tset-name');
+
+        if( $event eq 'set' )
+        {
+            $config_tree->tsetAddMember($tset, $token, 'monitor');
+        }
+        else
+        {
+            $config_tree->tsetDelMember($tset, $token);
+        }
+    }
+}
+
+
+sub run_event_exec
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $aname = shift;
+    my $obj = shift;
+
+    my $token = $obj->{'action_token'};
+    my $event = $obj->{'event'};
+    my $mname = $obj->{'mname'};
+    my $timestamp = $obj->{'timestamp'};
+
+    my $launch_when = $config_tree->getParam($aname, 'launch-when');
+    if( not defined $launch_when )
+    {
+        $launch_when = 'set';
+    }
+
+    if( grep {$event eq $_} split(',', $launch_when) )
+    {
+        my $cmd = $config_tree->getParam($aname, 'command');
+        $cmd =~ s/\&gt\;/\>/;
+        $cmd =~ s/\&lt\;/\</;
+
+        $ENV{'TORRUS_BIN'}       = $Torrus::Global::pkgbindir;
+        $ENV{'TORRUS_UPTIME'}    = time() - $self->whenStarted();
+
+        $ENV{'TORRUS_TREE'}      = $config_tree->treeName();
+        $ENV{'TORRUS_TOKEN'}     = $token;
+        $ENV{'TORRUS_NODEPATH'}  = $config_tree->path( $token );
+
+        my $nick =
+            $config_tree->getNodeParam( $token, 'descriptive-nickname' );
+        if( not defined( $nick ) )
+        {
+            $nick = $ENV{'TORRUS_NODEPATH'};
+        }
+        $ENV{'TORRUS_NICKNAME'} = $nick;
+        
+        $ENV{'TORRUS_NCOMMENT'}  =
+            $config_tree->getNodeParam( $token, 'comment', 1 );
+        $ENV{'TORRUS_NPCOMMENT'} =
+            $config_tree->getNodeParam( $config_tree->getParent( $token ),
+                                        'comment', 1 );
+        $ENV{'TORRUS_EVENT'}     = $event;
+        $ENV{'TORRUS_MONITOR'}   = $mname;
+        $ENV{'TORRUS_MCOMMENT'}  = $config_tree->getParam($mname, 'comment');
+        $ENV{'TORRUS_TSTAMP'}    = $timestamp;
+
+        if( defined( $obj->{'display_value'} ) )
+        {
+            $ENV{'TORRUS_VALUE'} = $obj->{'display_value'};
+
+            my $format = $config_tree->getParam($mname, 'display-format');
+            if( not defined( $format ) )
+            {
+                $format = '%.2f';
+            }
+
+            $ENV{'TORRUS_DISPLAY_VALUE'} =
+                sprintf( $format, $obj->{'display_value'} );
+        }
+
+        my $severity = $config_tree->getParam($mname, 'severity');
+        if( defined( $severity ) )
+        {
+            $ENV{'TORRUS_SEVERITY'} = $severity;
+        }
+        
+        my $setenv_params =
+            $config_tree->getParam($aname, 'setenv-params');
+
+        if( defined( $setenv_params ) )
+        {
+            foreach my $param ( split( ',', $setenv_params ) )
+            {
+                # We retrieve the param from the monitored token, not
+                # from action-token
+                my $value = $config_tree->getNodeParam( $obj->{'token'},
+                                                        $param );
+                if( not defined $value )
+                {
+                    Warn('Parameter ' . $param . ' referenced in action '.
+                         $aname . ', but not defined for ' .
+                         $config_tree->path($obj->{'token'}));
+                    $value = '';
+                }
+                $param =~ s/\W/_/g;
+                my $envName = 'TORRUS_P_'.$param;
+                Debug("Setting environment $envName to $value");
+                $ENV{$envName} = $value;
+            }
+        }
+
+        my $setenv_dataexpr =
+            $config_tree->getParam($aname, 'setenv-dataexpr');
+
+        if( defined( $setenv_dataexpr ) )
+        {
+            # <param name="setenv_dataexpr" value="ENV1=expr1, ENV2=expr2"/>
+            # Integrity checks are done at compilation time.
+            foreach my $pair ( split( ',', $setenv_dataexpr ) )
+            {
+                my ($env, $param) = split( '=', $pair );
+                my $expr = $config_tree->getParam($aname, $param);
+                my ($value, $timestamp) =
+                    $obj->{'da'}->read_RPN( $config_tree, $token, $expr );
+                my $envName = 'TORRUS_'.$env;
+                Debug("Setting environment $envName to $value");
+                $ENV{$envName} = $value;
+            }
+        }
+
+        Debug("Going to run command: $cmd");
+        my $status = system($cmd);
+        if( $status != 0 )
+        {
+            Error("$cmd executed with error: $!");
+        }
+
+        # Clean up the environment
+        foreach my $envName ( keys %ENV )
+        {
+            if( $envName =~ /^TORRUS_/ )
+            {
+                delete $ENV{$envName};
+            }
+        }
+    }
+}
+
+
+
+#######  Monitor scheduler  ########
+
+package Torrus::MonitorScheduler;
+@Torrus::MonitorScheduler::ISA = qw(Torrus::Scheduler);
+
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::Scheduler;
+use Torrus::TimeStamp;
+
+sub beforeRun
+{
+    my $self = shift;
+
+    my $tree = $self->treeName();
+    my $config_tree = new Torrus::ConfigTree(-TreeName => $tree, -Wait => 1);
+    if( not defined( $config_tree ) )
+    {
+        return undef;
+    }
+
+    my $data = $self->data();
+
+    # Prepare the list of tokens, sorted by period and offset,
+    # from config tree or from cache.
+
+    my $need_new_tasks = 0;
+
+    Torrus::TimeStamp::init();
+    my $known_ts = Torrus::TimeStamp::get($tree . ':monitor_cache');
+    my $actual_ts = $config_tree->getTimestamp();
+    if( $actual_ts >= $known_ts )
+    {
+        if( $self->{'delay'} > 0 )
+        {
+            Info(sprintf('Delaying for %d seconds', $self->{'delay'}));
+            sleep( $self->{'delay'} );
+        }
+
+        Info("Rebuilding monitor cache");
+        Debug("Config TS: $actual_ts, Monitor TS: $known_ts");
+
+        undef $data->{'targets'};
+        $need_new_tasks = 1;
+
+        $data->{'db_tokens'} = new Torrus::DB( 'monitor_tokens',
+                                               -Subdir => $tree,
+                                               -WriteAccess => 1,
+                                               -Truncate    => 1 );
+        $self->cacheMonitors( $config_tree, $config_tree->token('/') );
+        # explicitly close, since we don't need it often, and sometimes
+        # open it in read-only mode
+        $data->{'db_tokens'}->closeNow();
+        undef $data->{'db_tokens'};
+
+        # Set the timestamp
+        &Torrus::TimeStamp::setNow($tree . ':monitor_cache');
+    }
+    Torrus::TimeStamp::release();
+
+    &Torrus::DB::checkInterrupted();
+
+    if( not $need_new_tasks and not defined $data->{'targets'} )
+    {
+        $need_new_tasks = 1;
+
+        $data->{'db_tokens'} = new Torrus::DB('monitor_tokens',
+                                              -Subdir => $tree);
+        my $cursor = $data->{'db_tokens'}->cursor();
+        while( my ($token, $schedule) = $data->{'db_tokens'}->next($cursor) )
+        {
+            my ($period, $offset, $mlist) = split(':', $schedule);
+            if( not exists( $data->{'targets'}{$period}{$offset} ) )
+            {
+                $data->{'targets'}{$period}{$offset} = [];
+            }
+            push( @{$data->{'targets'}{$period}{$offset}}, $token );
+            $data->{'mlist'}{$token} = [];
+            push( @{$data->{'mlist'}{$token}}, split(',', $mlist) );
+        }
+        undef $cursor;
+        $data->{'db_tokens'}->closeNow();
+        undef $data->{'db_tokens'};
+    }
+
+    &Torrus::DB::checkInterrupted();
+
+    # Now fill in Scheduler's task list, if needed
+
+    if( $need_new_tasks )
+    {
+        Verbose("Initializing tasks");
+        my $init_start = time();
+        $self->flushTasks();
+
+        foreach my $period ( keys %{$data->{'targets'}} )
+        {
+            foreach my $offset ( keys %{$data->{'targets'}{$period}} )
+            {
+                my $monitor = new Torrus::Monitor( -Period => $period,
+                                                   -Offset => $offset,
+                                                   -TreeName => $tree,
+                                                   -SchedData => $data );
+
+                foreach my $token ( @{$data->{'targets'}{$period}{$offset}} )
+                {
+                    &Torrus::DB::checkInterrupted();
+                    
+                    $monitor->addTarget( $config_tree, $token );
+                }
+
+                $self->addTask( $monitor );
+            }
+        }
+        Verbose(sprintf("Tasks initialization finished in %d seconds",
+                        time() - $init_start));
+    }
+
+    Verbose("Monitor initialized");
+
+    return 1;
+}
+
+
+sub cacheMonitors
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $ptoken = shift;
+
+    my $data = $self->data();
+
+    foreach my $ctoken ( $config_tree->getChildren( $ptoken ) )
+    {
+        &Torrus::DB::checkInterrupted();
+
+        if( $config_tree->isSubtree( $ctoken ) )
+        {
+            $self->cacheMonitors( $config_tree, $ctoken );
+        }
+        elsif( $config_tree->isLeaf( $ctoken ) and
+               ( $config_tree->getNodeParam($ctoken, 'ds-type') ne
+                 'rrd-multigraph') )
+        {
+            my $mlist = $config_tree->getNodeParam( $ctoken, 'monitor' );
+            if( defined $mlist )
+            {
+                my $period = sprintf('%d',
+                                     $config_tree->getNodeParam
+                                     ( $ctoken, 'monitor-period' ) );
+                my $offset = sprintf('%d',
+                                     $config_tree->getNodeParam
+                                     ( $ctoken, 'monitor-timeoffset' ) );
+                
+                $data->{'db_tokens'}->put( $ctoken,
+                                           $period.':'.$offset.':'.$mlist );
+                
+                push( @{$data->{'targets'}{$period}{$offset}}, $ctoken );
+                $data->{'mlist'}{$ctoken} = [];
+                push( @{$data->{'mlist'}{$ctoken}}, split(',', $mlist) );
+            }
+        }
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/RPN.pm b/torrus/perllib/Torrus/RPN.pm
new file mode 100644
index 000000000..20fe15a16
--- /dev/null
+++ b/torrus/perllib/Torrus/RPN.pm
@@ -0,0 +1,213 @@
+#
+#    Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc.
+#    Copyright (C) 2002  Stanislav Sinyagin
+#
+#    This program is free software; you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation; either version 2 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details.
+#
+#    You should have received a copy of the GNU General Public License
+#    along with this program; if not, write to the Free Software
+#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RPN.pm,v 1.1 2010-12-27 00:03:40 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# a simple little RPN calculator -- implements the same operations
+# that RRDTool does.
+
+# This file is based on Cricket's RPM.pm
+
+package Torrus::RPN;
+
+use strict;
+
+use Torrus::Log;
+use Math::BigFloat;
+
+# Each RPN operator is defined by an array reference with the
+# following  elements: <number of args>, <subroutine>, <accepts undef>
+
+my $operators = {
+    '+' => [ 2, sub{ $_[0] + $_[1]; } ],
+    '-' => [ 2, sub{ $_[0] - $_[1]; } ],
+    '*' => [ 2, sub{ $_[0] * $_[1]; } ],
+    '/' => [ 2, sub{ $_[0] / $_[1]; } ],
+    '%' => [ 2, sub{ $_[0] % $_[1]; } ],
+    'MOD' => [ 2, sub{ $_[0] % $_[1]; } ],
+    'SIN' => [ 1, sub{ sin($_[0]->bsstr()); } ],
+    'COS' => [ 1, sub{ cos($_[0]->bsstr()); } ],
+    'LOG' => [ 1, sub{ log($_[0]); } ],
+    'EXP' => [ 1, sub{ $_[0]->exponent() } ],
+    'FLOOR' => [ 1, sub{ $_[0]->bfloor(); } ],
+    'CEIL' => [ 1, sub{ $_[0]->bceil(); } ],
+    'LT' => [ 2, sub{ ($_[0] <  $_[1]) ? 1:0; } ],
+    'LE' => [ 2, sub{ ($_[0] <= $_[1]) ? 1:0; } ],
+    'GT' => [ 2, sub{ ($_[0] >  $_[1]) ? 1:0; } ],
+    'GE' => [ 2, sub{ ($_[0] >= $_[1]) ? 1:0; } ],
+    'EQ' => [ 2, sub{ ($_[0] == $_[1]) ? 1:0; } ],
+    'IF' => [ 3, sub{ defined($_[0]) ? ($_[0] ? $_[1] : $_[2]) : undef; }, 1],
+    'MIN' => [ 2, sub{ ($_[0] <  $_[1]) ? $_[0] : $_[1]; } ],
+    'MAX' => [ 2, sub{ ($_[0] >  $_[1]) ? $_[0] : $_[1]; } ],
+    'UN'   => [ 1, sub{ defined($_[0]) ? $_[0]->is_nan() : 1; }, 1 ],
+    'UNKN' => [ 0, sub{ undef; } ],
+    # Operators not defined in RRDtool graph
+    'NE'  => [ 2, sub{ ($_[0] != $_[1]) ? 1:0; } ],
+    'AND' => [ 2, sub{ ($_[0] and $_[1]) ? 1:0; } ],
+    'OR'  => [ 2, sub{ ($_[0] or $_[1]) ? 1:0; } ],
+    'NOT' => [ 1, sub{ (not $_[0]) ? 1:0; } ],
+    'ABS' => [ 1, sub{ abs($_[0]); } ],
+    'NOW' => [ 0, sub{ time(); } ],
+    'DUP' => [ 1, sub{ ($_[0], $_[0]);}, 1 ],
+    'EXC' => [ 2, sub{ ($_[1], $_[0]); }, 1 ],
+    'NUM' => [ 1, sub{ defined($_[0]) ? $_[0] : 0; }, 1 ],
+    'INF' => [ 0, sub{ Math::BigFloat->binf(); } ],
+    'NEGINF' => [ 0, sub{ Math::BigFloat->binf('-'); } ]
+    };
+
+
+sub new
+{
+    my $type = shift;
+    my $self = {};
+    bless( $self, $type );
+    $self->{'stack'} = [];
+    return $self;
+}
+
+
+sub operator
+{
+    my $self = shift;
+    my $op = shift;
+
+    my $n_args           = $operators->{$op}->[0];
+    my $action           = $operators->{$op}->[1];
+    my $acceptsUndefined = $operators->{$op}->[2];
+    my @args = ();
+    my $allDefined = 1;
+    for( my $i = 0; $i < $n_args; $i++ )
+    {
+        my $arg = $self->popStack();
+        if( defined( $arg ) or $acceptsUndefined )
+        {
+            push( @args, $arg );
+        }
+        else
+        {
+            $allDefined = 0;
+        }
+    }
+    $self->pushStack( $allDefined ? &{$action}(reverse @args) : undef );
+}
+
+
+sub popStack
+{
+    my $self = shift;
+
+    my $ret;
+    if( scalar( @{$self->{'stack'}} ) == 0 )
+    {
+        Warn("Stack underflow");
+    }
+    else
+    {
+        $ret = pop( @{$self->{'stack'}} );
+    }
+    return $ret;
+}
+
+
+sub pushStack
+{
+    my $self = shift;
+    my @items = @_;
+
+    push( @{$self->{'stack'}}, @items );
+}
+
+
+sub translate
+{
+    my $self = shift;
+    my $string = shift;
+    my $callback = shift;
+
+    # Debug("Translating RPN: $string");
+    my $item;
+    my @new_items;
+    foreach $item ( split( /,/, $string ) )
+    {
+        if( $item =~ /^\{([^\}]*)\}$/ )
+        {
+            my $noderef = $1;
+            my $timeoffset;
+            if( $noderef =~ s/\(([^\)]+)\)// )
+            {
+               $timeoffset = $1;
+            }
+            my $value = &{$callback}( $noderef, $timeoffset );
+            $value = 'UNKN' unless defined( $value );
+            # Debug("$item translated into $value");
+            $item = $value;
+        }
+        elsif( $item eq 'MOD' )
+        {
+            # In Torrus parameter value, percent sign is reserved for
+            # parameter expansion. Rrdtool understands % only.
+            $item = '%';
+        }
+        push( @new_items, $item );
+    }
+
+    $string = join( ',', @new_items );
+    # Debug("RPN translated: $string");
+    return $string;
+}
+
+
+sub run
+{
+    my $self = shift;
+    my $string = shift;
+    my $callback = shift;
+
+    # Debug("Input RPN: $string");
+
+    if( index( $string, '{' ) >= 0 )
+    {
+        $string = $self->translate( $string, $callback );
+    }
+
+    my $item;
+    foreach $item ( split( /,/, $string ) )
+    {
+        if( ref( $operators->{$item} ) )
+        {
+            $self->operator($item);
+        }
+        else
+        {
+            $self->pushStack( Math::BigFloat->new($item) );
+        }
+    }
+    
+    my $retval = $self->popStack();
+    # Debug("RPN result: $retval");
+    return $retval;
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Renderer.pm b/torrus/perllib/Torrus/Renderer.pm
new file mode 100644
index 000000000..803dd1858
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer.pm
@@ -0,0 +1,286 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Renderer.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Renderer;
+
+use strict;
+use Digest::MD5 qw(md5_hex);
+
+use Torrus::DB;
+use Torrus::ConfigTree;
+use Torrus::TimeStamp;
+use Torrus::RPN;
+use Torrus::Log;
+use Torrus::SiteConfig;
+
+use Torrus::Renderer::HTML;
+use Torrus::Renderer::RRDtool;
+
+# Inherit methods from these modules
+use base qw(Torrus::Renderer::HTML
+            Torrus::Renderer::RRDtool
+            Torrus::Renderer::Frontpage
+            Torrus::Renderer::AdmInfo);
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    bless $self, $class;
+
+    if( not defined $Torrus::Global::cacheDir )
+    {
+        Error('$Torrus::Global::cacheDir must be defined');
+        return undef;
+    }
+    elsif( not -d $Torrus::Global::cacheDir )
+    {
+        Error("No such directory: $Torrus::Global::cacheDir");
+        return undef;
+    }
+
+    $self->{'db'} = new Torrus::DB('render_cache', -WriteAccess => 1);
+    if( not defined( $self->{'db'} ) )
+    {
+        return undef;
+    }
+
+    srand( time() * $$ );
+    
+    return $self;
+}
+
+
+# Returns the absolute filename and MIME type:
+#
+# my($fname, $mimetype) = $renderer->render($config_tree, $token, $view);
+#
+
+sub render
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my %new_options = @_;
+
+    # If no options given, preserve the existing ones
+    if( %new_options )
+    {
+        $self->{'options'} = \%new_options;
+    }
+
+    $self->checkAndClearCache( $config_tree );
+
+    my($t_render, $t_expires, $filename, $mime_type);
+
+    my $tree = $config_tree->treeName();
+
+    if( not $config_tree->isTset($token) )
+    {
+        if( my $alias = $config_tree->isAlias($token) )
+        {
+            $token = $alias;
+        }
+        if( not defined( $config_tree->path($token) ) )
+        {
+            Error("No such token: $token");
+            return undef;
+        }
+    }
+
+    $view = $config_tree->getDefaultView($token) unless defined $view;
+
+    my $uid = '';
+    if( $self->{'options'}->{'uid'} )
+    {
+        $uid = $self->{'options'}->{'uid'};
+    }
+
+    my $cachekey = $self->cacheKey( $uid . ':' . $tree . ':' .
+                                    $token . ':' . $view );
+
+    ($t_render, $t_expires, $filename, $mime_type) =
+        $self->getCache( $cachekey );
+
+    my $not_in_cache = 0;
+    
+    if( not defined( $filename ) )
+    {
+        $filename = Torrus::Renderer::newCacheFileName( $cachekey );
+        $not_in_cache = 1;
+    }
+
+    my $cachefile = $Torrus::Global::cacheDir.'/'.$filename;
+
+    if( ( not $not_in_cache ) and
+        -f $cachefile and
+        $t_expires >= time() )
+    {
+        return ($cachefile, $mime_type, $t_expires - time());
+    }
+
+    my $method = 'render_' . $config_tree->getParam($view, 'view-type');
+
+    ($t_expires, $mime_type) =
+        $self->$method( $config_tree, $token, $view, $cachefile );
+
+    if( %new_options )
+    {
+        $self->{'options'} = undef;
+    }
+
+    my @ret;
+    if( defined($t_expires) and defined($mime_type) )
+    {
+        $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type);
+        @ret = ($cachefile, $mime_type, $t_expires - time());
+    }
+
+    return @ret;
+}
+
+
+sub cacheKey
+{
+    my $self = shift;
+    my $keystring = shift;
+
+    if( ref( $self->{'options'}->{'variables'} ) )
+    {
+        foreach my $name ( sort keys %{$self->{'options'}->{'variables'}} )
+        {
+            my $val = $self->{'options'}->{'variables'}->{$name};
+            $keystring .= ':' . $name . '=' . $val;
+        }
+    }
+    return $keystring;
+}
+
+
+sub getCache
+{
+    my $self = shift;
+    my $keystring = shift;
+
+    my $cacheval = $self->{'db'}->get( $keystring );
+
+    if( defined($cacheval) )
+    {
+        return split(':', $cacheval);
+    }
+    else
+    {
+        return undef;
+    }
+}
+
+
+sub setCache
+{
+    my $self = shift;
+    my $keystring = shift;
+    my $t_render = shift;
+    my $t_expires = shift;
+    my $filename = shift;
+    my $mime_type = shift;
+
+    $self->{'db'}->put( $keystring,
+                        join(':',
+                             ($t_render, $t_expires, $filename, $mime_type)));
+}
+
+
+
+sub checkAndClearCache
+{
+    my $self = shift;
+    my $config_tree = shift;
+
+    my $tree = $config_tree->treeName();
+
+    Torrus::TimeStamp::init();
+    my $known_ts = Torrus::TimeStamp::get($tree . ':renderer_cache');
+    my $actual_ts = $config_tree->getTimestamp();
+    if( $actual_ts >= $known_ts or
+        time() >= $known_ts + $Torrus::Renderer::cacheMaxAge )
+    {
+        $self->clearcache();
+        Torrus::TimeStamp::setNow($tree . ':renderer_cache');
+    }
+    Torrus::TimeStamp::release();
+}
+
+
+sub clearcache
+{
+    my $self = shift;
+
+    Debug('Clearing renderer cache');
+    my $cursor = $self->{'db'}->cursor( -Write => 1 );
+    while( my ($key, $val) = $self->{'db'}->next( $cursor ) )
+    {
+        my($t_render, $t_expires, $filename, $mime_type) =  split(':', $val);
+
+        unlink $Torrus::Global::cacheDir.'/'.$filename;
+        $self->{'db'}->c_del( $cursor );
+    }
+    undef $cursor;
+    Debug('Renderer cache cleared');
+}
+
+
+sub newCacheFileName
+{
+    my $cachekey = shift;
+    return sprintf('%s_%.5d', md5_hex($cachekey), rand(1e5));
+}
+
+sub xmlnormalize
+{
+    my( $txt )= @_;
+
+    # Remove spaces in the head and tail.
+    $txt =~ s/^\s+//om;
+    $txt =~ s/\s+$//om;
+
+    # Unscreen special characters
+    $txt =~ s/{COLON}/:/ogm;
+    $txt =~ s/{SEMICOL}/;/ogm;
+    $txt =~ s/{PERCENT}/%/ogm;
+
+    $txt =~ s/\&/\&amp\;/ogm;
+    $txt =~ s/\</\&lt\;/ogm;
+    $txt =~ s/\>/\&gt\;/ogm;
+    $txt =~ s/\'/\&apos\;/ogm;
+    $txt =~ s/\"/\&quot\;/ogm;
+
+    return $txt;
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Renderer/AdmInfo.pm b/torrus/perllib/Torrus/Renderer/AdmInfo.pm
new file mode 100644
index 000000000..1cbd5106a
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer/AdmInfo.pm
@@ -0,0 +1,242 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: AdmInfo.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Renderer::AdmInfo;
+
+use strict;
+
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::ACL;
+
+use Template;
+
+my %rrd_params =
+    (
+     'leaf-type' => {'rrd-def' => {'rrd-ds' => undef,
+                                   'rrd-cf' => undef,
+                                   'data-file' => undef,
+                                   'data-dir'  => undef},
+                     'rrd-cdef' => {'rpn-expr' => undef}},
+     );
+
+my %rrdmulti_params = ( 'ds-names' => undef );
+
+my %collector_params =
+    (
+     'storage-type'   => {'rrd' => {
+         'data-file'              => undef,
+         'data-dir'               => undef,
+         'leaf-type'              => {
+             'rrd-def'  => {'rrd-ds' => undef,
+                            'rrd-cf' => undef,
+                            'rrd-create-dstype' => undef,
+                            'rrd-create-rra'         => undef,
+                            'rrd-create-heartbeat'   => undef,
+                            'rrd-hwpredict'         => {
+                                'enabled' => {'rrd-create-hw-rralen' => undef},
+                                'disabled' => undef
+                                }}}}},
+     'collector-type'        => undef,
+     'collector-period'      => undef,
+     'collector-timeoffset'  => undef,
+     'collector-instance'    => undef,
+     'collector-instance-hashstring' => undef,
+     'collector-scale'      => undef,
+     'collector-dispersed-timeoffset' => {
+         'no' => undef,
+         'yes' => {'collector-timeoffset-min' => undef,
+                   'collector-timeoffset-max' => undef,
+                   'collector-timeoffset-step' => undef,
+                   'collector-timeoffset-hashstring' => undef}}
+     );
+
+
+my %leaf_params =
+    ('ds-type' => {'rrd-file' => \%rrd_params,
+                   'rrd-multigraph' => \%rrdmulti_params,
+                   'collector' => \%collector_params},
+     'rrgraph-views'             => undef,
+     'rrd-scaling-base'         => undef,
+     'graph-logarithmic'        => undef,
+     'graph-rigid-boundaries'   => undef,
+     'graph-ignore-decorations' => undef,
+     'nodeid'                   => undef);
+
+
+my %param_categories =
+    (
+     'collector-dispersed-timeoffset'    => 'Collector',
+     'collector-period'                  => 'Collector',
+     'collector-scale'                   => 'Collector',
+     'collector-timeoffset'              => 'Collector',
+     'collector-timeoffset-hashstring'   => 'Collector',
+     'collector-timeoffset-max'          => 'Collector',
+     'collector-timeoffset-min'          => 'Collector',
+     'collector-timeoffset-step'         => 'Collector',
+     'collector-type'                    => 'Collector',
+     'collector-instance'                => 'Collector',
+     'collector-instance-hashstring'     => 'Collector',
+     'data-dir'                          => 'Storage',
+     'data-file'                         => 'Storage',
+     'ds-names'                          => 'Multigraph',
+     'ds-type'                           => 'Common Parameters',
+     'graph-ignore-decorations'          => 'Display',
+     'graph-logarithmic'                 => 'Display',
+     'graph-rigid-boundaries'            => 'Display',
+     'leaf-type'                         => 'Common Parameters',
+     'nodeid'                            => 'Common Parameters',
+     'rpn-expr'                          => 'RRD CDEF Paramters',
+     'rrd-cf'                            => 'RRD',
+     'rrd-create-dstype'                 => 'RRD',
+     'rrd-create-heartbeat'              => 'RRD',
+     'rrd-create-hw-rralen'              => 'RRD',
+     'rrd-create-rra'                    => 'RRD',
+     'rrd-ds'                            => 'RRD',
+     'rrd-hwpredict'                     => 'RRD',
+     'rrd-scaling-base'                  => 'RRD',
+     'rrgraph-views'                     => 'Display',
+     'storage-type'                      => 'Storage'
+     );
+     
+
+# Load additional validation, configurable from
+# torrus-config.pl and torrus-siteconfig.pl
+
+foreach my $mod ( @Torrus::Renderer::loadAdmInfo )
+{
+    eval( 'require ' . $mod );
+    die( $@ ) if $@;
+    eval( '&' . $mod . '::initAdmInfo( \%leaf_params, \%param_categories )' );
+    die( $@ ) if $@;
+}
+
+
+# All our methods are imported by Torrus::Renderer;
+
+sub render_adminfo
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $outfile = shift;
+
+    if( $self->may_display_adminfo( $config_tree, $token ) )
+    {
+        $self->{'adminfo'} = $self->retrieve_adminfo( $config_tree, $token );
+        my @ret = $self->render_html( $config_tree, $token, $view, $outfile );
+        delete $self->{'adminfo'};
+        return @ret;
+    }
+    else
+    {
+        if( not open(OUT, ">$outfile") )
+        {
+            Error("Cannot open $outfile for writing: $!");
+            return undef;
+        }
+        else
+        {
+            print OUT "Cannot display admin information\n";
+            close OUT;
+        }
+
+        return (300+time(), 'text/plain');
+    }
+}
+
+
+sub may_display_adminfo
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+
+    if( $config_tree->isLeaf( $token ) )
+    {
+        # hasPrivilege is imported from Torrus::Renderer::HTML
+        if( $self->hasPrivilege( $config_tree->treeName(),
+                                 'DisplayAdmInfo' ) )
+        {
+            return 1;
+        }
+    }
+    
+    return 0;
+}
+
+
+sub retrieve_adminfo
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+
+    my $ret = {};
+    my @namemaps = ( \%leaf_params );
+
+    while( scalar( @namemaps ) > 0 )
+    {
+        my @next_namemaps = ();
+
+        foreach my $namemap ( @namemaps )
+        {
+            foreach my $paramkey ( keys %{$namemap} )
+            {
+                my $pname = $paramkey;
+
+                my $pval = $config_tree->getNodeParam( $token, $pname );
+                if( defined( $pval ) )
+                {
+                    if( ref( $namemap->{$paramkey} ) )
+                    {
+                        if( exists $namemap->{$paramkey}->{$pval} )
+                        {
+                            if( defined $namemap->{$paramkey}->{$pval} )
+                            {
+                                push( @next_namemaps,
+                                      $namemap->{$paramkey}->{$pval} );
+                            }
+                        }
+                    }
+
+                    my $category = $param_categories{$pname};
+                    if( not defined( $category ) )
+                    {
+                        $category = 'Other';
+                    }                    
+                    $ret->{$category}{$pname} = $pval;
+                }
+            }
+        }
+        @namemaps = @next_namemaps;
+    }
+
+    return $ret;
+}
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Renderer/Frontpage.pm b/torrus/perllib/Torrus/Renderer/Frontpage.pm
new file mode 100644
index 000000000..5a9d0a39d
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer/Frontpage.pm
@@ -0,0 +1,291 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Frontpage.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Renderer::Frontpage;
+
+use strict;
+
+use Torrus::ConfigTree;
+use Torrus::Search;
+use Torrus::Log;
+
+use Template;
+use URI::Escape;
+
+# All our methods are imported by Torrus::Renderer;
+
+sub renderUserLogin
+{
+    my $self = shift;
+    my %new_options = @_;
+
+    if( %new_options )
+    {
+        $self->{'options'} = \%new_options;
+    }
+
+    my($t_render, $t_expires, $filename, $mime_type);
+
+    my $cachekey = $self->cacheKey( 'LOGINSCREEN' );
+
+    ($t_render, $t_expires, $filename, $mime_type) =
+        $self->getCache( $cachekey );
+
+    # We don't check the expiration time for login screen
+    if( not defined( $filename ) )
+    {
+        $filename = Torrus::Renderer::newCacheFileName( $cachekey );
+    }
+
+    my $outfile = $Torrus::Global::cacheDir.'/'.$filename;
+
+    $t_expires = time();
+    $mime_type = $Torrus::Renderer::LoginScreen::mimeType;
+    my $tmplfile = $Torrus::Renderer::LoginScreen::template;
+
+    # Create the Template Toolkit processor once, and reuse
+    # it in subsequent render() calls
+
+    if( not defined( $self->{'tt'} ) )
+    {
+        $self->{'tt'} =
+            new Template(INCLUDE_PATH => $Torrus::Global::templateDirs,
+                         TRIM => 1);
+    }
+
+    my $url = $Torrus::Renderer::rendererURL;
+    if( length( $self->{'options'}->{'urlPassTree'} ) > 0 )
+    {
+        $url .= '/' . $self->{'options'}->{'urlPassTree'};
+    }
+    
+    my $ttvars =
+    {
+        'url'        => $url,
+        'plainURL'   => $Torrus::Renderer::plainURL,
+        'style'      => sub { return $self->style($_[0]); },
+        'companyName'=> $Torrus::Renderer::companyName,
+        'companyLogo'=> $Torrus::Renderer::companyLogo,
+        'companyURL' => $Torrus::Renderer::companyURL,
+        'lostPasswordURL' => $Torrus::Renderer::lostPasswordURL,
+        'siteInfo'   => $Torrus::Renderer::siteInfo,
+        'version'    => $Torrus::Global::version,
+        'xmlnorm'    => \&Torrus::Renderer::xmlnormalize
+        };
+
+
+    # Pass the options from Torrus::Renderer::render() to Template
+    while( my( $opt, $val ) = each( %{$self->{'options'}} ) )
+    {
+        $ttvars->{$opt} = $val;
+    }
+
+    my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile );
+
+    undef $ttvars;
+
+    my @ret;
+    if( not $result )
+    {
+        Error("Error while rendering login screen: " .
+              $self->{'tt'}->error());
+    }
+    else
+    {
+        $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type);
+        @ret = ($outfile, $mime_type, $t_expires - time());
+    }
+
+    $self->{'options'} = undef;   
+
+    return @ret;
+}
+
+
+sub renderTreeChooser
+{
+    my $self = shift;
+    my %new_options = @_;
+
+    if( %new_options )
+    {
+        $self->{'options'} = \%new_options;
+    }
+
+    my($t_render, $t_expires, $filename, $mime_type);
+
+    my $uid = '';
+    if( $self->{'options'}->{'uid'} )
+    {
+        $uid = $self->{'options'}->{'uid'};
+    }
+
+    my $cachekey = $self->cacheKey( $uid . ':' . 'TREECHOOSER' );
+
+    ($t_render, $t_expires, $filename, $mime_type) =
+        $self->getCache( $cachekey );
+
+    if( defined( $filename ) )
+    {
+        if( $t_expires >= time() )
+        {
+            return ($Torrus::Global::cacheDir.'/'.$filename,
+                    $mime_type, $t_expires - time());
+        }
+        # Else reuse the old filename
+    }
+    else
+    {
+        $filename = Torrus::Renderer::newCacheFileName( $cachekey );
+    }
+
+    my $outfile = $Torrus::Global::cacheDir.'/'.$filename;
+
+    $t_expires = time() + $Torrus::Renderer::Chooser::expires;
+    $mime_type = $Torrus::Renderer::Chooser::mimeType;
+    
+    my $tmplfile;
+    if( defined( $self->{'options'}{'variables'}{'SEARCH'} ) and
+        $self->mayGlobalSearch() )
+    {
+        $tmplfile = $Torrus::Renderer::Chooser::searchTemplate;
+    }
+    else
+    {
+        $tmplfile = $Torrus::Renderer::Chooser::template;
+    }
+
+    # Create the Template Toolkit processor once, and reuse
+    # it in subsequent render() calls
+
+    if( not defined( $self->{'tt'} ) )
+    {
+        $self->{'tt'} =
+            new Template(INCLUDE_PATH => $Torrus::Global::templateDirs,
+                         TRIM => 1);
+    }
+
+    my $ttvars =
+    {
+        'treeNames' => sub{ return Torrus::SiteConfig::listTreeNames() },
+        'treeDescr' => sub{ return
+                                Torrus::SiteConfig::treeDescription($_[0]) }
+        ,
+        'url'  => sub { return $Torrus::Renderer::rendererURL . '/' . $_[0] },
+        'plainURL'   => $Torrus::Renderer::plainURL,
+        'persistentUrl'  => sub { return $Torrus::Renderer::rendererURL . '/' .
+                                  $_[0] . '?path=' . uri_escape($_[1])}
+        ,
+        'clearVar'   => sub { delete $self->{'options'}{'variables'}{$_[0]};
+                              return undef;},
+        'style'      => sub { return $self->style($_[0]); },
+        'companyName'=> $Torrus::Renderer::companyName,
+        'companyLogo'=> $Torrus::Renderer::companyLogo,
+        'companyURL' => $Torrus::Renderer::companyURL,
+        'siteInfo'   => $Torrus::Renderer::siteInfo,
+        'version'    => $Torrus::Global::version,
+        'xmlnorm'    => \&Torrus::Renderer::xmlnormalize,
+        'userAuth'   => $Torrus::CGI::authorizeUsers,
+        'uid'        => $self->{'options'}->{'uid'},
+        'userAttr'   => sub { return $self->userAttribute( $_[0] ) },
+        'mayDisplayTree' => sub { return $self->
+                                      hasPrivilege( $_[0], 'DisplayTree' ) }
+        ,
+        'mayGlobalSearch' => sub { return $self->mayGlobalSearch(); },        
+        'searchResults'   => sub { return $self->doGlobalSearch($_[0]); }
+    };
+
+
+    # Pass the options from Torrus::Renderer::render() to Template
+    while( my( $opt, $val ) = each( %{$self->{'options'}} ) )
+    {
+        $ttvars->{$opt} = $val;
+    }
+
+    my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile );
+
+    undef $ttvars;
+
+    my @ret;
+    if( not $result )
+    {
+        Error("Error while rendering tree chooser: " .
+              $self->{'tt'}->error());
+    }
+    else
+    {
+        $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type);
+        @ret = ($outfile, $mime_type, $t_expires - time());
+    }
+
+    $self->{'options'} = undef;   
+
+    return @ret;
+}
+
+
+sub mayGlobalSearch
+{
+    my $self = shift;
+    
+    return ( $Torrus::Renderer::globalSearchEnabled and
+             ( not $Torrus::CGI::authorizeUsers or
+               ( $self->hasPrivilege( '*', 'GlobalSearch' ) ) ) );
+}
+
+sub doGlobalSearch
+{
+    my $self = shift;
+    my $string = shift;
+    
+    my $sr = new Torrus::Search;
+    $sr->openGlobal();
+    my $result = $sr->searchPrefix( $string );
+
+    my $sorted = [];
+    push( @{$sorted}, sort {$a->[0] cmp $b->[0]} @{$result} );
+
+    # remove duplicating entries
+    my %seen;
+    my $ret = [];
+    
+    foreach my $element ( @{$sorted} )
+    {
+        my $string = join( ':', $element->[0], $element->[1] );
+        if( not $seen{$string} )
+        {
+            $seen{$string} = 1;
+            push( @{$ret}, $element );
+        }
+    }
+        
+    return $ret;
+}
+
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Renderer/HTML.pm b/torrus/perllib/Torrus/Renderer/HTML.pm
new file mode 100644
index 000000000..e9f72acf0
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer/HTML.pm
@@ -0,0 +1,530 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: HTML.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Renderer::HTML;
+
+use strict;
+
+use Torrus::ConfigTree;
+use Torrus::Search;
+use Torrus::Log;
+
+use URI::Escape;
+use Template;
+use POSIX qw(abs log floor pow);
+use Date::Parse;
+use Date::Format;
+
+Torrus::SiteConfig::loadStyling();
+
+# All our methods are imported by Torrus::Renderer;
+
+sub render_html
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $outfile = shift;
+
+    my $tmplfile = $config_tree->getParam($view, 'html-template');
+
+    my $expires = $config_tree->getParam($view, 'expires');
+    
+    # Create the Template Toolkit processor once, and reuse
+    # it in subsequent render() calls
+
+    if( not defined( $self->{'tt'} ) )
+    {
+        $self->{'tt'} =
+            new Template(INCLUDE_PATH => $Torrus::Global::templateDirs,
+                         TRIM => 1);
+    }
+    my $ttvars =
+    {
+        'treeName'   => $config_tree->treeName(),
+        'token'      => $token,
+        'view'       => $view,
+        'expires'    => $expires,
+        'path'       => sub { return $config_tree->path($_[0]); },
+        'pathToken'  => sub { return $config_tree->token($_[0]); },
+        'nodeExists' => sub { return $config_tree->nodeExists($_[0]); },
+        'children'   => sub { return $config_tree->getChildren($_[0]); },
+        'isLeaf'     => sub { return $config_tree->isLeaf($_[0]); },
+        'isAlias'    => sub { return $config_tree->isAlias($_[0]); },
+        'sortTokens' => sub { return $self->sortTokens($config_tree,
+                                                       $_[0]); },
+        'nodeName'   => sub { return $self->nodeName($config_tree, $_[0]); },
+        'parent'     => sub { return $config_tree->getParent($_[0]); },
+        'nodeParam'  => sub { return $config_tree->getNodeParam(@_); },
+        'param'      => sub { return $config_tree->getParam(@_); },
+        'url'        => sub { return $self->makeURL($config_tree, 0, @_); },
+        'persistentUrl' => sub { return $self->makeURL($config_tree, 1, @_); },
+        'clearVar'   => sub { delete $self->{'options'}{'variables'}{$_[0]};
+                              return undef;},
+        'plainURL'   => $Torrus::Renderer::plainURL,
+        'splitUrls'  => sub { return $self->makeSplitURLs($config_tree,
+                                                          $_[0], $_[1]); },
+        'topURL'     => ($Torrus::Renderer::rendererURL ne '' ?
+                         $Torrus::Renderer::rendererURL : '/'),
+        'rrprint'    => sub { return $self->rrPrint($config_tree,
+                                                    $_[0], $_[1]); },
+        'scale'      => sub { return $self->scale($_[0], $_[1]); },
+        'tsetMembers' => sub { $config_tree->tsetMembers($_[0]); },
+        'tsetList'   => sub { $config_tree->getTsets(); },
+        'style'      => sub { return $self->style($_[0]); },
+        'companyName'=> $Torrus::Renderer::companyName,
+        'companyLogo'=> $Torrus::Renderer::companyLogo,
+        'companyURL' => $Torrus::Renderer::companyURL,
+        'siteInfo'   => $Torrus::Renderer::siteInfo,
+        'treeInfo'   => sub { return $Torrus::Global::treeConfig{
+            $config_tree->treeName()}{'info'}; },
+        'version'    => $Torrus::Global::version,
+        'xmlnorm'    => \&Torrus::Renderer::xmlnormalize,
+        'userAuth'   => $Torrus::CGI::authorizeUsers,
+        'uid'        => $self->{'options'}->{'uid'},
+        'userAttr'   => sub { return $self->userAttribute( $_[0] ) },
+        'mayDisplayAdmInfo' => sub {
+            return $self->may_display_adminfo( $config_tree, $_[0] ) },
+        'adminfo' => $self->{'adminfo'},
+        'mayDisplayReports' => sub {
+            return $self->may_display_reports($config_tree) },
+        'reportsUrl' => sub {
+            return $self->reportsUrl($config_tree); },
+        'timestamp'  => sub { return time2str($Torrus::Renderer::timeFormat,
+                                              time()); },
+        'verifyDate'  => sub { return verifyDate($_[0]); },
+        'markup'     => sub{ return $self->translateMarkup( @_ ); },
+        'searchEnabled' => $Torrus::Renderer::searchEnabled,
+        'searchResults' => sub { return $self->doSearch($config_tree, $_[0]); }
+    };
+    
+    
+    # Pass the options from Torrus::Renderer::render() to Template
+    while( my( $opt, $val ) = each( %{$self->{'options'}} ) )
+    {
+        $ttvars->{$opt} = $val;
+    }
+
+    my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile );
+
+    undef $ttvars;
+
+    if( not $result )
+    {
+        if( $config_tree->isTset( $token ) )
+        {
+            Error("Error while rendering tokenset $token: " .
+                  $self->{'tt'}->error());
+        }
+        else
+        {
+            my $path = $config_tree->path($token);
+            Error("Error while rendering $path: " .
+                  $self->{'tt'}->error());
+        }
+        return undef;
+    }
+
+    return ($expires+time(), 'text/html; charset=UTF-8');
+}
+
+
+sub nodeName
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+
+    my $n = $config_tree->getNodeParam($token, 'node-display-name', 1);
+    if( defined( $n ) and length( $n ) > 0 )
+    {
+        return $n;
+    }
+    
+    return $config_tree->nodeName($config_tree->path($token));
+}
+
+
+sub sortTokens
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $tokenlist = shift;
+
+    my @sorted = ();
+    if( ref($tokenlist) and scalar(@{$tokenlist}) > 0 )
+    {
+        @sorted = sort
+        {
+            my $p_a = $config_tree->getNodeParam($a, 'precedence', 1);
+            $p_a = 0 unless defined $p_a;
+            my $p_b = $config_tree->getNodeParam($b, 'precedence', 1);
+            $p_b = 0 unless defined $p_b;
+            if( $p_a == $p_b )
+            {
+                my $n_a = $config_tree->path($a);
+                my $n_b = $config_tree->path($b);
+                return $n_a cmp $n_b;
+            }
+            else
+            {
+                return $p_b <=> $p_a;
+            }
+        } @{$tokenlist};
+    }
+    else
+    {
+        push(@sorted, $tokenlist);
+    }
+    return @sorted;
+}
+
+
+# compose an URL for a node.
+# $persistent defines if the link should be persistent
+# Persistent link is done with nodeid if available, or with path
+
+sub makeURL
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $persistent = shift;
+    my $token = shift;
+    my $view = shift;
+    my @add_vars = @_;
+
+    my $ret = $Torrus::Renderer::rendererURL . '/' . $config_tree->treeName();
+    
+    if( $persistent )
+    {
+        my $nodeid = $config_tree->getNodeParam($token, 'nodeid', 1);
+        if( defined( $nodeid ) )
+        {
+            $ret .= '?nodeid=' .
+                uri_escape($nodeid, $Torrus::Renderer::uriEscapeExceptions);
+        }
+        else
+        {
+            $ret .= '?path=' .
+                uri_escape($config_tree->path($token),
+                           $Torrus::Renderer::uriEscapeExceptions);
+        }
+    }
+    else
+    {
+        $ret .= '?token=' . uri_escape($token);
+    }
+
+    if( $view )
+    {
+        $ret .= '&amp;view=' . uri_escape($view);
+    }
+
+    my %vars = ();
+    # This could be array or a reference to array
+    my $add_vars_size = scalar( @add_vars );
+    if( $add_vars_size == 1 and ref( $add_vars[0] ) )
+    {
+        %vars = @{$add_vars[0]};
+    }
+    elsif( $add_vars_size > 0 and ($add_vars_size % 2 == 0) )
+    {
+        %vars = @add_vars;
+    }
+
+    if( ref( $self->{'options'}->{'variables'} ) )
+    {
+        foreach my $name ( sort keys %{$self->{'options'}->{'variables'}} )
+        {
+            my $val = $self->{'options'}->{'variables'}->{$name};
+            if( not defined( $vars{$name} ) )
+            {
+                $vars{$name} = $val;
+            }
+        }
+    }
+
+    foreach my $name ( sort keys %vars )
+    {
+        if( $vars{$name} ne '' )
+        {
+            $ret .= '&amp;' . $name . '=' .
+                uri_escape( $vars{$name},
+                            $Torrus::Renderer::uriEscapeExceptions );
+        }
+    }
+
+    return $ret;
+}
+
+sub makeSplitURLs
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+
+    my $ret = '';
+    while( defined( $token ) )
+    {
+        my $path = $config_tree->path($token);
+        
+        my $str = '<SPAN CLASS="PathElement">';
+        $str .=
+            sprintf('<A HREF="%s">%s%s</A>',
+                    $self->makeURL($config_tree, 0, $token, $view),
+                    $config_tree->nodeName($path),
+                    ( $config_tree->isSubtree($token) and
+                      $path ne '/') ? '/':'' );
+        $str .= "</SPAN>\n";
+        
+        $ret = $str . $ret;
+                
+        $token = $config_tree->getParent( $token );
+    }
+    
+    return $ret;
+}
+
+
+sub rrPrint
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+
+    my @ret = ();
+    my($fname, $mimetype) = $self->render( $config_tree, $token, $view );
+
+    if( $mimetype ne 'text/plain' )
+    {
+        Error("View $view does not produce text/plain for token $token");
+    }
+    else
+    {
+        if( not open(IN, $fname) )
+        {
+            Error("Cannot open $fname for reading: $!");
+        }
+        else
+        {
+            chomp(my $values = <IN>);
+            @ret = split(':', $values);
+            close IN;
+        }
+    }
+    return @ret;
+}
+
+# This subroutine is taken from Dave Plonka's Flowscan
+
+sub scale
+{
+    my $self = shift;
+    # This is based somewhat on Tobi Oetiker's code in rrd_graph.c:
+    my $fmt = shift;
+    my $value = shift;
+    my @symbols = ("a", # 10e-18 Ato
+                   "f", # 10e-15 Femto
+                   "p", # 10e-12 Pico
+                   "n", # 10e-9  Nano
+                   "u", # 10e-6  Micro
+                   "m", # 10e-3  Milli
+                   " ", # Base
+                   "k", # 10e3   Kilo
+                   "M", # 10e6   Mega
+                   "G", # 10e9   Giga
+                   "T", # 10e12  Terra
+                   "P", # 10e15  Peta
+                   "E"); # 10e18  Exa
+
+    my $symbcenter = 6;
+    my $digits = (0 == $value)? 0 : floor(log(abs($value))/log(1000));
+    return sprintf( $fmt . " %s", $value/pow(1000, $digits),
+                    $symbols[ $symbcenter+$digits ] );
+}
+
+sub style
+{
+    my $self = shift;
+    my $object = shift;
+
+    my $media;
+    if( not defined( $media = $self->{'options'}->{'variables'}->{'MEDIA'} ) )
+    {
+        $media = 'default';
+    }
+    return  $Torrus::Renderer::styling{$media}{$object};
+}
+
+
+
+sub userAttribute
+{
+    my $self = shift;
+    my $attr = shift;
+
+    if( $self->{'options'}->{'uid'} and $self->{'options'}->{'acl'} )
+    {
+        $self->{'options'}->{'acl'}->
+            userAttribute( $self->{'options'}->{'uid'}, $attr );
+    }
+    else
+    {
+        return '';
+    }
+}
+
+sub hasPrivilege
+{
+    my $self = shift;
+    my $object = shift;
+    my $privilege = shift;
+
+    if( $self->{'options'}->{'uid'} and $self->{'options'}->{'acl'} )
+    {
+        $self->{'options'}->{'acl'}->
+            hasPrivilege( $self->{'options'}->{'uid'}, $object, $privilege );
+    }
+    else
+    {
+        return undef;
+    }
+}
+
+
+sub translateMarkup
+{
+    my $self = shift;
+    my @strings = @_;
+
+    my $tt = new Template( TRIM => 1 );
+
+    my $ttvars =
+    {
+        'em'      =>  sub { return '<em>' . $_[0] . '</em>'; },
+        'strong'  =>  sub { return '<strong>' . $_[0] . '</strong>'; }
+    };
+    
+    my $ret = '';
+    
+    foreach my $str ( @strings )
+    {
+        my $output = '';
+        my $result = $tt->process( \$str, $ttvars, \$output );
+
+        if( not $result )
+        {
+            Error('Error translating markup: ' . $tt->error());
+        }
+        else
+        {
+            $ret .= $output;
+        }
+    }
+
+    undef $tt;
+    
+    return $ret;
+}
+
+
+sub verifyDate
+{
+    my $input = shift;
+
+    my $time = str2time( $input );
+    # rrdtool does not understand dates prior to 1980 (315529200)
+    if( defined( $time ) and $time > 315529200 )
+    {
+        # Present the time in format understood by rrdtool
+        return time2str('%H:%M %Y%m%d', $time);
+    }
+    else
+    {
+        return '';
+    }
+}
+
+
+sub may_display_reports
+{
+    my $self = shift;
+    my $config_tree = shift;
+
+    if( $Torrus::Renderer::displayReports )
+    {
+        if( not $Torrus::CGI::authorizeUsers )
+        {
+            return 1;
+        }
+        
+        my $tree = $config_tree->treeName();
+        if( $self->hasPrivilege( $tree, 'DisplayReports' ) and
+            -r $Torrus::Global::reportsDir . '/' . $tree .
+            '/html/index.html' )
+        {
+            return 1;
+        }
+    }
+    return 0;
+}
+
+
+sub reportsUrl
+{
+    my $self = shift;
+    my $config_tree = shift;
+
+    return $Torrus::Renderer::rendererURL . '/' .
+        $config_tree->treeName() . '?htmlreport=index.html';
+}
+
+
+sub doSearch
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $string = shift;
+    
+
+    my $tree = $config_tree->treeName();
+    
+    my $sr = new Torrus::Search;
+    $sr->openTree( $tree );
+    my $result = $sr->searchPrefix( $string, $tree );
+    $sr->closeTree( $tree );
+
+    my $ret = [];
+    push( @{$ret}, sort {$a->[0] cmp $b->[0]} @{$result} );
+    
+    return $ret;
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Renderer/RRDtool.pm b/torrus/perllib/Torrus/Renderer/RRDtool.pm
new file mode 100644
index 000000000..db0cc54a9
--- /dev/null
+++ b/torrus/perllib/Torrus/Renderer/RRDtool.pm
@@ -0,0 +1,993 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RRDtool.pm,v 1.1 2010-12-27 00:03:44 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::Renderer::RRDtool;
+
+use strict;
+
+use Torrus::ConfigTree;
+use Torrus::RPN;
+use Torrus::Log;
+
+use RRDs;
+
+# All our methods are imported by Torrus::Renderer;
+
+my %rrd_graph_opts =
+    (
+     'start'  => '--start',
+     'end'    => '--end',
+     'width'  => '--width',
+     'height' => '--height'
+     );
+
+my @arg_arrays = qw(opts defs bg hwtick hrule hwline line fg);
+
+
+sub render_rrgraph
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $outfile = shift;
+
+    if( not $config_tree->isLeaf($token) )
+    {
+        Error("Token $token is not a leaf");
+        return undef;
+    }
+
+    my $obj = {'args' => {}, 'dname' => 'A'};
+
+    foreach my $arrayName ( @arg_arrays )
+    {
+        $obj->{'args'}{$arrayName} = [];
+    }
+
+    push( @{$obj->{'args'}{'opts'}},
+          $self->rrd_make_opts( $config_tree, $token, $view,
+                                \%rrd_graph_opts, ) );
+
+    push( @{$obj->{'args'}{'opts'}},
+          $self->rrd_make_graph_opts( $config_tree, $token, $view ) );
+
+    my $dstype = $config_tree->getNodeParam($token, 'ds-type');
+
+    if( $dstype eq 'rrd-multigraph' )
+    {
+        $self->rrd_make_multigraph( $config_tree, $token, $view, $obj );
+    }
+    else
+    {
+        my $leaftype = $config_tree->getNodeParam($token, 'leaf-type');
+
+        # Handle DEFs and CDEFs
+        # At the moment, we call the DEF as 'A'. Could change in the future
+        if( $leaftype eq 'rrd-def' )
+        {
+            push( @{$obj->{'args'}{'defs'}},
+                  $self->rrd_make_def( $config_tree, $token,
+                                       $obj->{'dname'} ) );
+
+            if( $self->rrd_check_hw( $config_tree, $token, $view ) )
+            {
+                $self->rrd_make_holtwinters( $config_tree, $token,
+                                             $view, $obj );
+            }
+        }
+        elsif( $leaftype eq 'rrd-cdef' )
+        {
+            my $expr = $config_tree->getNodeParam($token, 'rpn-expr');
+            push( @{$obj->{'args'}{'defs'}},
+                  $self->rrd_make_cdef($config_tree, $token,
+                                       $obj->{'dname'}, $expr) );
+        }
+        else
+        {
+            Error("Unsupported leaf-type: $leaftype");
+            return undef;
+        }
+
+        $self->rrd_make_graphline( $config_tree, $token, $view, $obj );
+    }
+
+    $self->rrd_make_hrules( $config_tree, $token, $view, $obj );
+    if( not $Torrus::Renderer::ignoreDecorations )
+    {
+        $self->rrd_make_decorations( $config_tree, $token, $view, $obj );
+    }
+
+    # We're all set
+
+
+    my @args;
+    foreach my $arrayName ( @arg_arrays )
+    {
+        push( @args, @{$obj->{'args'}{$arrayName}} );
+    }
+    Debug("RRDs::graph arguments: " . join(' ', @args));
+
+    $self->tz_set();
+    &RRDs::graph( $outfile, @args );
+    $self->tz_restore();
+    my $ERR=RRDs::error;
+    if( $ERR )
+    {
+        my $path = $config_tree->path($token);
+        Error("$path $view: Error during RRD graph: $ERR");
+        return undef;
+    }
+
+    return( $config_tree->getParam($view, 'expires')+time(), 'image/png' );
+}
+
+
+my %rrd_print_opts =
+    (
+     'start'  => '--start',
+     'end'    => '--end',
+     );
+
+
+
+sub render_rrprint
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $outfile = shift;
+
+    if( not $config_tree->isLeaf($token) )
+    {
+        Error("Token $token is not a leaf");
+        return undef;
+    }
+
+    my @arg_opts;
+    my @arg_defs;
+    my @arg_print;
+
+    push( @arg_opts, $self->rrd_make_opts( $config_tree, $token, $view,
+                                           \%rrd_print_opts, ) );
+
+    my $dstype = $config_tree->getNodeParam($token, 'ds-type');
+
+    if( $dstype eq 'rrd-multigraph' )
+    {
+        Error("View type rrprint is not supported ".
+              "for DS type rrd-multigraph");
+        return undef;
+    }
+
+    my $leaftype = $config_tree->getNodeParam($token, 'leaf-type');
+
+    # Handle DEFs and CDEFs
+    # At the moment, we call the DEF as 'A'. Could change in the future
+    my $dname = 'A';
+    if( $leaftype eq 'rrd-def' )
+    {
+        push( @arg_defs,
+              $self->rrd_make_def( $config_tree, $token, $dname ) );
+    }
+    elsif( $leaftype eq 'rrd-cdef' )
+    {
+        my $expr = $config_tree->getNodeParam($token, 'rpn-expr');
+        push( @arg_defs,
+              $self->rrd_make_cdef($config_tree, $token, $dname, $expr) );
+    }
+    else
+    {
+        Error("Unsupported leaf-type: $leaftype");
+        return undef;
+    }
+
+    foreach my $cf ( split(',', $config_tree->getParam($view, 'print-cf')) )
+    {
+        push( @arg_print, sprintf( 'PRINT:%s:%s:%%le', $dname, $cf ) );
+    }
+
+    # We're all set
+
+    my @args = ( @arg_opts, @arg_defs, @arg_print );
+    Debug("RRDs::graph arguments: " . join(' ', @args));
+
+    my $printout;
+    $self->tz_set();
+    ($printout, undef, undef) = RRDs::graph('/dev/null', @args);
+    $self->tz_restore();
+    my $ERR=RRDs::error;
+    if( $ERR )
+    {
+        my $path = $config_tree->path($token);
+        Error("$path $view: Error during RRD graph: $ERR");
+        return undef;
+    }
+
+    if( not open(OUT, ">$outfile") )
+    {
+        Error("Cannot open $outfile for writing: $!");
+        return undef;
+    }
+    else
+    {
+        printf OUT ("%s\n", join(':', @{$printout}));
+        close OUT;
+    }
+
+    return( $config_tree->getParam($view, 'expires')+time(), 'text/plain' );
+}
+
+
+
+sub rrd_make_multigraph
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $obj = shift;
+
+    my @dsNames =
+        split(',', $config_tree->getNodeParam($token, 'ds-names') );
+
+    # We need this to refer to some existing variable name
+    $obj->{'dname'} = $dsNames[0];
+
+    # Analyze the drawing order
+    my %dsOrder;
+    foreach my $dname ( @dsNames )
+    {
+        my $order = $config_tree->getNodeParam($token, 'line-order-'.$dname);
+        $dsOrder{$dname} = defined( $order ) ? $order : 100;
+    }
+
+    my $disable_legend = $config_tree->getParam($view, 'disable-legend');    
+    $disable_legend =
+        (defined($disable_legend) and $disable_legend eq 'yes') ? 1:0;
+    
+    # make DEFs and Line instructions
+
+    my $do_gprint = 0;
+
+    if( not $disable_legend )
+    {
+        $do_gprint = $self->rrd_if_gprint( $config_tree, $token );
+        if( $do_gprint )
+        {
+            $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj );
+        }
+    }
+
+    foreach my $dname ( sort {$dsOrder{$a} <=> $dsOrder{$b}} @dsNames )
+    {
+        my $dograph = 1;
+        my $ignoreViews =
+            $config_tree->getNodeParam($token, 'ignore-views-'.$dname);
+        if( defined( $ignoreViews ) and
+            grep {$_ eq $view} split(',', $ignoreViews) )
+        {
+            $dograph = 0;
+        }
+
+        my $gprint_this = $do_gprint;
+        if( $do_gprint )
+        {
+            my $ds_nogprint =
+                $config_tree->getNodeParam($token, 'disable-gprint-'.$dname);
+            if( defined( $ds_nogprint ) and $ds_nogprint eq 'yes' )
+            {
+                $gprint_this = 0;
+            }
+        }
+
+        my $legend;
+        
+        if( $dograph or $gprint_this )
+        {
+            my $expr = $config_tree->getNodeParam($token, 'ds-expr-'.$dname);
+            push( @{$obj->{'args'}{'defs'}},
+                  $self->rrd_make_cdef($config_tree, $token, $dname, $expr) );
+
+            $legend =
+                $config_tree->getNodeParam($token, 'graph-legend-'.$dname);
+            if( defined( $legend ) )
+            {
+                $legend =~ s/:/\\:/g;
+            }
+            else
+            {
+                $legend = '';
+            }
+        }
+            
+        if( $gprint_this )
+        {
+            $self->rrd_make_gprint( $dname, $legend,
+                                    $config_tree, $token, $view, $obj );
+            if( not $dograph )
+            {
+                push( @{$obj->{'args'}{'line'}},
+                      'COMMENT:' . $legend . '\l');
+            }
+        }
+        else
+        {
+            # For datasource that disables gprint, there's no reason
+            # to print the label
+            $legend = '';
+        }
+        
+        if( $dograph )
+        {
+            my $linestyle =
+                $self->mkline( $config_tree->getNodeParam
+                               ($token, 'line-style-'.$dname) );
+            
+            my $linecolor =
+                $self->mkcolor( $config_tree->getNodeParam
+                                ($token, 'line-color-'.$dname) );
+            
+            my $alpha =
+                $config_tree->getNodeParam($token, 'line-alpha-'.$dname);
+            if( defined( $alpha ) )
+            {
+                $linecolor .= $alpha;
+            }
+
+            my $stack =
+                $config_tree->getNodeParam($token, 'line-stack-'.$dname);
+            if( defined( $stack ) and $stack eq 'yes' )
+            {
+                $stack = ':STACK';
+            }
+            else
+            {
+                $stack = '';
+            }
+                
+            push( @{$obj->{'args'}{'line'}},
+                  sprintf( '%s:%s%s%s%s', $linestyle, $dname,
+                           $linecolor,
+                           length($legend) > 0 ? ':'.$legend.'\l' : '',
+                           $stack ) );
+            
+        }
+    }
+}
+
+
+# Check if Holt-Winters stuff is needed
+sub rrd_check_hw
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+
+    my $use_hw = 0;
+    my $nodeHW = $config_tree->getNodeParam($token, 'rrd-hwpredict');
+    if( defined($nodeHW) and $nodeHW eq 'enabled' )
+    {
+        my $viewHW = $config_tree->getParam($view, 'rrd-hwpredict');
+        my $varNoHW = $self->{'options'}->{'variables'}->{'NOHW'};
+        
+        if( (not defined($viewHW) or $viewHW ne 'disabled') and
+            (not $varNoHW) )
+        {
+            $use_hw = 1;
+        }
+    }
+    return $use_hw;
+}
+
+
+sub rrd_make_holtwinters
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $obj = shift;
+
+    my $dname = $obj->{'dname'};
+
+    push( @{$obj->{'args'}{'defs'}},
+          $self->rrd_make_def( $config_tree, $token,
+                               $dname . 'pred', 'HWPREDICT' ) );
+    push( @{$obj->{'args'}{'defs'}},
+          $self->rrd_make_def( $config_tree, $token,
+                               $dname . 'dev', 'DEVPREDICT' ) );
+    # Upper boundary definition
+    push( @{$obj->{'args'}{'defs'}},
+          sprintf( 'CDEF:%supper=%spred,%sdev,2,*,+',
+                   $dname, $dname, $dname  ) );
+
+    # Lower boundary definition
+    push( @{$obj->{'args'}{'defs'}},
+          sprintf( 'CDEF:%slower=%spred,%sdev,2,*,-',
+                   $dname, $dname, $dname  ) );
+
+    # Failures definition
+    push( @{$obj->{'args'}{'defs'}},
+          $self->rrd_make_def( $config_tree, $token,
+                               $dname . 'fail', 'FAILURES' ) );
+
+    # Generate H-W Boundary Lines
+
+    # Boundary style
+    my $hw_bndr_style = $config_tree->getParam($view, 'hw-bndr-style');
+    $hw_bndr_style = 'LINE1' unless defined $hw_bndr_style;
+    $hw_bndr_style = $self->mkline( $hw_bndr_style );
+
+    my $hw_bndr_color = $config_tree->getParam($view, 'hw-bndr-color');
+    $hw_bndr_color = '#FF0000' unless defined $hw_bndr_color;
+    $hw_bndr_color = $self->mkcolor( $hw_bndr_color );
+
+    push( @{$obj->{'args'}{'hwline'}},
+          sprintf( '%s:%supper%s:%s',
+                   $hw_bndr_style, $dname, $hw_bndr_color,
+                   $Torrus::Renderer::hwGraphLegend ? 'Boundaries\n':'' ) );
+    push( @{$obj->{'args'}{'hwline'}},
+          sprintf( '%s:%slower%s',
+                   $hw_bndr_style, $dname, $hw_bndr_color ) );
+
+    # Failures Tick
+
+    my $hw_fail_color = $config_tree->getParam($view, 'hw-fail-color');
+    $hw_fail_color = '#FFFFA0' unless defined $hw_fail_color;
+    $hw_fail_color = $self->mkcolor( $hw_fail_color );
+
+    push( @{$obj->{'args'}{'hwtick'}},
+          sprintf( 'TICK:%sfail%s:1.0:%s',
+                   $dname, $hw_fail_color,
+                   $Torrus::Renderer::hwGraphLegend ? 'Failures':'') );
+}
+
+sub rrd_make_graphline
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $obj = shift;
+
+    my $legend;
+    
+    my $disable_legend = $config_tree->getParam($view, 'disable-legend');
+    if( not defined($disable_legend) or $disable_legend ne 'yes' )
+    {
+        $legend = $config_tree->getNodeParam($token, 'graph-legend');
+        if( defined( $legend ) )
+        {
+            $legend =~ s/:/\\:/g;
+        }
+    }
+
+    if( not defined( $legend ) )
+    {
+        $legend = '';
+    }
+    
+    my $styleval = $config_tree->getNodeParam($token, 'line-style');
+    if( not defined( $styleval ) or length( $styleval ) == 0 )
+    {
+        $styleval = $config_tree->getParam($view, 'line-style');
+    }
+    
+    my $linestyle = $self->mkline( $styleval );
+
+    my $colorval = $config_tree->getNodeParam($token, 'line-color');
+    if( not defined( $colorval ) or length( $colorval ) == 0 )
+    {
+        $colorval = $config_tree->getParam($view, 'line-color');
+    }
+    
+    my $linecolor = $self->mkcolor( $colorval );
+
+    if( $self->rrd_if_gprint( $config_tree, $token ) )
+    {
+        $self->rrd_make_gprint_header( $config_tree, $token, $view, $obj );
+
+        $self->rrd_make_gprint( $obj->{'dname'}, $legend,
+                                $config_tree, $token, $view, $obj );
+    }
+
+    push( @{$obj->{'args'}{'line'}},
+          sprintf( '%s:%s%s%s', $linestyle, $obj->{'dname'}, $linecolor,
+                   length($legend) > 0 ? ':'.$legend.'\l' : '' ) );
+}
+
+
+# Generate RRDtool arguments for HRULE's
+
+sub rrd_make_hrules
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $obj = shift;
+
+    my $hrulesList = $config_tree->getParam($view, 'hrules');
+    if( defined( $hrulesList ) )
+    {
+        foreach my $hruleName ( split(',', $hrulesList ) )
+        {
+            # The presence of this parameter is checked by Validator
+            my $valueParam =
+                $config_tree->getParam( $view, 'hrule-value-'.$hruleName );
+            my $value = $config_tree->getNodeParam( $token, $valueParam );
+
+            if( defined( $value ) )
+            {
+                my $color =
+                    $config_tree->getParam($view, 'hrule-color-'.$hruleName);
+                $color = $self->mkcolor( $color );
+
+                my $legend =
+                    $config_tree->getNodeParam($token,
+                                               'hrule-legend-'.$hruleName);
+
+                my $arg = sprintf( 'HRULE:%e%s', $value, $color );
+                if( defined( $legend ) and $legend =~ /\S/ )
+                {
+                    $arg .= ':' . $legend . '\l';
+                }
+                push( @{$obj->{'args'}{'hrule'}}, $arg );
+            }
+        }
+    }
+}
+
+
+sub rrd_make_decorations
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $obj = shift;
+
+    my $decorList = $config_tree->getParam($view, 'decorations');
+    my $ignore_decor =
+        $config_tree->getNodeParam($token, 'graph-ignore-decorations');
+    if( defined( $decorList ) and
+        (not defined($ignore_decor) or $ignore_decor ne 'yes') )
+    {
+        my $decor = {};
+        foreach my $decorName ( split(',', $decorList ) )
+        {
+            my $order =
+                $config_tree->getParam($view, 'dec-order-' . $decorName);
+            $decor->{$order} = {'def' => [], 'line' => ''};
+
+            my $style =
+                $self->mkline( $config_tree->
+                               getParam($view, 'dec-style-' . $decorName) );
+            my $color =
+                $self->mkcolor( $config_tree->
+                                getParam($view, 'dec-color-' . $decorName) );
+            my $expr = $config_tree->
+                getParam($view, 'dec-expr-' . $decorName);
+
+            push( @{$decor->{$order}{'def'}},
+                  $self->rrd_make_cdef( $config_tree, $token, $decorName,
+                                        $obj->{'dname'} . ',POP,' . $expr ) );
+
+            $decor->{$order}{'line'} =
+                sprintf( '%s:%s%s', $style, $decorName, $color );
+        }
+
+        foreach my $order ( sort {$a<=>$b} keys %{$decor} )
+        {
+            my $array = $order < 0 ? 'bg':'fg';
+
+            push( @{$obj->{'args'}{'defs'}}, @{$decor->{$order}{'def'}} );
+            push( @{$obj->{'args'}{$array}}, $decor->{$order}{'line'} );
+        }
+    }
+}
+
+# Takes the parameters from the view, and composes the list of
+# RRDtool arguments
+
+sub rrd_make_opts
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $opthash = shift;
+
+    my @args = ();
+    foreach my $param ( keys %{$opthash} )
+    {
+        my $value =
+            $self->{'options'}->{'variables'}->{'G' . $param};
+        
+        if( not defined( $value ) )
+        {
+            $value = $config_tree->getParam( $view, $param );
+        }
+        
+        if( defined( $value ) )
+        {
+            if( ( $param eq 'start' or $param eq 'end' ) and
+                defined( $self->{'options'}->{'variables'}->{'NOW'} ) )
+            {
+                my $now = $self->{'options'}->{'variables'}->{'NOW'};
+                if( index( $value , 'now' ) >= 0 )
+                {
+                    $value =~ s/now/$now/;
+                }
+                elsif( $value =~ /^(\-|\+)/ )
+                {
+                    $value = $now . $value;
+                }
+            }
+            push( @args, $opthash->{$param}, $value );
+        }
+    }
+
+    my $params = $config_tree->getParam($view, 'rrd-params');
+    if( defined( $params ) )
+    {
+        push( @args, split('\s+', $params) );
+    }
+
+    my $scalingbase = $config_tree->getNodeParam($token, 'rrd-scaling-base');
+    if( defined($scalingbase) and $scalingbase == 1024 )
+    {
+        push( @args, '--base', '1024' );
+    }
+
+    return @args;
+}
+
+
+sub rrd_make_graph_opts
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+
+    my @args = ( '--imgformat', 'PNG' );
+
+    my $graph_log = $config_tree->getNodeParam($token, 'graph-logarithmic');
+    if( defined($graph_log) and $graph_log eq 'yes' )
+    {
+        push( @args, '--logarithmic' );
+    }
+
+    my $disable_title =
+        $config_tree->getParam($view, 'disable-title');
+    if( not defined( $disable_title ) or $disable_title ne 'yes' )
+    {
+        my $title = $config_tree->getNodeParam($token, 'graph-title');
+        if( not defined( $title ) or length( $title ) == 0 )
+        {
+            $title = ' ';
+        }
+        push( @args, '--title', $title );
+    }
+
+    my $disable_vlabel =
+        $config_tree->getParam($view, 'disable-vertical-label');
+    if( not defined( $disable_vlabel ) or $disable_vlabel ne 'yes' )
+    {
+        my $vertical_label =
+            $config_tree->getNodeParam($token, 'vertical-label');
+        if( defined( $vertical_label ) and length( $vertical_label ) > 0 )
+        {
+            push( @args, '--vertical-label', $vertical_label );
+        }
+    }
+
+    my $ignore_limits = $config_tree->getParam($view, 'ignore-limits');
+    if( not defined($ignore_limits) or $ignore_limits ne 'yes' )
+    {
+        my $ignore_lower = $config_tree->getParam($view, 'ignore-lower-limit');
+        if( not defined($ignore_lower) or $ignore_lower ne 'yes' )
+        {
+            my $limit =
+                $config_tree->getNodeParam($token, 'graph-lower-limit');
+            if( defined($limit) and length( $limit ) > 0 )
+            {
+                push( @args, '--lower-limit', $limit );
+            }
+        }
+
+        my $ignore_upper = $config_tree->getParam($view, 'ignore-upper-limit');
+        if( not defined($ignore_upper) or $ignore_upper ne 'yes' )
+        {
+            my $limit =
+                $config_tree->getNodeParam($token, 'graph-upper-limit');
+            if( defined($limit) and length( $limit ) > 0 )
+            {
+                push( @args, '--upper-limit', $limit );
+            }
+        }
+
+        my $rigid_boundaries =
+            $config_tree->getNodeParam($token, 'graph-rigid-boundaries');
+        if( defined($rigid_boundaries) and $rigid_boundaries eq 'yes' )
+        {
+            push( @args, '--rigid' );
+        }
+    }
+
+    if( scalar( @Torrus::Renderer::graphExtraArgs ) > 0 )
+    {
+        push( @args, @Torrus::Renderer::graphExtraArgs );
+    }
+
+    return @args;
+}
+
+
+sub rrd_make_def
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $dname = shift;
+    my $cf = shift;
+
+    my $datafile = $config_tree->getNodeParam($token, 'data-file');
+    my $dataddir = $config_tree->getNodeParam($token, 'data-dir');
+    my $rrdfile = $dataddir.'/'.$datafile;
+    if( not -r $rrdfile )
+    {
+        my $path = $config_tree->path($token);
+        Error("$path: No such file or directory: $rrdfile");
+        return undef;
+    }
+
+    my $ds = $config_tree->getNodeParam($token, 'rrd-ds');
+    if( not defined $cf )
+    {
+        $cf = $config_tree->getNodeParam($token, 'rrd-cf');
+    }
+    return sprintf( 'DEF:%s=%s:%s:%s',
+                    $dname, $rrdfile, $ds, $cf );
+}
+
+
+
+my %cfNames =
+    ( 'AVERAGE' => 1,
+      'MIN'     => 1,
+      'MAX'     => 1,
+      'LAST'    => 1 );
+
+# Moved the validation part to Torrus::ConfigTree::Validator
+sub rrd_make_cdef
+{
+    my $self  = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $dname = shift;
+    my $expr  = shift;
+
+    my @args = ();
+
+    # We will name the DEFs as $dname.sprintf('%.2d', $ds_couter++);
+    my $ds_couter = 1;
+
+    my $rpn = new Torrus::RPN;
+
+    # The callback for RPN translation
+    my $callback = sub
+    {
+        my ($noderef, $timeoffset) = @_;
+
+        my $function;
+        if( $noderef =~ s/^(.+)\@// )
+        {
+            $function = $1;
+        }
+
+        my $cf;
+        if( defined( $function ) and $cfNames{$function} )
+        {
+            $cf = $function;
+        }
+        
+        my $leaf = length($noderef) > 0 ?
+            $config_tree->getRelative($token, $noderef) : $token;
+
+        my $varname = $dname . sprintf('%.2d', $ds_couter++);
+        push( @args,
+              $self->rrd_make_def( $config_tree, $leaf, $varname, $cf ) );
+        return $varname;
+    };
+
+    $expr = $rpn->translate( $expr, $callback );
+    push( @args, sprintf( 'CDEF:%s=%s', $dname, $expr ) );
+    return @args;
+}
+
+
+sub rrd_if_gprint
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+
+    my $disable = $config_tree->getNodeParam($token, 'graph-disable-gprint');
+    if( defined( $disable ) and $disable eq 'yes' )
+    {
+        return 0;
+    }
+    return 1;
+}
+
+sub rrd_make_gprint
+{
+    my $self = shift;
+    my $vname = shift;
+    my $legend = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $obj = shift;
+
+    my @args = ();
+
+    my $gprintValues = $config_tree->getParam($view, 'gprint-values');
+    if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
+    {
+        foreach my $gprintVal ( split(',', $gprintValues ) )
+        {
+            my $format =
+                $config_tree->getParam($view, 'gprint-format-' . $gprintVal);
+            push( @args, 'GPRINT:' . $vname . ':' . $format );
+        }
+    }
+
+    push( @{$obj->{'args'}{'line'}}, @args );
+}
+            
+
+sub rrd_make_gprint_header
+{
+    my $self = shift;
+    my $config_tree = shift;
+    my $token = shift;
+    my $view = shift;
+    my $obj = shift;
+
+    my $gprintValues = $config_tree->getParam($view, 'gprint-values');
+    if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
+    {
+        my $gprintHeader = $config_tree->getParam($view, 'gprint-header');
+        if( defined( $gprintHeader ) and length( $gprintHeader ) > 0 )
+        {
+            push( @{$obj->{'args'}{'line'}},
+                  'COMMENT:' . $gprintHeader . '\l' );
+        }
+    }
+}
+       
+
+sub mkcolor
+{
+    my $self = shift;
+    my $color = shift;
+
+    my $recursionLimit = 100;
+
+    while( $color =~ /^\#\#(\S+)$/ )
+    {
+        if( $recursionLimit-- <= 0 )
+        {
+            Error('Color recursion is too deep');
+            $color = '#000000';
+        }
+        else
+        {
+            my $colorName = $1;
+            $color = $Torrus::Renderer::graphStyles{$colorName}{'color'};
+            if( not defined( $color ) )
+            {
+                Error('No color is defined for ' . $colorName);
+                $color = '#000000';
+            }
+        }
+    }
+    return $color;
+}
+
+sub mkline
+{
+    my $self = shift;
+    my $line = shift;
+
+    if( $line =~ /^\#\#(\S+)$/ )
+    {
+        my $lineName = $1;
+        $line = $Torrus::Renderer::graphStyles{$lineName}{'line'};
+        if( not defined( $line ) )
+        {
+            Error('No line style is defined for ' . $lineName);
+            $line = 'LINE1';
+        }
+    }
+    return $line;
+}
+
+
+sub tz_set
+{
+    my $self = shift;
+
+    if( defined $ENV{'TZ'} )
+    {
+        Debug("Previous TZ value: " . $ENV{'TZ'});
+        $self->{'tz_defined'} = 1;
+    }
+    else
+    {
+        $self->{'tz_defined'} = 0;
+    }
+
+    if( defined( my $newTZ = $self->{'options'}->{'variables'}->{'TZ'} ) )
+    {
+        Debug("Setting TZ to " . $newTZ);
+        $self->{'tz_old'} = $ENV{'TZ'};
+        $ENV{'TZ'} = $newTZ;
+        $self->{'tz_changed'} = 1;
+    }
+    else
+    {
+        $self->{'tz_changed'} = 0;
+    }
+}
+
+sub tz_restore
+{
+    my $self = shift;
+
+    if( $self->{'tz_changed'} )
+    {
+        if( $self->{'tz_defined'} )
+        {
+            Debug("Restoring TZ back to " . $self->{'tz_old'});
+            $ENV{'TZ'} = $self->{'tz_old'};
+        }
+        else
+        {
+            Debug("Restoring TZ back to undefined");
+            delete $ENV{'TZ'};
+        }
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ReportGenerator.pm b/torrus/perllib/Torrus/ReportGenerator.pm
new file mode 100644
index 000000000..1a4dec3be
--- /dev/null
+++ b/torrus/perllib/Torrus/ReportGenerator.pm
@@ -0,0 +1,141 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ReportGenerator.pm,v 1.1 2010-12-27 00:03:37 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Package for reports generation
+# Classes should inherit Torrus::ReportGenerator
+
+package Torrus::ReportGenerator;
+
+use strict;
+use Date::Parse;
+
+use Torrus::Log;
+use Torrus::SQL::Reports;
+use Torrus::SQL::SrvExport;
+
+sub new
+{
+    my $class = shift;
+    my $options = shift;
+
+    if( not ref( $options ) or
+        not defined( $options->{'Date'} ) or
+        not defined( $options->{'Time'} ) or
+        not defined( $options->{'Name'} ) )
+    {
+        Error('Missing options in Torrus::Report constructor');
+        return undef;
+    }
+    
+    my $self = {};
+    bless ($self, $class);
+
+    # For monthly reports, adjust date and time for the first day of the month
+    if( $self->isMonthly() )
+    {
+        $options->{'Time'} = '00:00';
+        my ($ss,$mm,$hh,$day,$month,$year,$zone) =
+            strptime( $options->{'Date'} );
+        $year += 1900;
+        $month++;
+        $self->{'StartDate'} = sprintf('%.4d-%.2d-01', $year, $month);
+        $options->{'Date'} = $self->{'StartDate'};
+        $self->{'StartUnixTime'} = str2time( $self->{'StartDate'} );
+        $self->{'Year'} = $year;
+        $self->{'Month'} = $month;
+
+        # Count the number of seconds in the month and define the end date
+        my $endyear = $year;
+        my $endmonth = $month + 1;
+
+        if( $endmonth > 12 )
+        {
+            $endmonth = 1;
+            $endyear++;
+        }
+
+        my $enddate = sprintf('%.4d-%.2d-01', $endyear, $endmonth);
+        $self->{'EndDate'} = $enddate;
+        $self->{'EndUnixTime'} = str2time( $self->{'EndDate'} );
+        
+        $self->{'RangeSeconds'} =
+            $self->{'EndUnixTime'} - $self->{'StartUnixTime'};
+    }
+
+    if( $self->usesSrvExport() )
+    {
+        my $srvExp =
+            Torrus::SQL::SrvExport->new( $options->{'SrvExportSqlSubtype'} );
+        if( not defined( $srvExp ) )
+        {
+            Error('Cannot connect to the database');
+            return undef;
+        }
+        $self->{'srvexport'} = $srvExp;
+    }
+    
+    $self->{'options'} = $options;
+
+    my $sqlRep = Torrus::SQL::Reports->new( $options->{'ReportsSqlSubtype'} );
+    if( not defined( $sqlRep ) )
+    {
+        Error('Cannot connect to the database');
+        return undef;
+    }
+    $self->{'backend'} = $sqlRep;
+    
+    my $reportId = $sqlRep->reportId( $options->{'Date'},
+                                      $options->{'Time'},
+                                      $options->{'Name'} );
+    $self->{'reportId'} = $reportId;
+    
+    if( $sqlRep->isComplete( $reportId ) )
+    {
+        Error('Report already exists');
+        return undef;
+    }
+    
+    return $self;    
+}
+
+
+sub generate
+{
+    die('Virtual method called');    
+}
+
+
+sub isMonthly
+{
+    return 0;
+}
+
+sub usesSrvExport
+{
+    return 0;
+}
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ReportGenerator/MonthlySrvUsage.pm b/torrus/perllib/Torrus/ReportGenerator/MonthlySrvUsage.pm
new file mode 100644
index 000000000..481f8ad9a
--- /dev/null
+++ b/torrus/perllib/Torrus/ReportGenerator/MonthlySrvUsage.pm
@@ -0,0 +1,221 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: MonthlySrvUsage.pm,v 1.1 2010-12-27 00:03:58 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# For all service IDs available, build monthly usage figures:
+# Average, Maximum, and Percentile (default 95th percentile)
+# 
+
+package Torrus::ReportGenerator::MonthlySrvUsage;
+
+use strict;
+use POSIX qw(floor);
+use Date::Parse;
+use Math::BigFloat;
+
+use Torrus::Log;
+use Torrus::ReportGenerator;
+use Torrus::ServiceID;
+
+use base 'Torrus::ReportGenerator';
+
+sub isMonthly
+{
+    return 1;
+}
+
+sub usesSrvExport
+{
+    return 1;
+}
+
+
+sub generate
+{
+    my $self = shift;
+
+    my $percentile = $self->{'options'}->{'Percentile'};
+    if( not defined( $percentile ) )
+    {
+        $percentile = 95;
+    }
+
+    my $step = $self->{'options'}->{'Step'};
+    if( not defined( $step ) )
+    {
+        $step = 300;
+    }
+
+    my $srvIDParams = new Torrus::ServiceID();
+    
+    my $srvIDs = $self->{'srvexport'}->getServiceIDs();
+    foreach my $serviceid ( @{$srvIDs} )
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        my $data = $self->{'srvexport'}->getIntervalData
+            ( $self->{'StartDate'}, $self->{'EndDate'}, $serviceid );
+
+        &Torrus::DB::checkInterrupted();
+
+        next if scalar( @{$data} ) == 0;
+        Debug('MonthlySrvUsage: Generating report for ' . $serviceid);
+
+        my $params = $srvIDParams->getParams( $serviceid );
+        
+        my @aligned = ();
+        $#aligned = floor( $self->{'RangeSeconds'} / $step );
+        my $nDatapoints = scalar( @aligned );
+            
+        # Fill in the aligned array. For each interval by modulo(step),
+        # we take the maximum value from the available data
+
+        my $maxVal = 0;
+        
+        foreach my $row ( @{$data} )
+        {
+            my $rowtime = str2time( $row->{'srv_date'} . 'T' .
+                                    $row->{'srv_time'} );
+            my $pos = floor( ($rowtime - $self->{'StartUnixTime'}) / $step );
+            my $value = Math::BigFloat->new( $row->{'value'} );
+            if( $value->is_nan() )
+            {
+                $value->bzero();
+                $row->{'value'} = 0;
+            }
+            
+            if( ( not defined( $aligned[$pos] ) ) or
+                $aligned[$pos] < $value )
+            {
+                $aligned[$pos] = $value;
+                if( $value > $maxVal )
+                {
+                    $maxVal = $value;
+                }
+            }
+        }
+
+        &Torrus::DB::checkInterrupted();
+
+        # Set undefined values to zero and calculate the average
+
+        my $sum = Math::BigFloat->new(0);
+        my $unavailCount = 0;
+        foreach my $pos ( 0 .. $#aligned )
+        {
+            if( not defined( $aligned[$pos] ) )
+            {
+                $aligned[$pos] = 0;
+                $unavailCount++;
+            }
+            else
+            {
+                $sum += $aligned[$pos];
+            }
+        }
+
+        &Torrus::DB::checkInterrupted();
+
+        my $avgVal = $sum / $nDatapoints;
+
+        # Calculate the percentile
+
+        my @sorted = sort {$a <=> $b} @aligned;
+        my $pcPos = floor( $nDatapoints * $percentile / 100 );
+        my $pcVal = $sorted[$pcPos];
+
+        # Calculate the total volume if it's a counter
+        my $volume = Math::BigFloat->new(0);
+        my $volumeDefined = 0;
+        if( not defined( $params->{'dstype'} ) or
+            $params->{'dstype'} =~ /^COUNTER/o )
+        {
+            $volumeDefined = 1;
+            foreach my $row ( @{$data} )
+            {
+                $volume += $row->{'value'} * $row->{'intvl'};
+            }
+        }
+
+        # Adjust units and scale
+
+        my $usageUnits = '';
+        my $volumeUnits = '';
+        if( not defined( $params->{'units'} ) or
+            $params->{'units'} eq 'bytes' )
+        {
+            # Adjust bytes into megabit per second
+            $usageUnits = 'Mbps';
+            $maxVal *= 8e-6;
+            $avgVal *= 8e-6;
+            $pcVal  *= 8e-6;
+
+            # Adjust volume bytes into megabytes
+            $volumeUnits = 'GB';
+            $volume /= 1073741824;
+        }
+        
+        $self->{'backend'}->addField( $self->{'reportId'}, {
+            'name'      => 'MAX',
+            'serviceid' => $serviceid,
+            'value'     => $maxVal,
+            'units'     => $usageUnits });
+        
+        $self->{'backend'}->addField( $self->{'reportId'}, {
+            'name'      => 'AVG',
+            'serviceid' => $serviceid,
+            'value'     => $avgVal,
+            'units'     => $usageUnits });
+                                      
+        $self->{'backend'}->addField( $self->{'reportId'}, {
+            'name'      => sprintf('%s%s', $percentile, 'TH_PERCENTILE'),
+            'serviceid' => $serviceid,
+            'value'     => $pcVal,
+            'units'     => $usageUnits });
+        
+        $self->{'backend'}->addField( $self->{'reportId'}, {
+            'name'      => 'UNAVAIL',
+            'serviceid' => $serviceid,
+            'value'     => ($unavailCount*100)/$nDatapoints,
+            'units'     => '%' });
+
+        if( $volumeDefined )
+        {
+            $self->{'backend'}->addField( $self->{'reportId'}, {
+                'name'      => 'VOLUME',
+                'serviceid' => $serviceid,
+                'value'     => $volume,
+                'units'     => $volumeUnits });
+        }
+    }
+
+    &Torrus::DB::checkInterrupted();
+
+    $self->{'backend'}->finalize( $self->{'reportId'} );
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ReportOutput.pm b/torrus/perllib/Torrus/ReportOutput.pm
new file mode 100644
index 000000000..b4a4c57ab
--- /dev/null
+++ b/torrus/perllib/Torrus/ReportOutput.pm
@@ -0,0 +1,210 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ReportOutput.pm,v 1.1 2010-12-27 00:03:40 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Package for generating report output to HTML, PDF, whatever
+# Media-specific classes should inherit from this package
+# and 
+
+package Torrus::ReportOutput;
+
+use strict;
+
+use Torrus::Log;
+use Torrus::SQL::Reports;
+use Torrus::ServiceID;
+
+
+sub new
+{
+    my $class = shift;
+    my $options = shift;
+    
+    my $self = {};
+    bless ($self, $class);
+    
+    $self->{'options'} = $options;    
+    defined( $self->{'options'}->{'Tree'} ) or die;
+    
+    my $sqlRep = Torrus::SQL::Reports->new( $options->{'ReportsSqlSubtype'} );
+    if( not defined( $sqlRep ) )
+    {
+        Error('Cannot connect to the database');
+        return undef;
+    }
+    $self->{'backend'} = $sqlRep;
+
+    my $outdir = $Torrus::Global::reportsDir . '/' .
+        $self->{'options'}->{'Tree'};
+    $self->{'outdir'} = $outdir;
+
+    if( not -d $outdir )
+    {
+        if( not mkdir( $outdir ) )
+        {
+            Error('Cannot create directory ' . $outdir . ': ' . $!);
+            return undef;
+        }
+    }
+
+    return $self;    
+}
+
+# initialize the subclasses' internals
+sub init
+{
+    my $self = shift;
+    
+    return 1;
+}
+
+
+sub generate
+{
+    my $self = shift;
+
+    my $ok = 1;
+    
+    my %monthlyReportNames;
+
+    my $srvIdList;
+    if( not $self->{'options'}->{'All_Service_IDs'} )
+    {
+        my $srvId = new Torrus::ServiceID;
+        $srvIdList = $srvId->getAllForTree( $self->{'options'}->{'Tree'} );
+    }
+    
+    my $allReports = $self->{'backend'}->getAllReports( $srvIdList );
+
+    # frontpage, title, list of years, etc.
+    $self->genIntroduction( $allReports );
+
+    while( my( $year, $yearRef ) = each %{$allReports} )
+    {
+        my $monthlyReportFields = {};
+        my $srvidMonthlyFields = {};
+        
+        while( my( $month, $monthRef ) = each %{$yearRef} )
+        {
+            my $dailyReportFields = {};
+            
+            while( my( $day, $dayRef ) = each %{$monthRef} )
+            {
+                while( my( $reportName, $fieldsRef ) = each %{$dayRef} )
+                {
+                    # Check if the report is monthly
+                    if( not defined( $monthlyReportNames{$reportName} ) )
+                    {
+                        my $class =
+                            $Torrus::ReportGenerator::modules{$reportName};
+                        eval( 'require ' . $class );
+                        die( $@ ) if $@;
+
+                        $monthlyReportNames{$reportName} =
+                            $class->isMonthly() ? 1:0;
+                    }
+
+                    # This report is monthly -- do not include it in daily
+                    # list.
+                    if( $monthlyReportNames{$reportName} )
+                    {
+                        $monthlyReportFields->{$month}{$reportName} =
+                            $fieldsRef;
+                        while( my( $serviceid, $fref ) = each %{$fieldsRef} )
+                        {
+                            $srvidMonthlyFields->{$serviceid}{$reportName}->{
+                                $month} = $fref;
+                        }
+                    }
+                    else
+                    {
+                        $dailyReportFields->{$day} = $dayRef;
+                    }
+                }
+            }
+
+            $ok = $self->genDailyOutput( $year, $month, $dailyReportFields )?
+                $ok:0;
+        }
+
+        $ok = $self->genSrvIdOutput( $year, $srvidMonthlyFields ) ? $ok:0;
+        $ok = $self->genMonthlyOutput( $year, $monthlyReportFields ) ? $ok:0;;
+    }
+
+    return $ok;
+}
+
+
+# Print the head page and years reference
+sub genIntroduction
+{
+    my $self = shift;
+    my $allReports = shift;
+
+    return 1;
+}
+
+
+# Print monthly report for a given service ID
+# The fields argument is a hash of hashes:
+# serviceid => reportname => month => fieldname => {value, units}
+sub genSrvIdOutput
+{
+    my $self = shift;
+    my $year = shift;    
+    my $fields = shift;
+
+    return 1;
+}
+    
+# Print daily report
+# Fields structure:
+# day => reportname => serviceid => fieldname => {value, units}
+sub genDailyOutput
+{
+    my $self = shift;
+    my $year = shift;    
+    my $month = shift;    
+    my $fields = shift;
+
+    return 1;
+}
+
+# Print monthly report
+# fields:
+# month => reportname => serviceid => fieldname => {value, units}
+sub genMonthlyOutput
+{
+    my $self = shift;
+    my $year = shift;    
+    my $fields = shift;
+
+    return 1;
+}    
+    
+        
+    
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ReportOutput/HTML.pm b/torrus/perllib/Torrus/ReportOutput/HTML.pm
new file mode 100644
index 000000000..40348a664
--- /dev/null
+++ b/torrus/perllib/Torrus/ReportOutput/HTML.pm
@@ -0,0 +1,296 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: HTML.pm,v 1.1 2010-12-27 00:03:46 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::ReportOutput::HTML;
+
+use strict;
+use Template;
+use Date::Format;
+
+use Torrus::Log;
+use Torrus::ReportOutput;
+use Torrus::SiteConfig;
+
+use base 'Torrus::ReportOutput';
+
+our @monthNames = qw
+    (January February March April May June
+     July August September October November December);
+
+sub init
+{
+    my $self = shift;
+
+    Torrus::SiteConfig::loadStyling();
+    
+    my $htmldir = $self->{'outdir'} . '/html';
+    if( not -d $htmldir )
+    {
+        Verbose('Creating directory: ' . $htmldir);
+        if( not mkdir( $htmldir ) )
+        {
+            Error('Cannot create directory ' . $htmldir . ': ' . $!);
+            return 0;
+        }
+    }
+    $self->{'htmldir'} = $htmldir;
+    
+    $self->{'tt'} =
+        new Template(INCLUDE_PATH => $Torrus::Global::templateDirs,
+                     TRIM => 1);
+    return 1;
+}
+
+
+# Print the head page and years reference
+sub genIntroduction
+{
+    my $self = shift;
+    my $allReports = shift;
+
+    return $self->render({
+        'filename' => $self->indexFilename(),
+        'template' => 'index',
+        'data' => $allReports });    
+}
+
+
+# Print monthly report for a given service ID
+# The fields argument is a hash of hashes:
+# serviceid => reportname => month => fieldname => {value, units}
+sub genSrvIdOutput
+{
+    my $self = shift;
+    my $year = shift;    
+    my $fields = shift;
+
+    my $ok = 1;
+    while( my( $serviceid, $ref ) = each %{$fields} )
+    {
+        $ok = $self->render({
+            'filename' => $self->srvIdFilename($year, $serviceid),
+            'template' => 'serviceid',
+            'data' => $ref,
+            'serviceid' => $serviceid,
+            'year' => $year }) ? $ok:0; 
+    }
+    return $ok;
+}
+
+
+# Print daily report -- NOT IMPLEMENTED YET
+# Fields structure:
+# day => reportname => serviceid => fieldname => {value, units}
+sub genDailyOutput
+{
+    my $self = shift;
+    my $year = shift;    
+    my $month = shift;    
+    my $fields = shift;
+
+    return 1;
+}
+
+
+# Print monthly report
+# fields:
+# month => reportname => serviceid => fieldname => {value, units}
+sub genMonthlyOutput
+{
+    my $self = shift;
+    my $year = shift;    
+    my $fields = shift;
+
+    my $ok = 1;
+    my @months;
+    while( my( $month, $ref ) = each %{$fields} )
+    {
+        if( $self->render({
+            'filename' => $self->monthlyFilename($year, $month),
+            'template' => 'monthly',
+            'data'     => $ref,
+            'year'     => $year,
+            'month'    => $month }) )
+        {
+            push( @months, $month );
+        }
+        else
+        {
+            $ok = 0;
+        }
+    }
+
+    my @sorted = sort {$a <=>$b} @months;
+    $ok = $self->render({
+        'filename' => $self->yearlyFilename($year),
+        'template' => 'yearly',
+        'data'     => {'months' => \@sorted},
+        'year'     => $year }) ? $ok:0;
+    return $ok;
+}
+    
+
+sub indexFilename
+{
+    return 'index.html';
+}
+
+
+sub srvIdFilename
+{
+    my $self = shift;
+    my $year = shift;
+    my $serviceid = shift;
+
+    return sprintf('%.4d_serviceid_%s.html', $year, $serviceid);
+}
+
+sub monthlyFilename
+{
+    my $self = shift;
+    my $year = shift;
+    my $month = shift;
+
+    return sprintf('%.4d_monthly_%.2d.html', $year, $month);
+}
+
+sub yearlyFilename
+{
+    my $self = shift;
+    my $year = shift;
+
+    return sprintf('%.4d_yearly.html', $year);
+}
+    
+    
+
+sub render
+{
+    my $self = shift;
+    my $opt = shift;
+
+    my $outfile = $self->{'htmldir'} . '/' . $opt->{'filename'};
+    my $tmplfile = $Torrus::ReportOutput::HTML::templates{$opt->{'template'}};
+    Debug('Rendering ' . $outfile . ' from ' . $tmplfile);
+    
+    my $ttvars =
+    {
+        'plainURL'   => $Torrus::Renderer::plainURL,
+        'style'      => sub { return $self->style($_[0]); },
+        'treeName'   => $self->{'options'}->{'Tree'},
+        'companyName'=> $Torrus::Renderer::companyName,
+        'companyURL' => $Torrus::Renderer::companyURL,
+        'siteInfo'   => $Torrus::Renderer::siteInfo,
+        'version'    => $Torrus::Global::version,
+        'xmlnorm'    => \&xmlnormalize,
+        'data'       => $opt->{'data'},
+        'year'       => $opt->{'year'},
+        'month'      => $opt->{'month'},
+        'serviceid'  => $opt->{'serviceid'},
+        'indexUrl'   => sub {
+            return $self->reportUrl($self->indexFilename());},
+        'srvIdUrl'   => sub {
+            return $self->reportUrl($self->srvIdFilename($opt->{'year'},
+                                                         $_[0]));},
+        'monthlyUrl' => sub {
+            return $self->reportUrl($self->monthlyFilename($opt->{'year'},
+                                                           $_[0]));},
+        'yearlyUrl' => sub {
+            return $self->reportUrl($self->yearlyFilename($_[0]));},
+        'monthName' => sub {$self->monthName($_[0]);},
+        'formatValue' => sub {
+            if( ref($_[0]))
+            {
+                return sprintf('%.2f %s', $_[0]->{'value'}, $_[0]->{'units'});
+            }
+            else
+            {
+                return 'N/A';
+            }},
+        'timestamp'  => sub { return time2str($Torrus::Renderer::timeFormat,
+                                              time()); },
+    };
+    
+    my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile );
+
+    if( not $result )
+    {
+        Error("Error while rendering " . $outfile . ": " .
+              $self->{'tt'}->error());
+        return 0;
+    }
+    return 1;
+}
+
+
+sub style
+{
+    my $self = shift;
+    my $object = shift;
+
+    my $ret = $Torrus::Renderer::styling{'report'}{$object};
+    if( not defined( $ret ) )
+    {
+        $ret = $Torrus::Renderer::styling{'default'}{$object};
+    }
+
+    return $ret;
+}
+
+sub monthName
+{
+    my $self = shift;
+    my $month = shift;
+
+    return $monthNames[ $month - 1 ];
+}
+
+
+sub reportUrl
+{
+    my $self = shift;
+    my $filename = shift;
+
+    return $Torrus::Renderer::rendererURL . '/' .
+        $self->{'options'}->{'Tree'} . '?htmlreport=' . $filename;
+}
+
+sub xmlnormalize
+{
+    my( $txt )= @_;
+
+    $txt =~ s/\&/\&amp\;/gm;
+    $txt =~ s/\</\&lt\;/gm;
+    $txt =~ s/\>/\&gt\;/gm;
+    $txt =~ s/\'/\&apos\;/gm;
+    $txt =~ s/\"/\&quot\;/gm;
+
+    return $txt;
+}
+
+    
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/SNMP_Failures.pm b/torrus/perllib/Torrus/SNMP_Failures.pm
new file mode 100644
index 000000000..4203dc166
--- /dev/null
+++ b/torrus/perllib/Torrus/SNMP_Failures.pm
@@ -0,0 +1,205 @@
+#  Copyright (C) 2010  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: SNMP_Failures.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+# SNMP failures statistics interface
+
+package Torrus::SNMP_Failures;
+
+use Torrus::DB;
+use Torrus::Log;
+use strict;
+
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    %{$self->{'options'}} = %options;
+
+    die() if ( not defined($options{'-Tree'}) or
+               not defined($options{'-Instance'}) );
+
+    $self->{'db_failures'} =
+        new Torrus::DB( 'snmp_failures_' . $options{'-Instance'},
+                        -Subdir => $self->{'options'}{'-Tree'},
+                        -Btree => 1,
+                        -WriteAccess => $options{'-WriteAccess'} );
+
+    $self->{'counters'} = ['unreachable', 'deleted', 'mib_errors'];
+    
+    return( defined( $self->{'db_failures'} ) ? $self:undef );
+}
+
+
+sub DESTROY
+{
+    my $self = shift;    
+    $self->{'db_failures'}->closeNow();
+}
+
+
+
+sub init
+{
+    my $self = shift;
+
+    $self->{'db_failures'}->trunc();
+    
+    foreach my $c ( @{$self->{'counters'}} )
+    {
+        $self->{'db_failures'}->put('c:' . $c, 0);
+    }
+}
+
+
+
+sub host_failure
+{
+    my $self = shift;    
+    my $type = shift;
+    my $hosthash = shift;
+
+    $self->{'db_failures'}->put('h:' . $hosthash,
+                                $type . ':' . time());
+}
+
+
+sub set_counter
+{
+    my $self = shift;    
+    my $type = shift;
+    my $count = shift;
+
+    $self->{'db_failures'}->put('c:' . $type, $count);
+}
+    
+
+sub remove_host
+{
+    my $self = shift;    
+    my $hosthash = shift;
+
+    $self->{'db_failures'}->del('h:' . $hosthash);
+}
+
+    
+sub mib_error
+{
+    my $self = shift;    
+    my $hosthash = shift;
+    my $path = shift;
+
+    my $count = $self->{'db_failures'}->get('M:' . $hosthash);
+    $count = 0 unless defined($count);
+
+    $self->{'db_failures'}->put('m:' . $hosthash, $path . ':' . time());    
+    $self->{'db_failures'}->put('M:' . $hosthash, $count + 1);
+
+    my $global_count = $self->{'db_failures'}->get('c:mib_errors');
+    $self->{'db_failures'}->put('c:mib_errors', $global_count + 1);
+}
+
+
+
+sub read
+{
+    my $self = shift;
+    my $out = shift;
+    my %options = @_;
+
+    foreach my $c ( @{$self->{'counters'}} )
+    {
+        if( not defined( $out->{'total_' . $c} ) )
+        {
+            $out->{'total_' . $c} = 0;
+        }
+        
+        $out->{'total_' . $c} += 
+            $self->{'db_failures'}->get('c:' . $c);
+
+        if( $options{'-details'} and
+            not defined( $out->{'detail_' . $c} ) )
+        {
+            $out->{'detail_' . $c} = {};
+        }
+    }
+
+    &Torrus::DB::checkInterrupted();
+        
+    if( $options{'-details'} )
+    {
+        my $cursor = $self->{'db_failures'}->cursor();
+        while( my ($key, $val) = $self->{'db_failures'}->next($cursor) )
+        {
+            if( $key =~ /^h:(.+)$/o )
+            {
+                my $hosthash = $1;
+                my ($counter, $timestamp) = split(/:/o, $val);
+
+                $out->{'detail_' . $counter}{$hosthash} = {
+                    'timestamp' => 0 + $timestamp,
+                    'time' => scalar(localtime( $timestamp )),
+                };
+            }
+            elsif( $key =~ /^m:(.+)$/o )
+            {
+                my $hosthash = $1;
+                my ($path, $timestamp) = split(/:/o, $val);
+
+                $out->{'detail_mib_errors'}{$hosthash}{'nodes'}{$path} = {
+                    'timestamp' => 0 + $timestamp,
+                    'time' => scalar(localtime( $timestamp )),
+                }
+            }
+            elsif( $key =~ /^M:(.+)$/o )
+            {
+                my $hosthash = $1;
+                my $count = 0 + $val;
+                
+                if( not defined
+                    ( $out->{'detail_mib_errors'}{$hosthash}{'count'}) )
+                {
+                    $out->{'detail_mib_errors'}{$hosthash}{'count'} = 0;
+                }
+                
+                $out->{'detail_mib_errors'}{$hosthash}{'count'} += $count;
+            }
+            
+            &Torrus::DB::checkInterrupted();
+        }
+        
+        undef $cursor;
+    }
+}
+
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/SQL.pm b/torrus/perllib/Torrus/SQL.pm
new file mode 100644
index 000000000..de54cacee
--- /dev/null
+++ b/torrus/perllib/Torrus/SQL.pm
@@ -0,0 +1,234 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: SQL.pm,v 1.1 2010-12-27 00:03:38 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Package for RDBMS communication management in Torrus
+# Classes should inherit Torrus::SQL and execute Torrus::SQL->new(),
+# and then use methods of DBIx::Abstract.
+
+package Torrus::SQL;
+
+use strict;
+use DBI;
+use DBIx::Abstract;
+use DBIx::Sequence;
+
+use Torrus::Log;
+
+my %connectionArgsCache;
+
+# Obtain connection attributes for particular class and object subtype.
+# The attributes are defined in torrus-siteconfig.pl, in a hash
+# %Torrus::SQL::connections.
+# For a given Perl class and an optional subtype,
+# the connection attributes are derived in the following order:
+# 'Default', 'Default/[subtype]', '[Class]', '[Class]/[subtype]',
+# 'All/[subtype]'.
+# For a simple setup, the default attributes are usually defined for
+# 'Default' key.
+# The key attributes are: 'dsn', 'username', and 'password'.
+# Returns a hash reference with the same keys.
+
+sub getConnectionArgs
+{
+    my $class = shift;
+    my $objClass = shift;
+    my $subtype = shift;
+
+    my $cachekey = $objClass . ( defined( $subtype )? '/'.$subtype : '');
+    if( defined( $connectionArgsCache{$cachekey} ) )
+    {
+        return $connectionArgsCache{$cachekey};
+    }
+    
+    my @lookup = ('Default');
+    if( defined( $subtype ) )
+    {
+        push( @lookup, 'Default/' . $subtype );
+    }
+    push( @lookup, $objClass );
+    if( defined( $subtype ) )
+    {
+        push( @lookup, $objClass . '/' . $subtype, 'All/' . $subtype );
+    }    
+
+    my $ret = {};
+    foreach my $attr ( 'dsn', 'username', 'password' )
+    {
+        my $val;
+        foreach my $key ( @lookup )
+        {
+            if( defined( $Torrus::SQL::connections{$key} ) )
+            {
+                if( defined( $Torrus::SQL::connections{$key}{$attr} ) )
+                {
+                    $val = $Torrus::SQL::connections{$key}{$attr};
+                }
+            }
+        }
+        if( not defined( $val ) )
+        {
+            die('Undefined attribute in %Torrus::SQL::connections: ' . $attr);
+        }
+        $ret->{$attr} = $val;
+    }
+
+    $connectionArgsCache{$cachekey} = $ret;
+    
+    return $ret;
+}
+
+
+my %dbhPool;
+
+# For those who want direct DBI manipulation, simply call
+# Class->dbh($subtype) with optional subtype. Then you don't use
+# any other methods of Torrus::SQL.
+
+sub dbh
+{
+    my $class = shift;
+    my $subtype = shift;
+
+    my $attrs = Torrus::SQL->getConnectionArgs( $class, $subtype );
+
+    my $poolkey = $attrs->{'dsn'} . '//' . $attrs->{'username'} . '//' .
+        $attrs->{'password'};
+
+    my $dbh;
+    
+    if( exists( $dbhPool{$poolkey} ) )
+    {
+        $dbh = $dbhPool{$poolkey};
+        if( not $dbh->ping() )
+        {
+            $dbh = undef;
+            delete $dbhPool{$poolkey};
+        }
+    }
+
+    if( not defined( $dbh ) )
+    {
+        $dbh = DBI->connect( $attrs->{'dsn'},
+                             $attrs->{'username'},
+                             $attrs->{'password'},
+                             { 'PrintError' => 0,
+                               'AutoCommit' => 0 } );
+
+        if( not defined( $dbh ) )
+        {
+            Error('Error connecting to DBI source ' . $attrs->{'dsn'} . ': ' .
+                  $DBI::errstr);
+        }
+        else
+        {
+            $dbhPool{$poolkey} = $dbh;
+        }
+    }
+    
+    return $dbh;
+}
+
+
+END
+{
+    foreach my $dbh ( values %dbhPool )
+    {
+        $dbh->disconnect();
+    }
+}
+
+
+sub new
+{
+    my $class = shift;
+    my $subtype = shift;
+
+    my $self = {};
+
+    $self->{'dbh'} = $class->dbh( $subtype );
+    if( not defined( $self->{'dbh'} ) )
+    {
+        return undef;
+    }
+    
+    $self->{'sql'} = DBIx::Abstract->connect( $self->{'dbh'} );
+
+    $self->{'subtype'} = $subtype;
+    $self->{'classname'} = $class;
+    
+    bless ($self, $class);
+    return $self;    
+}
+
+
+
+sub sequence
+{
+    my $self = shift;
+
+    if( not defined( $self->{'sequence'} ) )
+    {
+        my $attrs = Torrus::SQL->getConnectionArgs( $self->{'classname'},
+                                                    $self->{'subtype'} );
+
+        $self->{'sequence'} = DBIx::Sequence->new({
+            dbh => $self->{'dbh'},
+            allow_id_reuse => 1 });
+    }
+    return $self->{'sequence'};
+}
+       
+
+sub sequenceNext
+{
+    my $self = shift;
+
+    return $self->sequence()->Next($self->{'classname'});
+}
+
+
+sub fetchall
+{
+    my $self = shift;
+    my $columns = shift;
+    
+    my $ret = [];
+    while( defined( my $row = $self->{'sql'}->fetchrow_arrayref() ) )
+    {
+        my $retrecord = {};
+        my $i = 0;
+        foreach my $col ( @{$columns} )
+        {
+            $retrecord->{$col} = $row->[$i++];
+        }
+        push( @{$ret}, $retrecord );
+    }
+    
+    return $ret;
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/SQL/Reports.pm b/torrus/perllib/Torrus/SQL/Reports.pm
new file mode 100644
index 000000000..5a90b7e42
--- /dev/null
+++ b/torrus/perllib/Torrus/SQL/Reports.pm
@@ -0,0 +1,291 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Reports.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Class for Reporter data manipulation
+package Torrus::SQL::ReportFields;
+
+package Torrus::SQL::Reports;
+
+use strict;
+
+use Torrus::SQL;
+use base 'Torrus::SQL';
+
+use Torrus::Log;
+# use Torrus::SQL::ReportFields;
+
+# The name of the table and columns 
+# defaults configured in torrus-config.pl
+our $tableName;
+our %columns;
+
+
+sub new
+{
+    my $class = shift;
+    my $subtype = shift;
+
+    my $self  = $class->SUPER::new( $subtype );
+
+    $self->{'fields'} = Torrus::SQL::ReportFields->new( $subtype );
+    
+    bless ($self, $class);
+    return $self;
+}
+    
+
+# Find or create a new row in reports table
+# 
+sub reportId
+{
+    my $self = shift;
+    my $repdate = shift;
+    my $reptime = shift;
+    my $repname = shift;
+
+    my $result = $self->{'sql'}->select_one_to_arrayref({
+        'fields' => [ $columns{'id'}, $columns{'iscomplete'} ],
+        'table' => $tableName,
+        'where' => { $columns{'rep_date'}   => $repdate,
+                     $columns{'rep_time'}   => $reptime,
+                     $columns{'reportname'} => $repname } });
+    
+    if( defined( $result ) )
+    {
+        if( not $result->[1] ) 
+        {
+            # iscomplete is zero - the report is unfinished
+            Warn('Found unfinished report ' . $repname . ' for ' .
+                 $repdate . ' ' . $reptime .
+                 '. Deleting the previous report data');
+            $self->{'fields'}->removeAll( $result->[0] );
+        }
+            
+        return $result->[0];
+    }
+    else
+    {
+        my $id = $self->sequenceNext();
+
+        $self->{'sql'}->insert({
+            'table' => $tableName,
+            'fields' => { $columns{'id'} => $id,
+                          $columns{'rep_date'}   => $repdate,
+                          $columns{'rep_time'}   => $reptime,
+                          $columns{'reportname'} => $repname,
+                          $columns{'iscomplete'} => 0 } });
+        
+        return $id;
+    }
+}
+
+
+
+# Add a new field to a report. The field is a hash array reference
+# with keys: 'name', 'serviceid', 'value', 'units'
+
+sub addField
+{
+    my $self = shift;
+    my $reportId = shift;
+    my $field = shift;
+
+    if( isDebug() )
+    {
+        Debug('Adding report field: ' . $field->{'name'} .
+              ':' . $field->{'serviceid'} . ' = ' . $field->{'value'} .
+              ' ' . $field->{'units'});
+    }
+    $self->{'fields'}->add( $reportId, $field );
+}
+
+
+sub getFields
+{
+    my $self = shift;
+    my $reportId = shift;
+
+    return $self->{'fields'}->getAll( $reportId );
+}
+
+
+sub isComplete
+{
+    my $self = shift;
+    my $reportId = shift;
+    
+    my $result = $self->{'sql'}->select_one_to_arrayref({
+        'fields' => [ $columns{'iscomplete'} ],
+        'table' => $tableName,
+        'where' => { $columns{'id'}   => $reportId } });
+    
+    if( defined( $result ) )
+    {
+        return $result->[0];
+    }
+    else
+    {
+        Error('Cannot find the report record for ID=' . $reportId);
+    }
+
+    return 0;
+}
+
+
+sub finalize
+{
+    my $self = shift;
+    my $reportId = shift;
+
+    $self->{'sql'}->update({
+        'table' => $tableName,
+        'where' => { $columns{'id'}   => $reportId },
+        'fields' => { $columns{'iscomplete'} => 1 } });
+
+    $self->{'sql'}->commit();
+}
+
+
+sub getAllReports
+{
+    my $self = shift;
+    my $srvIdList = shift;
+    my $limitDate = shift;
+
+    my $where = { $columns{'iscomplete'} => 1 };
+    
+    if( defined( $limitDate ) )
+    {
+        $where->{$columns{'rep_date'}} = ['>=', $limitDate];
+    }
+    
+    $self->{'sql'}->select({
+        'table' => $tableName,
+        'where' => $where,
+        'fields' => [ $columns{'id'},
+                      $columns{'rep_date'},
+                      $columns{'rep_time'},
+                      $columns{'reportname'} ] });
+    
+    my $reports =
+        $self->fetchall([ 'id', 'rep_date', 'rep_time', 'reportname' ]);
+
+    my $ret = {};
+    foreach my $report ( @{$reports} )
+    {
+        my($year, $month, $day) = split('-', $report->{'rep_date'});
+
+        my $fields = $self->getFields( $report->{'id'} );
+        my $fieldsref = {};
+        
+        foreach my $field ( @{$fields} )
+        {
+            if( not ref( $srvIdList ) or
+                grep {$field->{'serviceid'} eq $_} @{$srvIdList} )
+            {
+                $fieldsref->{$field->{'serviceid'}}->{$field->{'name'}} = {
+                    'value' => $field->{'value'},
+                    'units' => $field->{'units'} };
+            }
+        }
+        
+        $ret->{$year}{$month}{$day}{$report->{'reportname'}} = $fieldsref;
+    }
+    return $ret;    
+}
+
+        
+        
+    
+    
+
+        
+################################################
+## Class for report fields table
+
+package Torrus::SQL::ReportFields;
+use strict;
+
+use Torrus::SQL;
+use base 'Torrus::SQL';
+
+use Torrus::Log;
+
+# The name of the table and columns 
+# defaults configured in torrus-config.pl
+our $tableName;
+our %columns;
+
+sub add
+{
+    my $self = shift;
+    my $reportId = shift;
+    my $attrs = shift;
+    
+    my $id = $self->sequenceNext();
+    
+    $self->{'sql'}->insert({
+        'table' => $tableName,
+        'fields' => { $columns{'id'}         => $id,
+                      $columns{'rep_id'}     => $reportId,
+                      $columns{'name'}       => $attrs->{'name'},
+                      $columns{'serviceid'}  => $attrs->{'serviceid'},
+                      $columns{'value'}      => $attrs->{'value'},
+                      $columns{'units'}      => $attrs->{'units'} } });
+}
+
+
+sub getAll
+{
+    my $self = shift;
+    my $reportId = shift;
+       
+    $self->{'sql'}->select({
+        'table' => $tableName,
+        'where' => { $columns{'rep_id'} => $reportId },
+        'fields' => [ $columns{'name'},
+                      $columns{'serviceid'},
+                      $columns{'value'},
+                      $columns{'units'}] });
+
+    return $self->fetchall([ 'name', 'serviceid', 'value', 'units' ]);
+}
+
+
+sub removeAll
+{
+    my $self = shift;
+    my $reportId = shift;
+       
+    $self->{'sql'}->delete({
+        'table' => $tableName,
+        'where' => { $columns{'rep_id'} => $reportId }});
+}    
+    
+    
+    
+    
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/SQL/SrvExport.pm b/torrus/perllib/Torrus/SQL/SrvExport.pm
new file mode 100644
index 000000000..ef94547d6
--- /dev/null
+++ b/torrus/perllib/Torrus/SQL/SrvExport.pm
@@ -0,0 +1,109 @@
+#  Copyright (C) 2005  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: SrvExport.pm,v 1.1 2010-12-27 00:03:59 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Class for Collector's external storage export data manipulation.
+
+package Torrus::SQL::SrvExport;
+
+use strict;
+
+use Torrus::SQL;
+use base 'Torrus::SQL';
+
+use Torrus::Log;
+
+# The name of the table and columns where the collector export is stored
+# defaults configured in torrus-config.pl
+our $tableName;
+our %columns;
+
+sub sqlInsertStatement
+{
+    return sprintf('INSERT INTO %s (%s,%s,%s,%s,%s) VALUES (?,?,?,?,?)',
+                   $tableName,
+                   $columns{'srv_date'},
+                   $columns{'srv_time'},
+                   $columns{'serviceid'},
+                   $columns{'value'},
+                   $columns{'intvl'});
+}
+                   
+
+sub getServiceIDs
+{
+    my $self = shift;
+    
+    $self->{'sql'}->select({
+        'fields' => [ $columns{'serviceid'} ],
+        'table' => $tableName,
+        'group' => [ $columns{'serviceid'} ],
+        'order' => [ $columns{'serviceid'} ] });
+
+    my $ret = [];
+    while( defined( my $row = $self->{'sql'}->fetchrow_arrayref() ) )
+    {
+        push( @{$ret}, $row->[0] );
+    }
+
+    return $ret;    
+}    
+
+
+# YYYY-MM-DD for start and end date
+# returns the reference to the array of hashes for selected entries.
+
+sub getIntervalData
+{
+    my $self = shift;
+    my $startdate = shift;
+    my $enddate = shift;
+    my $serviceid = shift;
+
+    $self->{'sql'}->select({
+        'fields' =>
+            [ $columns{'srv_date'},
+              $columns{'srv_time'},
+              $columns{'value'},
+              $columns{'intvl'} ],
+            'table' => $tableName,
+            'where' => [ {$columns{'serviceid'} => $serviceid},
+                         'AND',
+                         {$columns{'srv_date'} => ['>=', $startdate]},
+                         'AND',
+                         {$columns{'srv_date'} => ['<', $enddate]}
+                         ]});
+
+    return $self->fetchall([ 'srv_date', 'srv_time', 'value', 'intvl' ]);
+}
+
+
+    
+    
+    
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Scheduler.pm b/torrus/perllib/Torrus/Scheduler.pm
new file mode 100644
index 000000000..9777d7519
--- /dev/null
+++ b/torrus/perllib/Torrus/Scheduler.pm
@@ -0,0 +1,498 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Scheduler.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+# Task scheduler.
+# Task object MUST implement two methods:
+# run() -- the running cycle
+# whenNext() -- returns the next time it must be run.
+# See below the Torrus::Scheduler::PeriodicTask class definition
+#
+# Options:
+#   -Tree        => tree name
+#   -ProcessName => process name and commandline options
+#   -RunOnce     => 1       -- this prevents from infinite loop.   
+
+
+package Torrus::Scheduler;
+
+use strict;
+use Torrus::SchedulerInfo;
+use Torrus::Log;
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    %{$self->{'options'}} = %options;
+    %{$self->{'data'}} = ();
+
+    if( not defined( $options{'-Tree'} ) or
+        not defined( $options{'-ProcessName'} ) )
+    {
+        die();
+    }
+
+    $self->{'stats'} = new Torrus::SchedulerInfo( -Tree => $options{'-Tree'},
+                                                  -WriteAccess => 1 );    
+    return $self;
+}
+
+
+sub DESTROY
+{
+    my $self = shift;
+    delete $self->{'stats'};
+}
+
+sub treeName
+{
+    my $self = shift;
+    return $self->{'options'}{'-Tree'};
+}
+
+sub setProcessStatus
+{
+    my $self = shift;
+    my $text = shift;
+    $0 = $self->{'options'}{'-ProcessName'} . ' [' . $text . ']';
+}
+
+sub addTask
+{
+    my $self = shift;
+    my $task = shift;
+    my $when = shift;
+
+    if( not defined $when )
+    {
+        # If not specified, run immediately
+        $when = time() - 1;
+    }
+    $self->storeTask( $task, $when );
+    $self->{'stats'}->clearStats( $task->id() );
+}
+
+
+sub storeTask
+{
+    my $self = shift;
+    my $task = shift;
+    my $when = shift;
+
+    if( not defined( $self->{'tasks'}{$when} ) )
+    {
+        $self->{'tasks'}{$when} = [];
+    }
+    push( @{$self->{'tasks'}{$when}}, $task );
+}
+    
+
+sub flushTasks
+{
+    my $self = shift;
+
+    if( defined( $self->{'tasks'} ) )
+    {
+        foreach my $when ( keys %{$self->{'tasks'}} )
+        {
+            foreach my $task ( @{$self->{'tasks'}{$when}} )
+            {
+                $self->{'stats'}->clearStats( $task->id() );
+            }
+        }
+        undef $self->{'tasks'};
+    }
+}
+
+
+sub run
+{
+    my $self = shift;
+
+    my $stop = 0;
+
+    while( not $stop )
+    {
+        $self->setProcessStatus('initializing scheduler');
+        while( not $self->beforeRun() )
+        {
+            &Torrus::DB::checkInterrupted();
+            
+            Error('Scheduler initialization error. Sleeping ' .
+                  $Torrus::Scheduler::failedInitSleep . ' seconds');
+
+            &Torrus::DB::setUnsafeSignalHandlers();
+            sleep($Torrus::Scheduler::failedInitSleep);
+            &Torrus::DB::setSafeSignalHandlers();
+        }
+        $self->setProcessStatus('');
+        my $nextRun = time() + 3600;
+        foreach my $when ( keys %{$self->{'tasks'}} )
+        {
+            # We have 1-second rounding error
+            if( $when <= time() + 1 )
+            {
+                foreach my $task ( @{$self->{'tasks'}{$when}} )
+                {
+                    &Torrus::DB::checkInterrupted();
+                    
+                    my $startTime = time();
+
+                    $self->beforeTaskRun( $task, $startTime, $when );
+                    $task->beforeRun( $self->{'stats'} );
+
+                    $self->setProcessStatus('running');
+                    $task->run();
+                    my $whenNext = $task->whenNext();
+                    
+                    $task->afterRun( $self->{'stats'}, $startTime );
+                    $self->afterTaskRun( $task, $startTime );
+                    
+                    if( $whenNext > 0 )
+                    {
+                        if( $whenNext == $when )
+                        {
+                            Error("Incorrect time returned by task");
+                        }
+                        $self->storeTask( $task, $whenNext );
+                        if( $nextRun > $whenNext )
+                        {
+                            $nextRun = $whenNext;
+                        }
+                    }
+                }
+                delete $self->{'tasks'}{$when};
+            }
+            elsif( $nextRun > $when )
+            {
+                $nextRun = $when;
+            }
+        }
+
+        if( $self->{'options'}{'-RunOnce'} or
+            ( scalar( keys %{$self->{'tasks'}} ) == 0 and
+              not $self->{'options'}{'-RunAlways'} ) )
+        {
+            $self->setProcessStatus('');
+            $stop = 1;
+        }
+        else
+        {
+            if( scalar( keys %{$self->{'tasks'}} ) == 0 )
+            {
+                Info('Tasks list is empty. Will sleep until ' .
+                     scalar(localtime($nextRun)));
+            }
+
+            $self->setProcessStatus('sleeping');
+            &Torrus::DB::setUnsafeSignalHandlers();            
+            Debug('We will sleep until ' . scalar(localtime($nextRun)));
+            
+            if( $Torrus::Scheduler::maxSleepTime > 0 )
+            {
+                Debug('This is a VmWare-like clock. We devide the sleep ' .
+                      'interval into small pieces');
+                while( time() < $nextRun )
+                {
+                    my $sleep = $nextRun - time();
+                    if( $sleep > $Torrus::Scheduler::maxSleepTime )
+                    {
+                        $sleep = $Torrus::Scheduler::maxSleepTime;
+                    }
+                    Debug('Sleeping ' . $sleep . ' seconds');
+                    sleep( $sleep );
+                }
+            }
+            else
+            {
+                my $sleep = $nextRun - time();
+                if( $sleep > 0 )
+                {
+                    sleep( $sleep );
+                }
+            }
+
+            &Torrus::DB::setSafeSignalHandlers();
+        }
+    }
+}
+
+
+# A method to override by ancestors. Executed every time before the
+# running cycle. Must return true value when finishes.
+sub beforeRun
+{
+    my $self = shift;
+    Debug('Torrus::Scheduler::beforeRun() - doing nothing');
+    return 1;
+}
+
+
+sub beforeTaskRun
+{
+    my $self = shift;
+    my $task = shift;
+    my $startTime = shift;
+    my $plannedStartTime = shift;
+
+    if( not $task->didNotRun() and  $startTime > $plannedStartTime + 1 )
+    {
+        my $late = $startTime - $plannedStartTime;
+        Verbose(sprintf('Task delayed %d seconds', $late));
+        $self->{'stats'}->setStatsValues( $task->id(), 'LateStart', $late );
+    }
+}
+
+
+sub afterTaskRun
+{
+    my $self = shift;
+    my $task = shift;
+    my $startTime = shift;
+
+    my $len = time() - $startTime;
+    Verbose(sprintf('%s task finished in %d seconds', $task->name(), $len));
+    
+    $self->{'stats'}->setStatsValues( $task->id(), 'RunningTime', $len );
+}
+
+
+# User data can be stored here
+sub data
+{
+    my $self = shift;
+    return $self->{'data'};
+}
+
+
+# Periodic task base class
+# Options:
+#   -Period   => seconds    -- cycle period
+#   -Offset   => seconds    -- time offset from even period moments
+#   -Name     => "string"   -- Symbolic name for log messages
+#   -Instance => N          -- instance number
+
+package Torrus::Scheduler::PeriodicTask;
+
+use Torrus::Log;
+use strict;
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    if( not defined( $options{'-Instance'} ) )
+    {
+        $options{'-Instance'} = 0;
+    }
+
+    %{$self->{'options'}} = %options;
+
+    $self->{'options'}{'-Period'} = 0 unless
+        defined( $self->{'options'}{'-Period'} );
+
+    $self->{'options'}{'-Offset'} = 0 unless
+        defined( $self->{'options'}{'-Offset'} );
+        
+    $self->{'options'}{'-Name'} = "PeriodicTask" unless
+        defined( $self->{'options'}{'-Name'} );
+
+    $self->{'missedPeriods'} = 0;
+
+    $self->{'options'}{'-Started'} = time();
+
+    # Array of (Name, Value) pairs for any kind of stats    
+    $self->{'statValues'} = [];
+    
+    Debug("New Periodic Task created: period=" .
+          $self->{'options'}{'-Period'} .
+          " offset=" . $self->{'options'}{'-Offset'});
+
+    return $self;
+}
+
+
+sub whenNext
+{
+    my $self = shift;
+
+    if( $self->period() > 0 )
+    {
+        my $now = time();
+        my $period = $self->period();
+        my $offset = $self->offset();
+        my $previous;
+
+        if( defined $self->{'previousSchedule'} )
+        {
+            if( $now - $self->{'previousSchedule'} <= $period )
+            {
+                $previous = $self->{'previousSchedule'};
+            }
+            elsif( not $Torrus::Scheduler::ignoreClockSkew )
+            {
+                Error('Last run of ' . $self->{'options'}{'-Name'} .
+                      ' was more than ' . $period . ' seconds ago');
+                $self->{'missedPeriods'} =
+                    int( ($now - $self->{'previousSchedule'}) / $period );
+            }
+        }
+        if( not defined( $previous ) )
+        {
+            $previous = $now - ($now % $period) + $offset;
+        }
+
+        my $whenNext = $previous + $period;
+        $self->{'previousSchedule'} = $whenNext;
+
+        Debug("Task ". $self->{'options'}{'-Name'}.
+              " wants to run next time at " . scalar(localtime($whenNext)));
+        return $whenNext;
+    }
+    else
+    {
+        return undef;
+    }
+}
+
+
+sub beforeRun
+{
+    my $self = shift;
+    my $stats = shift;
+
+    Verbose(sprintf('%s periodic task started. Period: %d:%.2d; ' .
+                    'Offset: %d:%.2d',
+                    $self->name(),
+                    int( $self->period() / 60 ), $self->period() % 60,
+                    int( $self->offset() / 60 ), $self->offset() % 60));    
+}
+
+
+sub afterRun
+{
+    my $self = shift;
+    my $stats = shift;
+    my $startTime = shift;
+    
+    my $len = time() - $startTime;
+    if( $len > $self->period() )
+    {
+        Warn(sprintf('%s task execution (%d) longer than period (%d)',
+                     $self->name(), $len, $self->period()));
+        
+        $stats->setStatsValues( $self->id(), 'TooLong', $len );
+        $stats->incStatsCounter( $self->id(), 'OverrunPeriods',
+                                 int( $len > $self->period() ) );
+    }
+
+    if( $self->{'missedPeriods'} > 0 )
+    {
+        $stats->incStatsCounter( $self->id(), 'MissedPeriods',
+                                 $self->{'missedPeriods'} );
+        $self->{'missedPeriods'} = 0;
+    }
+
+    foreach my $pair( @{$self->{'statValues'}} )
+    {
+        $stats->setStatsValues( $self->id(), @{$pair} );
+    }
+    @{$self->{'statValues'}} = [];
+}
+
+
+sub run
+{
+    my $self = shift;
+    Error("Dummy class Torrus::Scheduler::PeriodicTask was run");
+}
+
+
+sub period
+{
+    my $self = shift;
+    return $self->{'options'}->{'-Period'};
+}
+
+
+sub offset
+{
+    my $self = shift;
+    return $self->{'options'}->{'-Offset'};
+}
+
+
+sub didNotRun
+{
+    my $self = shift;
+    return( not defined( $self->{'previousSchedule'} ) );
+}
+
+
+sub name
+{
+    my $self = shift;
+    return $self->{'options'}->{'-Name'};
+}
+
+sub instance
+{
+    my $self = shift;
+    return $self->{'options'}->{'-Instance'};
+}
+
+
+sub whenStarted
+{
+    my $self = shift;
+    return $self->{'options'}->{'-Started'};
+}
+
+
+sub id
+{
+    my $self = shift;
+    return join(':', 'P', $self->name(), $self->instance(),
+                $self->period(), $self->offset());
+}
+
+sub setStatValue
+{
+    my $self = shift;
+    my $name = shift;
+    my $value = shift;
+
+    push( @{$self->{'statValues'}}, [$name, $value] );
+}
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/SchedulerInfo.pm b/torrus/perllib/Torrus/SchedulerInfo.pm
new file mode 100644
index 000000000..452b16129
--- /dev/null
+++ b/torrus/perllib/Torrus/SchedulerInfo.pm
@@ -0,0 +1,216 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: SchedulerInfo.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+# Task scheduler runtime information. Quite basic statistics access.
+
+package Torrus::SchedulerInfo;
+
+use Torrus::DB;
+use Torrus::Log;
+use strict;
+
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    %{$self->{'options'}} = %options;
+
+    die() if not defined( $options{'-Tree'} );
+
+    $self->{'db_stats'} =
+        new Torrus::DB( 'scheduler_stats',
+                      -Subdir => $self->{'options'}{'-Tree'},
+                      -Btree => 1,
+                      -WriteAccess => $options{'-WriteAccess'} );
+
+    return( defined( $self->{'db_stats'} ) ? $self:undef );
+}
+
+
+sub DESTROY
+{
+    my $self = shift;
+    delete $self->{'db_stats'};
+}
+
+
+sub readStats
+{
+    my $self = shift;
+
+    my $stats = {};
+
+    my $cursor = $self->{'db_stats'}->cursor();
+    while( my ($key, $value) = $self->{'db_stats'}->next($cursor) )
+    {
+        my( $id, $variable ) = split( '#', $key );
+        if( defined( $id ) and defined( $variable ) )
+        {
+            $stats->{$id}{$variable} = $value;
+        }
+    }
+    undef $cursor;
+
+    return $stats;
+}
+
+
+sub setValue
+{
+    my $self = shift;
+    my $id = shift;
+    my $variable = shift;
+    my $value = shift;
+
+    $self->{'db_stats'}->put( join('#', $id, $variable), $value );
+}
+
+sub getValue
+{
+    my $self = shift;
+    my $id = shift;
+    my $variable = shift;
+    
+    return $self->{'db_stats'}->get( join('#', $id, $variable) );
+}
+
+
+sub clearStats
+{
+    my $self = shift;
+    my $id = shift;
+
+    my $cursor = $self->{'db_stats'}->cursor( -Write => 1 );
+    while( my ($key, $value) = $self->{'db_stats'}->next($cursor) )
+    {
+        my( $db_id, $variable ) = split( '#', $key );
+        if( defined( $db_id ) and defined( $variable ) and
+            $id eq $db_id )
+        {
+            $self->{'db_stats'}->c_del( $cursor );
+        }
+    }
+    undef $cursor;
+}
+
+
+sub clearAll
+{
+    my $self = shift;
+    $self->{'db_stats'}->trunc();
+}
+
+
+sub setStatsValues
+{
+    my $self = shift;
+    my $id = shift;
+    my $variable = shift;
+    my $value = shift;
+
+    $self->setValue( $id, 'Last' . $variable, $value );
+
+    my $maxName = 'Max' . $variable;
+    my $maxVal = $self->getValue( $id, $maxName );
+    if( not defined( $maxVal ) or $value > $maxVal )
+    {
+        $maxVal = $value;
+    }
+    $self->setValue( $id, $maxName, $maxVal );
+
+    my $minName = 'Min' . $variable;
+    my $minVal = $self->getValue( $id, $minName );
+    if( not defined( $minVal ) or $value < $minVal )
+    {
+        $minVal = $value;
+    }
+    $self->setValue( $id, $minName, $minVal );
+
+    my $timesName = 'NTimes' . $variable;
+    my $nTimes = $self->getValue( $id, $timesName );
+
+    my $avgName = 'Avg' . $variable;
+    my $average = $self->getValue( $id, $avgName );
+
+    if( not defined( $nTimes ) )
+    {
+        $nTimes = 1;
+        $average = $value;
+    }
+    else
+    {
+        $average = ( $average * $nTimes + $value ) / ( $nTimes + 1 );
+        $nTimes++;
+    }
+    $self->setValue( $id, $timesName, $nTimes );
+    $self->setValue( $id, $avgName, $average );
+
+    my $expAvgName = 'ExpAvg' . $variable;
+    my $expAverage = $self->getValue( $id, $expAvgName );
+    if( not defined( $expAverage ) )
+    {
+        $expAverage = $value;
+    }
+    else
+    {
+        my $alpha = $Torrus::Scheduler::statsExpDecayAlpha;
+        $expAverage = $alpha * $value + ( 1 - $alpha ) * $expAverage;
+    }
+    $self->setValue( $id, $expAvgName, $expAverage );
+}
+
+
+sub incStatsCounter
+{
+    my $self = shift;
+    my $id = shift;
+    my $variable = shift;
+    my $increment = shift;
+
+    if( not defined( $increment ) )
+    {
+        $increment = 1;
+    }
+
+    my $name = 'Count' . $variable;
+    my $previous = $self->getValue( $id, $name );
+
+    if( not defined( $previous ) )
+    {
+        $previous = 0;
+    }
+    
+    $self->setValue( $id, $name, $previous + $increment );
+}
+
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/Search.pm b/torrus/perllib/Torrus/Search.pm
new file mode 100644
index 000000000..9923757db
--- /dev/null
+++ b/torrus/perllib/Torrus/Search.pm
@@ -0,0 +1,148 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Search.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+# Task scheduler runtime information. Quite basic statistics access.
+
+package Torrus::Search;
+
+use Torrus::DB;
+use Torrus::Log;
+use strict;
+
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    %{$self->{'options'}} = %options;
+
+    return $self;
+}
+
+
+sub openTree
+{
+    my $self = shift;
+    my $tree = shift;
+
+    my $db = new Torrus::DB
+        ( 'searchwords',
+          -Subdir => $tree,
+          -Btree => 1,
+          -Duplicates => 1,
+          -WriteAccess => $self->{'options'}{'-WriteAccess'},
+          -Truncate => $self->{'options'}{'-WriteAccess'} );
+
+    $self->{'db_treewords'}{$tree} = $db;
+}
+
+
+sub closeTree
+{
+    my $self = shift;
+    my $tree = shift;
+
+    $self->{'db_treewords'}{$tree}->closeNow();
+}
+
+
+sub openGlobal
+{
+    my $self = shift;
+
+    my $db = new Torrus::DB
+        ( 'globsearchwords',
+          -Btree => 1,
+          -Duplicates => 1,
+          -WriteAccess => $self->{'options'}{'-WriteAccess'},
+          -Truncate => $self->{'options'}{'-WriteAccess'} );
+
+    $self->{'db_globwords'} = $db;    
+}
+
+
+sub storeKeyword
+{
+    my $self = shift;
+    my $tree = shift;
+    my $keyword = lc( shift );
+    my $path = shift;
+    my $param = shift;
+
+    my $val = $path;
+    if( defined( $param ) )
+    {
+        $val .= ':' . $param;
+    }
+
+    my $lookupkey = join( ':', $tree, $keyword, $val );    
+    if( not $self->{'stored'}{$lookupkey} )
+    {
+        $self->{'db_treewords'}{$tree}->put( $keyword, $val );
+        if( defined( $self->{'db_globwords'} ) )
+        {
+            $self->{'db_globwords'}->put( $keyword, join(':', $tree, $val) );
+        }
+
+        $self->{'stored'}{$lookupkey} = 1;
+    }
+}
+
+sub searchPrefix
+{
+    my $self = shift;
+    my $prefix = lc( shift );
+    my $tree = shift;
+
+    my $db = defined( $tree ) ?
+        $self->{'db_treewords'}{$tree} : $self->{'db_globwords'};
+
+    my $result = $db->searchPrefix( $prefix );
+
+    my $ret = [];
+    
+    if( defined( $result ) )
+    {
+        foreach my $pair ( @{$result} )
+        {
+            my $retstrings = [];
+            push( @{$retstrings}, split(':', $pair->[1]) );
+            push( @{$ret}, $retstrings );
+        }
+    }
+
+    return $ret;
+}
+    
+    
+
+
+    
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ServiceID.pm b/torrus/perllib/Torrus/ServiceID.pm
new file mode 100644
index 000000000..90cbb98e0
--- /dev/null
+++ b/torrus/perllib/Torrus/ServiceID.pm
@@ -0,0 +1,188 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: ServiceID.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Manage the properties assigned to Service IDs
+
+package Torrus::ServiceID;
+
+use Torrus::DB;
+use Torrus::Log;
+
+use strict;
+
+
+sub new
+{
+    my $self = {};
+    my $class = shift;
+    my %options = @_;
+    bless $self, $class;
+
+    my $writing = $options{'-WriteAccess'};
+
+    $self->{'db_params'} =
+        new Torrus::DB( 'serviceid_params',
+                        -Btree => 1,
+                        -WriteAccess => $writing );
+    defined( $self->{'db_params'} ) or return( undef );
+
+    $self->{'is_writing'} = $writing;
+
+    return $self;
+}
+
+
+sub DESTROY
+{
+    my $self = shift;
+    Debug('Destroyed ServiceID object');
+    undef $self->{'db_params'};
+}
+
+
+
+sub idExists
+{
+    my $self = shift;
+    my $serviceid = shift;
+    my $tree = shift;
+
+    if( defined($tree) )
+    {
+        return $self->{'db_params'}->searchList( 't:'.$tree, $serviceid );
+    }
+
+    return $self->{'db_params'}->searchList( 'a:', $serviceid );
+}    
+    
+
+sub add
+{
+    my $self = shift;
+    my $serviceid = shift;
+    my $parameters = shift;
+
+    $self->{'db_params'}->addToList( 'a:', $serviceid );
+    
+    my $trees = $parameters->{'trees'};
+
+    foreach my $tree ( split(/\s*,\s*/o, $trees) )
+    {
+        $self->{'db_params'}->addToList( 't:'.$tree, $serviceid );
+    }
+
+    foreach my $param ( keys %{$parameters} )
+    {
+        my $val = $parameters->{$param};
+        
+        if( defined( $val ) and length( $val ) > 0 )
+        {
+            $self->{'db_params'}->put( 'p:'.$serviceid.':'.$param, $val );
+            $self->{'db_params'}->addToList( 'P:'.$serviceid, $param );
+        }
+    }
+}
+
+
+sub getParams
+{
+    my $self = shift;
+    my $serviceid = shift;
+
+    my $ret = {};
+    my $plist = $self->{'db_params'}->get( 'P:'.$serviceid );
+    foreach my $param ( split(',', $plist ) )
+    {
+        $ret->{$param} =
+            $self->{'db_params'}->get( 'p:'.$serviceid.':'.$param );
+    }
+
+    return $ret;
+}    
+
+
+sub getAllForTree
+{
+    my $self = shift;
+    my $tree = shift;
+
+    my $ret = [];
+    my $idlist = $self->{'db_params'}->get('t:'.$tree);
+    if( defined( $idlist ) )
+    {
+        push( @{$ret}, split( ',', $idlist ) );
+    }
+    return $ret;
+}
+
+
+sub cleanAllForTree
+{
+    my $self = shift;
+    my $tree = shift;
+
+    my $idlist = $self->{'db_params'}->get('t:'.$tree);
+    if( defined( $idlist ) )
+    {
+        foreach my $serviceid ( split( ',', $idlist ) )
+        {
+            # A ServiceID may belong to several trees.
+            # delete it from all other trees.
+
+            my $srvTrees =
+                $self->{'db_params'}->get( 'p:'.$serviceid.':trees' );
+            
+            foreach my $srvTree ( split(/\s*,\s*/o, $srvTrees) )
+            {
+                if( $srvTree ne $tree )
+                {
+                    $self->{'db_params'}->delFromList( 't:'.$srvTree,
+                                                       $serviceid );
+                }
+            }            
+            
+            $self->{'db_params'}->delFromList( 'a:', $serviceid );
+            
+            my $plist = $self->{'db_params'}->get( 'P:'.$serviceid );
+
+            foreach my $param ( split(',', $plist ) )
+            {
+                $self->{'db_params'}->del( 'p:'.$serviceid.':'.$param );
+            }
+
+            $self->{'db_params'}->del( 'P:'.$serviceid );
+            
+        }
+        $self->{'db_params'}->deleteList('t:'.$tree);
+    }
+}
+
+            
+            
+            
+            
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/SiteConfig.pm b/torrus/perllib/Torrus/SiteConfig.pm
new file mode 100644
index 000000000..947d0856c
--- /dev/null
+++ b/torrus/perllib/Torrus/SiteConfig.pm
@@ -0,0 +1,335 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: SiteConfig.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+## %Torrus::Global::treeConfig manipulation
+
+package Torrus::SiteConfig;
+
+use Torrus::Log;
+use strict;
+
+our %validDaemonNames = ('collector' => 1,
+                         'monitor'   => 1);
+
+our %mandatoryGraphStyles =
+    (
+     'SingleGraph'     => {'color' => 1, 'line'  => 1},
+     'HWBoundary'     => {'color' => 1, 'line'  => 1},
+     'HWFailure'      => {'color' => 1},
+     'HruleMin'       => {'color' => 1},
+     'HruleNormal'    => {'color' => 1},
+     'HruleMax'       => {'color' => 1},
+     'BpsIn'          => {'color' => 1, 'line'  => 1},
+     'BpsOut'         => {'color' => 1, 'line'  => 1}
+     );
+
+%Torrus::SiteConfig::validLineStyles =
+    (
+     'LINE1' => 1,
+     'LINE2' => 1,
+     'LINE3' => 1,
+     'AREA'  => 1,
+     'STACK' => 1
+     );
+
+## Verify the correctness of %Torrus::Global::treeConfig contents
+
+sub verify
+{
+    my $ok = 1;
+    if( not (scalar( keys %Torrus::Global::treeConfig )) )
+    {
+        Error('%Torrus::Global::treeConfig is not defined or empty');
+        $ok = 0;
+    }
+
+    foreach my $tree ( keys %Torrus::Global::treeConfig )
+    {
+        if( $tree !~ /^[a-zA-Z][a-zA-Z0-9_\-]*$/o )
+        {
+            Error("Invalid tree name: " . $tree);
+            $ok = 0;
+            next;
+        }
+
+        if( not $Torrus::Global::treeConfig{$tree}{'description'} )
+        {
+            Error("Missing description for the tree named \"" . $tree . "\"");
+            $ok = 0;
+        }
+
+        my $xmlfiles = $Torrus::Global::treeConfig{$tree}{'xmlfiles'};
+        if( not ref( $xmlfiles ) or not scalar( @{$xmlfiles} ) )
+        {
+            Error("'xmlfiles' array is not defined for the tree named \"" .
+                  $tree . "\"");
+            $ok = 0;
+        }
+        else
+        {
+            foreach my $file ( @{$xmlfiles} )
+            {
+                $ok = findXMLFile( $file,
+                                   "in the tree named \"" . $tree . "\"" ) ?
+                                       $ok:0;
+            }
+
+            if( ref( $Torrus::Global::treeConfig{$tree}{'run'} ) )
+            {
+                foreach my $daemon
+                    ( keys %{$Torrus::Global::treeConfig{$tree}{'run'}} )
+                {
+                    if( not $validDaemonNames{$daemon} )
+                    {
+                        Error("\"" . $daemon . "\" is not a correct daemon " .
+                              "name in the tree named \"" . $tree . "\"");
+                        $ok = 0;
+                    }
+                }
+            }
+        }
+    }
+
+    foreach my $file ( @Torrus::Global::xmlAlwaysIncludeFirst )
+    {
+        $ok = findXMLFile( $file,
+                           'in @Torrus::Global::xmlAlwaysIncludeFirst' ) ?
+                               $ok:0;
+    }
+    foreach my $file ( @Torrus::Global::xmlAlwaysIncludeLast )
+    {
+        $ok = findXMLFile( $file,
+                           'in @Torrus::Global::xmlAlwaysIncludeLast' ) ?
+                               $ok:0;
+    }
+
+    # Validate the styling profile
+
+    my $file = $Torrus::Global::stylingDir . '/' .
+        $Torrus::Renderer::stylingProfile . '.pl';
+    if( -r $file )
+    {
+        require $file;
+
+        #Color names are always there
+        require $Torrus::Global::stylingDir . '/colornames.pl';
+
+        if( defined($Torrus::Renderer::stylingProfileOverlay) )
+        {
+            my $overlay = $Torrus::Renderer::stylingProfileOverlay;
+            if( -r $overlay )
+            {
+                require $overlay;
+            }
+            else
+            {
+                Error('Error reading styling profile overlay from ' .
+                      $overlay . ': File is not readable');
+                $ok = 0;
+            }
+        }
+
+        my $profile = \%Torrus::Renderer::graphStyles;
+        # Check if mandatory parameters present
+        foreach my $element ( keys %mandatoryGraphStyles )
+        {
+            if( ref( $profile->{$element} ) )
+            {
+                if( $mandatoryGraphStyles{$element}{'color'}
+                    and not defined( $profile->{$element}{'color'} ) )
+                {
+                    Error('Mandatory color for ' . $element .
+                          ' is not defined in ' . $file);
+                    $ok = 0;
+                }
+                if( $mandatoryGraphStyles{$element}{'line'}
+                    and not defined( $profile->{$element}{'line'} ) )
+                {
+                    Error('Mandatory line style for ' . $element .
+                          ' is not defined in ' . $file);
+                    $ok = 0;
+                }
+            }
+            else
+            {
+                Error('Mandatory styling for ' . $element .
+                      ' is not defined in ' . $file);
+                $ok = 0;
+            }
+        }
+        # Check validity of all parameters
+        foreach my $element ( keys %{$profile} )
+        {
+            if( defined( $profile->{$element}{'color'} ) )
+            {
+                my $color = $profile->{$element}{'color'};
+                my $recursionLimit = 100;
+
+                while( $color =~ /^\#\#(\S+)$/ )
+                {
+                    if( $recursionLimit-- <= 0 )
+                    {
+                        Error('Color recursion is too deep');
+                        $ok = 0;
+                    }
+                    else
+                    {
+                        my $colorName = $1;
+                        $color = $profile->{$colorName}{'color'};
+                        if( not defined( $color ) )
+                        {
+                            Error('No color is defined for ' . $colorName);
+                            $ok = 0;
+                        }
+                    }
+                }
+
+                if( $color !~ /^\#[0-9a-fA-F]{6}$/ )
+                {
+                    Error('Invalid color specification for ' . $element .
+                          ' in ' . $file);
+                    $ok = 0;
+                }
+            }
+            if( defined( $profile->{$element}{'line'} ) )
+            {
+                if( not $Torrus::SiteConfig::validLineStyles{
+                    $profile->{$element}{'line'}} )
+                {
+                    Error('Invalid line specification for ' . $element .
+                          ' in ' . $file);
+                    $ok = 0;
+                }
+            }
+        }
+    }
+    else
+    {
+        Error('Error reading styling profile from ' . $file .
+              ': File is not readable');
+        $ok = 0;
+    }
+
+    return $ok;
+}
+
+
+sub findXMLFile
+{
+    my $file = shift;
+    my $msg = shift;
+
+    my $filename;
+    if( defined( $file ) )
+    {
+        my $found = 0;
+        foreach my $dir ( @Torrus::Global::xmlDirs )
+        {
+            $filename = $dir . '/' . $file;
+            if( -r $filename )
+            {
+                $found = 1;
+                last;
+            }
+        }
+        
+        if( not $found )
+        {
+            Error("Cannot find file: " . $file);
+            $filename = undef;
+        }
+    }
+    else
+    {
+        Error("File name undefined " . $msg);
+    }
+    return $filename;
+}
+
+
+sub treeExists
+{
+    my $tree = shift;
+    return defined( $Torrus::Global::treeConfig{$tree} );
+}
+
+
+sub listTreeNames
+{
+    return( sort keys %Torrus::Global::treeConfig );
+}
+
+
+sub mayRunCollector
+{
+    my $tree = shift;
+    my $run = $Torrus::Global::treeConfig{$tree}{'run'}{'collector'};
+    return( defined($run) and $run > 0 );   
+}
+
+sub collectorInstances
+{
+    my $tree = shift;
+    my $run = $Torrus::Global::treeConfig{$tree}{'run'}{'collector'};
+    return( (defined($run) and $run > 1) ? int($run) : 1 ); 
+}
+
+sub mayRunMonitor
+{
+    my $tree = shift;
+    return $Torrus::Global::treeConfig{$tree}{'run'}{'monitor'};
+}
+
+
+sub listXmlFiles
+{
+    my $tree = shift;
+    return @{$Torrus::Global::treeConfig{$tree}{'xmlfiles'}};
+}
+
+
+sub treeDescription
+{
+    my $tree = shift;
+    return $Torrus::Global::treeConfig{$tree}{'description'};
+}
+
+
+sub loadStyling
+{
+    require $Torrus::Global::stylingDir . '/' .
+        $Torrus::Renderer::stylingProfile . '.pl';
+
+    require $Torrus::Global::stylingDir . '/colornames.pl';
+
+    if( defined($Torrus::Renderer::stylingProfileOverlay) )
+    {
+        require $Torrus::Renderer::stylingProfileOverlay;
+    }
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/TimeStamp.pm b/torrus/perllib/Torrus/TimeStamp.pm
new file mode 100644
index 000000000..07959141c
--- /dev/null
+++ b/torrus/perllib/Torrus/TimeStamp.pm
@@ -0,0 +1,71 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: TimeStamp.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+package Torrus::TimeStamp;
+
+use Torrus::DB;
+use Torrus::Log;
+
+use strict;
+
+$Torrus::TimeStamp::db = undef;
+
+END
+{
+    Torrus::TimeStamp::release();
+}
+
+sub init
+{
+    not defined( $Torrus::TimeStamp::db ) or
+        die('$Torrus::TimeStamp::db is defined at init');
+    $Torrus::TimeStamp::db = new Torrus::DB('timestamps', -WriteAccess => 1);
+}
+
+sub release
+{
+    undef $Torrus::TimeStamp::db;
+}
+
+sub setNow
+{
+    my $tname = shift;
+    ref( $Torrus::TimeStamp::db ) or
+        die('$Torrus::TimeStamp::db is not defined at setNow');
+    $Torrus::TimeStamp::db->put( $tname, time() );
+}
+
+sub get
+{
+    my $tname = shift;
+    ref( $Torrus::TimeStamp::db ) or
+        die('$Torrus::TimeStamp::db is not defined at get');
+    my $stamp = $Torrus::TimeStamp::db->get( $tname );
+    return defined($stamp) ? $stamp : 0;
+}
+
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End: