← Back to branch summary

~ubuntu-branches/ubuntu/trusty/torrus/trusty-proposed

« back to all changes in this revision

Viewing changes to perllib/Torrus/ConfigTree/XMLCompiler.pm

  • Committer: Bazaar Package Importer
  • Author(s): Marc Haber
  • Date: 2008-03-08 00:18:46 UTC
  • mfrom: (1.2.1 upstream) (3.1.3 hardy)
  • Revision ID: james.westby@ubuntu.com-20080308001846-q3pinwcswe3uf7wj
Tags: 1.0.6-2
http://bugs.debian.org/469274
Add torrus-common.NEWS advising people to recompile their
configuration upon upgrading to torrus 1.0.6.
Thanks to Joerg Dorchain. Closes: #469274

Show diffs side-by-side

added added

removed removed

Lines of Context:
perllib/Torrus/ConfigTree/XMLCompiler.pm
14
14
#  along with this program; if not, write to the Free Software
15
15
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
16
16
 
17
 
# $Id: XMLCompiler.pm,v 1.2 2005/01/25 13:46:33 ssinyagin Exp $
 
17
# $Id: XMLCompiler.pm,v 1.6 2007/04/10 14:28:34 ssinyagin Exp $
18
18
# Stanislav Sinyagin <ssinyagin@yahoo.com>
19
19
 
20
20
 
41
41
    $options{'-Rebuild'} = 1;
42
42
 
43
43
    my $self  = $class->SUPER::new( %options );
 
44
    if( not defined( $self ) )
 
45
    {
 
46
        return undef;
 
47
    }
 
48
 
44
49
    bless $self, $class;
45
50
 
46
51
    if( $options{'-NoDSRebuild'} )
109
114
        }
110
115
    }
111
116
 
 
117
    foreach $node ( $root->getElementsByTagName('param-properties') )
 
118
    {
 
119
        $ok = $self->compile_paramprops( $node ) ? $ok:0;
 
120
    }
 
121
 
112
122
    if( not $self->{'-NoDSRebuild'} )
113
123
    {
114
124
        foreach $node ( $root->getElementsByTagName('definitions') )
172
182
}
173
183
 
174
184
 
 
185
sub compile_paramprops
 
186
{
 
187
    my $self = shift;
 
188
    my $node = shift;
 
189
    my $ok = 1;
 
190
 
 
191
    foreach my $def ( $node->getChildrenByTagName('prop') )
 
192
    {
 
193
        my $param = $def->getAttribute('param'); 
 
194
        my $prop = $def->getAttribute('prop');
 
195
        my $value = $def->getAttribute('value');
 
196
        if( not $param or not $prop or not defined($value) )
 
197
        {
 
198
            Error("Property definition error"); $ok = 0;
 
199
        }
 
200
        else
 
201
        {
 
202
            $self->setParamProperty($param, $prop, $value);
 
203
        }
 
204
    }
 
205
    return $ok;
 
206
}
 
207
 
 
208
 
 
209
 
175
210
# Process <param name="name" value="value"/> and put them into DB.
176
211
# Usage: $self->compile_params($node, $name);
177
212
 
198
233
        else
199
234
        {
200
235
            # Remove spaces in the head and tail.
201
 
            $value =~ s/^\s+//;
202
 
            $value =~ s/\s+$//;
 
236
            $value =~ s/^\s+//o;
 
237
            $value =~ s/\s+$//o;
203
238
 
204
239
            if( $param eq 'legend' )
205
240
            {
206
241
                # Remove space around delimiters
207
 
                $value =~ s/\s*\:\s*/\:/g;
208
 
                $value =~ s/\s*\;\s*/\;/g;
 
242
                $value =~ s/\s*\:\s*/\:/go;
 
243
                $value =~ s/\s*\;\s*/\;/go;
209
244
            }
210
245
            elsif( $param eq 'ds-type' and $value eq 'RRDfile' )
211
246
            {
267
302
    my $childname = shift;
268
303
    if( index($childname, '$PARENT') > -1 )
269
304
    {
270
 
        my @pathparts = split('/', $parentpath);
 
305
        my @pathparts = split(/\//o, $parentpath);
271
306
        my $parentname = pop @pathparts;
272
307
        $childname =~ s/\$PARENT/$parentname/g;
273
308
    }
279
314
    my $self = shift;
280
315
    my $name = shift;
281
316
 
282
 
    return ( $name =~ /^[0-9A-Za-z_\-\.]+$/ and
283
 
             $name !~ /\.\./ );
 
317
    return ( $name =~ /^[0-9A-Za-z_\-\.]+$/o and
 
318
             $name !~ /\.\./o );
284
319
}
285
320
 
286
321
sub compile_subtrees
323
358
    foreach my $alias ( $node->getChildrenByTagName('alias') )
324
359
    {
325
360
        my $apath = $alias->textContent();
326
 
        $apath =~ s/\s+//mg;
 
361
        $apath =~ s/\s+//mgo;
327
362
        $ok = $self->setAlias($token, $apath) ? $ok:0;
328
363
    }
329
364
 
330
 
    # Handle file patterns -- we're still in compile_subtrees()
331
 
 
332
 
    foreach my $fp ( $node->getChildrenByTagName('filepattern') )
333
 
    {
334
 
        my $type = $fp->getAttribute('type');
335
 
        my $name = $fp->getAttribute('name');
336
 
        my $file_re = $fp->getAttribute('filere');
337
 
        my $dirname = $self->getNodeParam($token, 'data-dir');
338
 
 
339
 
        if($type ne 'subtree' and $type ne 'leaf')
340
 
        {
341
 
            Error("Unknown filepattern type: $type at $path"); $ok = 0;
342
 
        }
343
 
        elsif( not defined($name) or not defined($file_re) )
344
 
        {
345
 
            Error("Filepattern name or RE not defined at $path"); $ok = 0;
346
 
        }
347
 
        elsif( not defined($dirname) )
348
 
        {
349
 
            Error("data-dir parameter not defined at $path"); $ok = 0;
350
 
        }
351
 
        elsif( not -d $dirname )
352
 
        {
353
 
            Error("Directory $dirname does not exist at $path"); $ok = 0;
354
 
        }
355
 
        else
356
 
        {
357
 
            $file_re = $self->expand_name($path, $file_re);
358
 
 
359
 
            # Read the directory and match the pattern
360
 
            my %applied = ();
361
 
            opendir(DIR, $dirname) or die "can't opendir $dirname: $!";
362
 
            while( (my $fname = readdir(DIR)) )
363
 
            {
364
 
                if( $fname =~ /$file_re/ )
365
 
                {
366
 
                    my $newnodename = eval($name);
367
 
                    if( defined $applied{$newnodename} )
368
 
                    {
369
 
                        Error("Filepattern gives non-unique names: " .
370
 
                              "name=\"$name\" filere=\"$file_re\" at $path");
371
 
                        $ok = 0;
372
 
                    }
373
 
                    else
374
 
                    {
375
 
                        $applied{$newnodename} = $fname;
376
 
                    }
377
 
                }
378
 
            }
379
 
            closedir DIR;
380
 
            # Clone the contents of filepattern into the main tree
381
 
            my %detailedmatched = ();
382
 
            foreach my $newnodename (keys %applied)
383
 
            {
384
 
                my $newnode = XML::LibXML::Element->new( $type );
385
 
                $newnode->setAttribute('name', $newnodename);
386
 
                $node->parentNode()->appendChild($newnode);
387
 
 
388
 
                my $childname = $newnodename;
389
 
                $childname .= '/' if $type eq 'subtree';
390
 
                my $newnodetoken = $self->addChild($token, $childname);
391
 
                my $newnodepath = $path.$childname;
392
 
 
393
 
                $self->setNodeParam($newnodetoken, 'data-file',
394
 
                                $applied{$newnodename});
395
 
 
396
 
                foreach my $fpchild ($fp->childNodes())
397
 
                {
398
 
                    if( $fpchild->nodeName() eq 'detailed' )
399
 
                    {
400
 
                        my $match =  $fpchild->getAttribute('match');
401
 
                        if( not defined $match )
402
 
                        {
403
 
                            Error("Detailed should have match at $path");
404
 
                            $ok = 0;
405
 
                        }
406
 
                        else
407
 
                        {
408
 
                            if( not defined $detailedmatched{$match} )
409
 
                            {
410
 
                                $detailedmatched{$match} = 0;
411
 
                            }
412
 
                            if( $match eq $newnodename )
413
 
                            {
414
 
                                $detailedmatched{$match} = 1;
415
 
                                foreach my $detnode ( $fpchild->childNodes() )
416
 
                                {
417
 
                                    $newnode->
418
 
                                        appendChild($detnode->cloneNode(1));
419
 
                                }
420
 
                            }
421
 
                        }
422
 
                    }
423
 
                    else
424
 
                    {
425
 
                        $newnode->appendChild($fpchild->cloneNode(1));
426
 
                    }
427
 
                }
428
 
                $ok = $self->
429
 
                    compile_subtrees( $newnode, $newnodetoken ) ? $ok:0;
430
 
            }
431
 
 
432
 
            # Check if any of detailed have not matched
433
 
 
434
 
            foreach my $match (keys %detailedmatched)
435
 
            {
436
 
                if( not $detailedmatched{$match} )
437
 
                {
438
 
                    Warn("Detailed match \"$match\" have not matched any ".
439
 
                         "file at $path");
440
 
                }
441
 
            }
442
 
        }
443
 
    }
444
 
 
445
365
    foreach my $setvar ( $node->getChildrenByTagName('setvar') )        
446
366
    {
447
367
        my $name = $setvar->getAttribute('name');