import torrus 1.0.9
[freeside.git] / torrus / bin / configsnapshot.in
diff --git a/torrus/bin/configsnapshot.in b/torrus/bin/configsnapshot.in
new file mode 100644 (file)
index 0000000..dc79e5b
--- /dev/null
@@ -0,0 +1,332 @@
+#!@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: