torrus/bin/schedulerinfo.in

   1 #!@PERL@ -w
   2 #  Copyright (C) 2003  Stanislav Sinyagin
   3 #  Copyright (C) 2003  Christian Schnidrig
   4 #
   5 #  This program is free software; you can redistribute it and/or modify
   6 #  it under the terms of the GNU General Public License as published by
   7 #  the Free Software Foundation; either version 2 of the License, or
   8 #  (at your option) any later version.
   9 #
  10 #  This program is distributed in the hope that it will be useful,
  11 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 #  GNU General Public License for more details.
  14 #
  15 #  You should have received a copy of the GNU General Public License
  16 #  along with this program; if not, write to the Free Software
  17 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  18
  19 # $Id: schedulerinfo.in,v 1.1 2010-12-27 00:04:00 ivan Exp $
  20 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  21
  22 BEGIN { require '@torrus_config_pl@'; }
  23
  24 use strict;
  25 use Getopt::Long;
  26
  27 use Torrus::ConfigTree;
  28 use Torrus::SiteConfig;
  29 use Torrus::SchedulerInfo;
  30 use Torrus::Log;
  31
  32 exit(1) if not Torrus::SiteConfig::verify();
  33
  34 my $tree;
  35 my $report_config;
  36 my $report_runtime;
  37 my $clear_treestats;
  38
  39 my $help_needed;
  40
  41
  42 my $ok = GetOptions('tree=s'   => \$tree,
  43                     'config'   => \$report_config,
  44                     'runtime'  => \$report_runtime,
  45                     'clear'    => \$clear_treestats,
  46                     'help'     => \$help_needed);
  47
  48 if( not $ok or
  49     not $tree or
  50     not ( $report_config or $report_runtime or $clear_treestats  ) or
  51     $help_needed or scalar(@ARGV) > 0 )
  52 {
  53     print STDERR "Usage: $0 --tree=NAME [options...]\n",
  54     "Options:\n",
  55     "  --tree=NAME     tree name\n",
  56     "  --config        report scheduler configuration\n",
  57     "  --runtime       report scheduler runtime statistics\n",
  58     "  --clear         clear scheduler statistics for specific tree\n",
  59     "  --help          this help message\n";
  60     exit 1;
  61 }
  62
  63
  64 if( not Torrus::SiteConfig::treeExists( $tree ) )
  65 {
  66     Error('Tree ' . $tree . ' does not exist');
  67     exit 1;
  68 }
  69
  70
  71 &Torrus::DB::setSafeSignalHandlers();
  72
  73 if( $clear_treestats )
  74 {
  75     my $stats = new Torrus::SchedulerInfo( -Tree => $tree, -WriteAccess => 1 );
  76     $stats->clearAll();
  77     print STDERR "Statistics cleared for tree $tree\n";
  78     exit 0;
  79 }
  80
  81 thickLine();
  82 printf("Torrus version %s\n", '@VERSION@');
  83 printf("Datasources tree: %s\n", $tree);
  84 printf("Date: %s\n\n", scalar( localtime( time() ) ) );
  85
  86 if( $report_config )
  87 {
  88     my $config_tree = new Torrus::ConfigTree( -TreeName => $tree );
  89     if( not defined($config_tree) )
  90     {
  91         Error("Configuration is not ready");
  92         exit 1;
  93     }
  94
  95     my $stats = { 'collectorLeaves' => {}, 'monitorLeaves' => 0 };
  96
  97     collectStats( $config_tree, $stats );
  98
  99     thickLine();
 100     printf("Scheduler configuration report\n\n");
 101
 102     foreach my $instance ( sort {$a<=>$b} keys %{$stats->{'collectorLeaves'}} )
 103     {
 104         printf("Collector leaves for instance #%d: %d\n",
 105                $instance,
 106                $stats->{'collectorLeaves'}{$instance});
 107     }
 108
 109     printf("Total monitor leaves: %d\n\n", $stats->{'monitorLeaves'});
 110
 111     printf("Scheduled leaves by type:\n");
 112
 113     foreach my $type ( sort keys %{$stats->{'leavesPerType'}} )
 114     {
 115         printf("  %10s  %-10d\n", $type,
 116                $stats->{'leavesPerType'}{$type});
 117     }
 118     printf("\n");
 119
 120     foreach my $instance ( sort {$a<=>$b} keys %{$stats->{'collectorLeaves'}} )
 121     {
 122         if( $stats->{'collectorLeaves'}{$instance} > 0 )
 123         {
 124             &Torrus::DB::checkInterrupted();
 125
 126             printf("Collector execution timeline for instance #%d:\n",
 127                    $instance);
 128             reportTimeline( $stats->{'collectorSchedule'}{$instance} );
 129         }
 130     }
 131
 132     if( $stats->{'monitorLeaves'} > 0 )
 133     {
 134         printf("Monitor execution timeline:\n");
 135         reportTimeline( $stats->{'monitorSchedule'} );
 136     }
 137 }
 138
 139 if( $report_runtime )
 140 {
 141     my @reportFormats =
 142         (
 143          { 'label'   => 'Running Time',
 144            'varname' => 'RunningTime' },
 145
 146          { 'label'   => 'Late Start',
 147            'varname' => 'LateStart' },
 148
 149          { 'label'   => 'Too Long',
 150            'varname' => 'TooLong' },
 151
 152          { 'label'   => 'RRD Queue',
 153            'varname' => 'RRDQueue' },
 154
 155          { 'label'   => 'Raw Queue',
 156            'varname' => 'RawQueue' }
 157
 158          );
 159
 160     my @counterFormats =
 161         (
 162          { 'label'   => 'running cycles passed',
 163            'varname' => 'NTimesRunningTime' },
 164
 165          { 'label'   => 'late starts',
 166            'varname' => 'NTimesLateStart' },
 167
 168          { 'label'   => 'too long runs',
 169            'varname' => 'NTimesTooLong' },
 170
 171          { 'label'   => 'overrun periods',
 172            'varname' => 'CountOverrunPeriods' },
 173
 174          { 'label'   => 'missed periods',
 175            'varname' => 'CountMissedPeriods' }
 176          );
 177
 178     my $sInfo = new Torrus::SchedulerInfo( '-Tree' => $tree );
 179     exit(1) if not defined( $sInfo );
 180
 181     my $stats = $sInfo->readStats();
 182
 183     thickLine();
 184     printf("Scheduler runtime report\n\n");
 185
 186     my $periodicTasks = {};
 187     foreach my $taskId ( keys %{$stats} )
 188     {
 189         my ($type, $taskName, $instance, $period, $offset) =
 190             split( ':', $taskId );
 191         if( $type eq 'P' )
 192         {
 193             $periodicTasks->{$taskName}{$instance}{$period}{$offset} = $taskId;
 194         }
 195     }
 196
 197     foreach my $taskName ( sort keys %{$periodicTasks} )
 198     {
 199         foreach my $instance ( sort {$a<=>$b}
 200                                keys %{$periodicTasks->{$taskName}} )
 201         {
 202             foreach my $period
 203                 ( sort {$a<=>$b}
 204                   keys %{$periodicTasks->{$taskName}{$instance}} )
 205             {
 206                 foreach my $offset
 207                     ( sort {$a<=>$b}
 208                       keys %{$periodicTasks->{$taskName}{$instance}{$period}} )
 209                 {
 210                     &Torrus::DB::checkInterrupted();
 211
 212                     my $taskId =
 213                         $periodicTasks->{$taskName}{$instance}{
 214                             $period}{$offset};
 215                     my $ref = $stats->{$taskId};
 216
 217                     printf("Task: %s, Instance: %d, " .
 218                            "Period: %d seconds, Offset: %d seconds\n",
 219                            $taskName, $instance, $period, $offset);
 220
 221                     foreach my $format ( @counterFormats )
 222                     {
 223                         if( defined( $ref->{$format->{'varname'}} ) )
 224                         {
 225                             printf("%5d %s\n",
 226                                    $ref->{$format->{'varname'}},
 227                                    $format->{'label'} );
 228                         }
 229                     }
 230
 231                     thinLine();
 232                     printf("%-15s%-10s%-10s%-10s%-10s\n",
 233                            '', 'Min', 'Max', 'Average', 'Exp Average');
 234
 235                     foreach my $format ( @reportFormats )
 236                     {
 237                         my $varname =  $format->{'varname'};
 238                         if( defined( $ref->{'Min' . $varname} ) )
 239                         {
 240                             printf("%-15s%-10d%-10d%-10.1f%-10.1f\n",
 241                                    $format->{'label'},
 242                                    $ref->{'Min' . $varname},
 243                                    $ref->{'Max' . $varname},
 244                                    $ref->{'Avg' . $varname},
 245                                    $ref->{'ExpAvg' . $varname});
 246                         }
 247                     }
 248
 249                     thinLine();
 250                     printf("\n");
 251                 }
 252             }
 253         }
 254     }
 255 }
 256
 257 thickLine();
 258 exit 0;
 259
 260
 261 sub collectStats
 262 {
 263     my $config_tree = shift;
 264     my $stats = shift;
 265     my $token = shift;
 266
 267     if( not defined( $token ) )
 268     {
 269         $token = $config_tree->token('/');
 270     }
 271
 272     my @children = $config_tree->getChildren( $token );
 273
 274     foreach my $ctoken ( @children )
 275     {
 276         &Torrus::DB::checkInterrupted();
 277
 278         if( $config_tree->isSubtree( $ctoken ) )
 279         {
 280             collectStats( $config_tree, $stats, $ctoken );
 281         }
 282         elsif( $config_tree->isLeaf( $ctoken ) )
 283         {
 284             if( $config_tree->getNodeParam( $ctoken, 'ds-type' )
 285                 eq 'collector' )
 286             {
 287                 my $instance =
 288                     $config_tree->getNodeParam
 289                     ( $ctoken, 'collector-instance' );
 290
 291                 $stats->{'collectorLeaves'}{$instance}++;
 292
 293                 my $type = 'c:' .
 294                     $config_tree->getNodeParam( $ctoken, 'collector-type' );
 295
 296                 my $period =
 297                     $config_tree->getNodeParam( $ctoken, 'collector-period' );
 298                 $period = int( $period ); # make sure we're talking integers
 299
 300                 my $offset = $config_tree->
 301                     getNodeParam( $ctoken, 'collector-timeoffset' );
 302
 303                 $stats->{'leavesPerType'}{$type}++;
 304                 $stats->{'collectorSchedule'}{$instance}{$period}{
 305                     $offset}{$type}++;
 306             }
 307
 308             if( defined( $config_tree->getNodeParam( $ctoken, 'monitor' ) ) )
 309             {
 310                 $stats->{'monitorLeaves'}++;
 311                 my $type = 'monitor';
 312
 313                 my $period =
 314                     $config_tree->getNodeParam( $ctoken, 'monitor-period' );
 315                 $period = int( $period ); # make sure we're talking integers
 316
 317                 my $offset = $config_tree->
 318                     getNodeParam( $ctoken, 'monitor-timeoffset' );
 319                 $offset = int($offset) % $period;
 320
 321                 $stats->{'leavesPerType'}{$type}++;
 322                 $stats->{'monitorSchedule'}{$period}{$offset}{$type}++;
 323             }
 324         }
 325     }
 326 }
 327
 328
 329 # caluclate and print the schedule
 330 sub reportTimeline
 331 {
 332     my $schedule = shift;
 333
 334     # calculate the common period length (least common multiple)
 335     my $lcm = 0;
 336     foreach my $period ( keys %{$schedule} )
 337     {
 338         my $a = $period;
 339         my $b = $lcm;
 340         my $c;
 341         if( $b == 0 )
 342         {
 343             $lcm = $a;
 344         }
 345         else
 346         {
 347             if( $a < $b )
 348             {
 349                 my $tmp = $b;
 350                 $b = $a;
 351                 $a = $tmp;
 352             }
 353             while( $b != 0 )
 354             {
 355                 $c = $a % $b;
 356                 $a = $b;
 357                 $b = $c;
 358             }
 359             $lcm = $lcm * $period / $a;
 360         }
 361     }
 362
 363     printf("Least common period: %d seconds\n", $lcm);
 364
 365     # populate the common period
 366     my %cp;
 367     my $chunks = 0;
 368     foreach my $period ( keys %{$schedule} )
 369     {
 370         foreach my $offset ( keys %{$schedule->{$period}} )
 371         {
 372             $chunks++;
 373             foreach my $type ( keys %{$schedule->{$period}{$offset}} )
 374             {
 375                 for( my $i = 0; $i < ($lcm / $period); $i++ )
 376                 {
 377                     $cp{$i * $period + $offset}{'col'}{$type} +=
 378                         $schedule->{$period}{$offset}{$type};
 379                 }
 380             }
 381         }
 382     }
 383     printf("Number of chunks: %d \n\n", $chunks );
 384
 385     # calculate interval lengths
 386
 387     my $previous;
 388     my $first;
 389     foreach my $time ( sort { $a <=> $b } keys %cp )
 390     {
 391         if( not defined($first) )
 392         {
 393             $first = $time;
 394         }
 395         else
 396         {
 397             $cp{$previous}{'endtime'} = $time;
 398         }
 399         $previous = $time;
 400     }
 401     $cp{$previous}{'endtime'} = $lcm + $first;
 402
 403     # print results
 404
 405     thinLine();
 406     printf("%-10s%-10s%-20s%-10s\n",
 407            'Offset', 'Interval', 'Type', 'Data');
 408     printf("%-10s%-10s%-20s%-10s\n",
 409            '(sec)', '(sec)', '', 'sources');
 410     thinLine();
 411
 412     foreach my $time ( sort { $a <=> $b } keys %cp )
 413     {
 414         foreach my $type ( keys %{$cp{$time}{'col'}} )
 415         {
 416             printf("%-10d%-10d%-20s%-10d\n",
 417                    $time,
 418                    $cp{$time}{'endtime'} - $time,
 419                    $type,
 420                    $cp{$time}{'col'}{$type} );
 421         }
 422     }
 423     thinLine();
 424     printf("\n");
 425 }
 426
 427
 428 sub thickLine
 429 {
 430     foreach my $i ( 1..75 )
 431     {
 432         print '=';
 433     }
 434     print "\n";
 435 }
 436
 437 sub thinLine
 438 {
 439     foreach my $i ( 1..70 )
 440     {
 441         print '-';
 442     }
 443     print "\n";
 444 }
 445
 446
 447
 448
 449
 450 # Local Variables:
 451 # mode: perl
 452 # indent-tabs-mode: nil
 453 # perl-indent-level: 4
 454 # End: