#!@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: