torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm

   1 #  Copyright (C) 2002  Stanislav Sinyagin
   2 #
   3 #  This program is free software; you can redistribute it and/or modify
   4 #  it under the terms of the GNU General Public License as published by
   5 #  the Free Software Foundation; either version 2 of the License, or
   6 #  (at your option) any later version.
   7 #
   8 #  This program is distributed in the hope that it will be useful,
   9 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #  GNU General Public License for more details.
  12 #
  13 #  You should have received a copy of the GNU General Public License
  14 #  along with this program; if not, write to the Free Software
  15 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  16
  17 # $Id: XMLCompiler.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20
  21 package Torrus::ConfigTree::XMLCompiler;
  22
  23 use Torrus::ConfigTree::Writer;
  24 our @ISA=qw(Torrus::ConfigTree::Writer);
  25
  26 use Torrus::ConfigTree;
  27 use Torrus::ConfigTree::Validator;
  28 use Torrus::SiteConfig;
  29 use Torrus::Log;
  30 use Torrus::TimeStamp;
  31
  32 use XML::LibXML;
  33 use strict;
  34
  35 sub new
  36 {
  37     my $proto = shift;
  38     my %options = @_;
  39     my $class = ref($proto) || $proto;
  40
  41     $options{'-Rebuild'} = 1;
  42
  43     my $self  = $class->SUPER::new( %options );
  44     if( not defined( $self ) )
  45     {
  46         return undef;
  47     }
  48
  49     bless $self, $class;
  50
  51     if( $options{'-NoDSRebuild'} )
  52     {
  53         $self->{'-NoDSRebuild'} = 1;
  54     }
  55
  56     $self->{'files_processed'} = {};
  57
  58     return $self;
  59 }
  60
  61
  62 sub compile
  63 {
  64     my $self = shift;
  65     my $filename = shift;
  66
  67     &Torrus::DB::checkInterrupted();
  68
  69     $filename = Torrus::SiteConfig::findXMLFile($filename);
  70     if( not defined( $filename ) )
  71     {
  72         return 0;
  73     }
  74
  75     # Make sure we process each file only once
  76     if( $self->{'files_processed'}{$filename} )
  77     {
  78         return 1;
  79     }
  80     else
  81     {
  82         $self->{'files_processed'}{$filename} = 1;
  83     }
  84
  85     Verbose('Compiling ' . $filename);
  86
  87     my $ok = 1;
  88     my $parser = new XML::LibXML;
  89     my $doc;
  90     eval { $doc = $parser->parse_file( $filename );  };
  91     if( $@ )
  92     {
  93         Error("Failed to parse $filename: $@");
  94         return 0;
  95     }
  96
  97     my $root = $doc->documentElement();
  98
  99     # Initialize the '/' element
 100     $self->initRoot();
 101
 102     my $node;
 103
 104     # First of all process all pre-required files
 105     foreach $node ( $root->getElementsByTagName('include') )
 106     {
 107         my $incfile = $node->getAttribute('filename');
 108         if( not $incfile )
 109         {
 110             Error("No filename given in include statement in $filename");
 111             $ok = 0;
 112         }
 113         else
 114         {
 115             $ok = $self->compile( $incfile ) ? $ok:0;
 116         }
 117     }
 118
 119     foreach $node ( $root->getElementsByTagName('param-properties') )
 120     {
 121         $ok = $self->compile_paramprops( $node ) ? $ok:0;
 122     }
 123
 124     if( not $self->{'-NoDSRebuild'} )
 125     {
 126         foreach $node ( $root->getElementsByTagName('definitions') )
 127         {
 128             $ok = $self->compile_definitions( $node ) ? $ok:0;
 129         }
 130
 131         foreach $node ( $root->getElementsByTagName('datasources') )
 132         {
 133             $ok = $self->compile_ds( $node ) ? $ok:0;
 134         }
 135     }
 136
 137     foreach $node ( $root->getElementsByTagName('monitors') )
 138     {
 139         $ok = $self->compile_monitors( $node ) ? $ok:0;
 140     }
 141
 142     foreach $node ( $root->getElementsByTagName('token-sets') )
 143     {
 144         $ok = $self->compile_tokensets( $node ) ? $ok:0;
 145     }
 146
 147     foreach $node ( $root->getElementsByTagName('views') )
 148     {
 149         $ok = $self->compile_views( $node ) ? $ok:0;
 150     }
 151
 152     return $ok;
 153 }
 154
 155
 156 sub compile_definitions
 157 {
 158     my $self = shift;
 159     my $node = shift;
 160     my $ok = 1;
 161
 162     foreach my $def ( $node->getChildrenByTagName('def') )
 163     {
 164         &Torrus::DB::checkInterrupted();
 165
 166         my $name = $def->getAttribute('name');
 167         my $value = $def->getAttribute('value');
 168         if( not $name )
 169         {
 170             Error("Definition without a name"); $ok = 0;
 171         }
 172         elsif( not $value )
 173         {
 174             Error("Definition without value: $name"); $ok = 0;
 175         }
 176         elsif( defined $self->getDefinition($name) )
 177         {
 178             Error("Duplicate definition: $name"); $ok = 0;
 179         }
 180         else
 181         {
 182             $self->addDefinition($name, $value);
 183         }
 184     }
 185     return $ok;
 186 }
 187
 188
 189 sub compile_paramprops
 190 {
 191     my $self = shift;
 192     my $node = shift;
 193     my $ok = 1;
 194
 195     foreach my $def ( $node->getChildrenByTagName('prop') )
 196     {
 197         &Torrus::DB::checkInterrupted();
 198
 199         my $param = $def->getAttribute('param');
 200         my $prop = $def->getAttribute('prop');
 201         my $value = $def->getAttribute('value');
 202         if( not $param or not $prop or not defined($value) )
 203         {
 204             Error("Property definition error"); $ok = 0;
 205         }
 206         else
 207         {
 208             $self->setParamProperty($param, $prop, $value);
 209         }
 210     }
 211     return $ok;
 212 }
 213
 214
 215
 216 # Process <param name="name" value="value"/> and put them into DB.
 217 # Usage: $self->compile_params($node, $name);
 218
 219 sub compile_params
 220 {
 221     my $self = shift;
 222     my $node = shift;
 223     my $name = shift;
 224     my $isDS = shift;
 225
 226     &Torrus::DB::checkInterrupted();
 227
 228     my $ok = 1;
 229     foreach my $p_node ( $node->getChildrenByTagName('param') )
 230     {
 231         my $param = $p_node->getAttribute('name');
 232         my $value = $p_node->getAttribute('value');
 233         if( not defined($value) )
 234         {
 235             $value = $p_node->textContent();
 236         }
 237         if( not $param )
 238         {
 239             Error("Parameter without name in $name"); $ok = 0;
 240         }
 241         else
 242         {
 243             # Remove spaces in the head and tail.
 244             $value =~ s/^\s+//om;
 245             $value =~ s/\s+$//om;
 246
 247             if( $isDS )
 248             {
 249                 $self->setNodeParam($name, $param, $value);
 250             }
 251             else
 252             {
 253                 $self->setParam($name, $param, $value);
 254             }
 255         }
 256     }
 257     return $ok;
 258 }
 259
 260
 261 sub compile_ds
 262 {
 263     my $self = shift;
 264     my $ds_node = shift;
 265     my $ok = 1;
 266
 267     # First, process templates. We expect them to be direct children of
 268     # <datasources>
 269
 270     foreach my $template ( $ds_node->getChildrenByTagName('template') )
 271     {
 272         my $name = $template->getAttribute('name');
 273         if( not $name )
 274         {
 275             Error("Template without a name"); $ok = 0;
 276         }
 277         elsif( defined $self->{'Templates'}->{$name} )
 278         {
 279             Error("Duplicate template names: $name"); $ok = 0;
 280         }
 281         else
 282         {
 283             $self->{'Templates'}->{$name} = $template;
 284         }
 285     }
 286
 287     # Recursively traverse the tree
 288     $ok = $self->compile_subtrees( $ds_node, $self->token('/') ) ? $ok:0;
 289
 290     return $ok;
 291 }
 292
 293
 294
 295
 296 sub validate_nodename
 297 {
 298     my $self = shift;
 299     my $name = shift;
 300
 301     return ( $name =~ /^[0-9A-Za-z_\-\.\:]+$/o and
 302              $name !~ /\.\./o );
 303 }
 304
 305 sub compile_subtrees
 306 {
 307     my $self = shift;
 308     my $node = shift;
 309     my $token = shift;
 310     my $iamLeaf = shift;
 311
 312     my $ok = 1;
 313
 314     # Apply templates
 315
 316     foreach my $templateapp ( $node->getChildrenByTagName('apply-template') )
 317     {
 318         my $name = $templateapp->getAttribute('name');
 319         if( not $name )
 320         {
 321             my $path = $self->path($token);
 322             Error("Template application without a name at $path"); $ok = 0;
 323         }
 324         else
 325         {
 326             my $template = $self->{'Templates'}->{$name};
 327             if( not defined $template )
 328             {
 329                 my $path = $self->path($token);
 330                 Error("Cannot find template named $name at $path"); $ok = 0;
 331             }
 332             else
 333             {
 334                 $ok = $self->compile_subtrees
 335                     ($template, $token, $iamLeaf) ? $ok:0;
 336             }
 337         }
 338     }
 339
 340     $ok = $self->compile_params($node, $token, 1);
 341
 342     # Handle aliases -- we are still in compile_subtrees()
 343
 344     foreach my $alias ( $node->getChildrenByTagName('alias') )
 345     {
 346         my $apath = $alias->textContent();
 347         $apath =~ s/\s+//mgo;
 348         $ok = $self->setAlias($token, $apath) ? $ok:0;
 349     }
 350
 351     foreach my $setvar ( $node->getChildrenByTagName('setvar') )
 352     {
 353         my $name = $setvar->getAttribute('name');
 354         my $value = $setvar->getAttribute('value');
 355         if( not defined( $name ) or not defined( $value ) )
 356         {
 357             my $path = $self->path($token);
 358             Error("Setvar statement without name or value in $path"); $ok = 0;
 359         }
 360         else
 361         {
 362             $self->setVar( $token, $name, $value );
 363         }
 364     }
 365
 366     # Compile-time variables
 367
 368     foreach my $iftrue ( $node->getChildrenByTagName('iftrue') )
 369     {
 370         my $var = $iftrue->getAttribute('var');
 371         if( not defined( $var ) )
 372         {
 373             my $path = $self->path($token);
 374             Error("Iftrue statement without variable name in $path"); $ok = 0;
 375         }
 376         elsif( $self->isTrueVar( $token, $var ) )
 377         {
 378             $ok = $self->compile_subtrees( $iftrue, $token, $iamLeaf ) ? $ok:0;
 379         }
 380     }
 381
 382     foreach my $iffalse ( $node->getChildrenByTagName('iffalse') )
 383     {
 384         my $var = $iffalse->getAttribute('var');
 385         if( not defined( $var ) )
 386         {
 387             my $path = $self->path($token);
 388             Error("Iffalse statement without variable name in $path"); $ok = 0;
 389         }
 390         elsif( not $self->isTrueVar( $token, $var ) )
 391         {
 392             $ok = $self->compile_subtrees
 393                 ( $iffalse, $token, $iamLeaf ) ? $ok:0;
 394         }
 395     }
 396
 397
 398     # Compile child nodes -- the last part of compile_subtrees()
 399
 400     if( not $iamLeaf )
 401     {
 402         foreach my $subtree ( $node->getChildrenByTagName('subtree') )
 403         {
 404             my $name = $subtree->getAttribute('name');
 405             if( not defined( $name ) or length( $name ) == 0 )
 406             {
 407                 my $path = $self->path($token);
 408                 Error("Subtree without a name at $path"); $ok = 0;
 409             }
 410             else
 411             {
 412                 if( $self->validate_nodename( $name ) )
 413                 {
 414                     my $stoken = $self->addChild($token, $name.'/');
 415                     $ok = $self->compile_subtrees( $subtree, $stoken ) ? $ok:0;
 416                 }
 417                 else
 418                 {
 419                     my $path = $self->path($token);
 420                     Error("Invalid subtree name: $name at $path"); $ok = 0;
 421                 }
 422             }
 423         }
 424
 425         foreach my $leaf ( $node->getChildrenByTagName('leaf') )
 426         {
 427             my $name = $leaf->getAttribute('name');
 428             if( not defined( $name ) or length( $name ) == 0 )
 429             {
 430                 my $path = $self->path($token);
 431                 Error("Leaf without a name at $path"); $ok = 0;
 432             }
 433             else
 434             {
 435                 if( $self->validate_nodename( $name ) )
 436                 {
 437                     my $ltoken = $self->addChild($token, $name);
 438                     $ok = $self->compile_subtrees( $leaf, $ltoken, 1 ) ? $ok:0;
 439                 }
 440                 else
 441                 {
 442                     my $path = $self->path($token);
 443                     Error("Invalid leaf name: $name at $path"); $ok = 0;
 444                 }
 445             }
 446         }
 447     }
 448     return $ok;
 449 }
 450
 451
 452 sub compile_monitors
 453 {
 454     my $self = shift;
 455     my $mon_node = shift;
 456     my $ok = 1;
 457
 458     foreach my $monitor ( $mon_node->getChildrenByTagName('monitor') )
 459     {
 460         my $mname = $monitor->getAttribute('name');
 461         if( not $mname )
 462         {
 463             Error("Monitor without a name"); $ok = 0;
 464         }
 465         else
 466         {
 467             $ok = $self->addMonitor( $mname );
 468             $ok = $self->compile_params($monitor, $mname) ? $ok:0;
 469         }
 470     }
 471
 472     foreach my $action ( $mon_node->getChildrenByTagName('action') )
 473     {
 474         my $aname = $action->getAttribute('name');
 475         if( not $aname )
 476         {
 477             Error("Action without a name"); $ok = 0;
 478         }
 479         else
 480         {
 481             $self->addAction( $aname );
 482             $ok = $self->compile_params($action, $aname);
 483         }
 484     }
 485     return $ok;
 486 }
 487
 488
 489 sub compile_tokensets
 490 {
 491     my $self = shift;
 492     my $tsets_node = shift;
 493     my $ok = 1;
 494
 495     $ok = $self->compile_params($tsets_node, 'SS') ? $ok:0;
 496
 497     foreach my $tokenset ( $tsets_node->getChildrenByTagName('token-set') )
 498     {
 499         my $sname = $tokenset->getAttribute('name');
 500         if( not $sname )
 501         {
 502             Error("Token-set without a name"); $ok = 0;
 503         }
 504         else
 505         {
 506             $sname = 'S'. $sname;
 507             $ok = $self->addTset( $sname );
 508             $ok = $self->compile_params($tokenset, $sname) ? $ok:0;
 509         }
 510     }
 511     return $ok;
 512 }
 513
 514
 515 sub compile_views
 516 {
 517     my $self = shift;
 518     my $vw_node = shift;
 519     my $parentname = shift;
 520     my $ok = 1;
 521
 522     foreach my $view ( $vw_node->getChildrenByTagName('view') )
 523     {
 524         my $vname = $view->getAttribute('name');
 525         if( not $vname )
 526         {
 527             Error("View without a name"); $ok = 0;
 528         }
 529         else
 530         {
 531             $self->addView( $vname, $parentname );
 532             $ok = $self->compile_params( $view, $vname ) ? $ok:0;
 533             # Process child views
 534             $ok = $self->compile_views( $view, $vname ) ? $ok:0;
 535         }
 536     }
 537     return $ok;
 538 }
 539
 540
 541
 542 1;
 543
 544 # Local Variables:
 545 # mode: perl
 546 # indent-tabs-mode: nil
 547 # perl-indent-level: 4
 548 # End: