--- /dev/null
+#!@PERL@
+# 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: configsnapshot.in,v 1.1 2010-12-27 00:04:01 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+BEGIN { require '@torrus_config_pl@'; }
+
+use strict;
+use Getopt::Long;
+
+use Torrus::Log;
+use Torrus::ConfigTree;
+use Torrus::SiteConfig;
+use Torrus::ConfigBuilder;
+
+exit(1) if not Torrus::SiteConfig::verify();
+
+my $tree;
+my $help_needed;
+my $verbose = 0;
+
+my $outfile = 'snapshot.xml';
+
+my $filter_param;
+my $filter_value;
+my $filter_op = '=';
+
+my $creator = "Torrus version @VERSION@\n" .
+ "This file was generated by command:\n" .
+ $0 . " \\\n";
+foreach my $arg ( @ARGV )
+{
+ if( $arg =~ /^--/ )
+ {
+ $creator .= ' ' . $arg . ' ';
+ }
+ else
+ {
+ $creator .= "\'" . $arg . "\'\\\n";
+ }
+}
+$creator .= "\nOn " . scalar(localtime(time));
+
+my $ok = GetOptions('tree=s' => \$tree,
+ 'out=s' => \$outfile,
+ 'param=s' => \$filter_param,
+ 'value=s' => \$filter_value,
+ 'op=s' => \$filter_op,
+ 'verbose' => \$verbose,
+ 'help' => \$help_needed);
+
+if( not $ok or not $tree or $help_needed or
+ ( defined($filter_param) + defined($filter_value) == 1 ) or
+ ( $filter_op ne '=' and $filter_op ne 'eq' and $filter_op ne 're' ) or
+ scalar(@ARGV) > 0 )
+{
+ print STDERR "Usage: $0 --tree=NAME [options...]\n",
+ "Options:\n",
+ " --tree=NAME tree name\n",
+ " --out=filename output file [".$outfile."]\n",
+ " --param=PARAM --value=VALUE \n",
+ " filter the output by leaves with specified value\n",
+ " --op=OP filter operation [=|eq|re], default: [=]\n",
+ " --verbose print extra information\n",
+ " --help this help message\n";
+ exit 1;
+}
+
+if( $verbose )
+{
+ Torrus::Log::setLevel('verbose');
+}
+
+if( not Torrus::SiteConfig::treeExists( $tree ) )
+{
+ Error('Tree ' . $tree . ' does not exist');
+ exit 1;
+}
+
+&Torrus::DB::setSafeSignalHandlers();
+
+my $config_tree = new Torrus::ConfigTree( -TreeName => $tree, -Wait => 1 );
+if( not defined( $config_tree ) )
+{
+ exit 1;
+}
+
+
+my $filter_match = sub {return $_[0] == $filter_value};
+
+if(defined($filter_param))
+{
+ if( $filter_op eq 'eq' )
+ {
+ $filter_match = sub {return $_[0] eq $filter_value};
+ }
+ elsif( $filter_op eq 're' )
+ {
+ $filter_match = sub {return $_[0] =~ $filter_value};
+ }
+}
+
+
+
+my $cb = new Torrus::ConfigBuilder;
+
+$cb->addCreatorInfo( $creator );
+
+# We don't collect views, since they are in defaults.xml which is always
+# included
+
+collect_monitors( $config_tree, $cb );
+collect_tokensets( $config_tree, $cb );
+collect_definitions( $config_tree, $cb );
+collect_datasources( $config_tree, $cb );
+
+my $ok = $cb->toFile( $outfile );
+if( $ok )
+{
+ Verbose('Wrote ' . $outfile);
+}
+else
+{
+ Error('Cannot write ' . $outfile . ': ' . $!);
+}
+
+exit($ok ? 0:1);
+
+sub collect_monitors
+{
+ my $config_tree = shift;
+ my $cb = shift;
+
+ my $monitorsNode = $cb->startMonitors();
+
+ foreach my $action ( $config_tree->getActionNames() )
+ {
+ &Torrus::DB::checkInterrupted();
+
+ my $params = $config_tree->getParams( $action );
+ $cb->addMonitorAction( $monitorsNode, $action, $params );
+ }
+
+ foreach my $monitor ( $config_tree->getMonitorNames() )
+ {
+ &Torrus::DB::checkInterrupted();
+
+ my $params = $config_tree->getParams( $monitor );
+ $cb->addMonitor( $monitorsNode, $monitor, $params );
+ }
+}
+
+sub collect_tokensets
+{
+ my $config_tree = shift;
+ my $cb = shift;
+
+ my $tsetsNode = $cb->startTokensets();
+
+ foreach my $tset ( $config_tree->getTsets() )
+ {
+ &Torrus::DB::checkInterrupted();
+
+ my $params = $config_tree->getParams( $tset );
+ my $name = $tset;
+ $name =~ s/^S//;
+ $cb->addTokenset( $tsetsNode, $name, $params );
+ }
+}
+
+
+sub collect_definitions
+{
+ my $config_tree = shift;
+ my $cb = shift;
+
+ my $definitionsNode = $cb->startDefinitions();
+
+ foreach my $defName ( sort $config_tree->getDefinitionNames() )
+ {
+ &Torrus::DB::checkInterrupted();
+
+ my $value = $config_tree->getDefinition( $defName );
+ $cb->addDefinition( $definitionsNode, $defName, $value );
+ }
+
+ my $propsNode = $cb->startParamProps();
+ my $props = $config_tree->getParamProperties();
+
+ &Torrus::DB::checkInterrupted();
+
+ foreach my $prop ( sort keys %{$props} )
+ {
+ foreach my $param ( sort keys %{$props->{$prop}} )
+ {
+ $cb->addParamProp( $propsNode, $param, $prop,
+ $props->{$prop}{$param} );
+ }
+ }
+}
+
+
+my %filterTokens;
+
+
+sub collect_datasources
+{
+ my $config_tree = shift;
+ my $cb = shift;
+
+ my $topNode = $cb->getTopSubtree();
+ my $topToken = $config_tree->token('/');
+
+ my $params = prepare_params( $config_tree, $topToken );
+ $cb->addParams( $topNode, $params );
+
+ if( defined($filter_param) )
+ {
+ $filterTokens{$topToken} = apply_filter( $config_tree, $topToken );
+ }
+
+ collect_subtrees( $config_tree, $cb, $topToken, $topNode );
+}
+
+
+
+sub apply_filter
+{
+ my $config_tree = shift;
+ my $token = shift;
+
+ $filterTokens{$token} = 0;
+
+ foreach my $ctoken ( $config_tree->getChildren( $token ) )
+ {
+ &Torrus::DB::checkInterrupted();
+
+ if( $config_tree->isSubtree( $ctoken ) )
+ {
+ $filterTokens{$token} += apply_filter( $config_tree, $ctoken );
+ }
+ elsif( $config_tree->isLeaf( $ctoken ) )
+ {
+ my $val = $config_tree->getNodeParam( $ctoken, $filter_param );
+ if( defined($val) and &{$filter_match}($val) )
+ {
+ $filterTokens{$ctoken} = 1;
+ $filterTokens{$token}++;
+ }
+ }
+ }
+
+ return $filterTokens{$token};
+}
+
+
+
+sub collect_subtrees
+{
+ my $config_tree = shift;
+ my $cb = shift;
+ my $token = shift;
+ my $parentNode = shift;
+
+ foreach my $ctoken ( $config_tree->getChildren( $token ) )
+ {
+ &Torrus::DB::checkInterrupted();
+
+ if( not defined($filter_param) or $filterTokens{$ctoken} )
+ {
+ my $childName =
+ $config_tree->nodeName( $config_tree->path($ctoken) );
+ my $params = prepare_params( $config_tree, $ctoken );
+
+ if( $config_tree->isSubtree( $ctoken ) )
+ {
+ my $subtreeNode =
+ $cb->addSubtree( $parentNode, $childName, $params );
+ collect_subtrees( $config_tree, $cb, $ctoken, $subtreeNode );
+ }
+ elsif( $config_tree->isLeaf( $ctoken ) )
+ {
+ $cb->addLeaf( $parentNode, $childName, $params );
+ }
+
+ foreach my $aliasToken ( $config_tree->getAliases( $ctoken ) )
+ {
+ $cb->addAlias( $parentNode,
+ $config_tree->path( $aliasToken ) );
+ }
+ }
+ }
+}
+
+
+sub prepare_params
+{
+ my $config_tree = shift;
+ my $token = shift;
+
+ my $params = $config_tree->getParams( $token, 1 );
+
+ # Remove linebreaks
+ while( my( $param, $value ) = each %{$params} )
+ {
+ $value =~ s/\s+/ /gm;
+ $params->{$param} = $value;
+ }
+
+ return $params;
+}
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End: