contrib/collection3/lib/Collectd/Graph/Common.pm

   1 package Collectd::Graph::Common;
   2
   3 use strict;
   4 use warnings;
   5
   6 use vars (qw($ColorCanvas $ColorFullBlue $ColorHalfBlue));
   7
   8 use Carp (qw(confess cluck));
   9 use CGI (':cgi');
  10 use Exporter;
  11
  12 $ColorCanvas   = 'FFFFFF';
  13 $ColorFullBlue = '0000FF';
  14 $ColorHalfBlue = 'B7B7F7';
  15
  16 @Collectd::Graph::Common::ISA = ('Exporter');
  17 @Collectd::Graph::Common::EXPORT_OK = (qw(
  18   $ColorCanvas
  19   $ColorFullBlue
  20   $ColorHalfBlue
  21
  22   sanitize_hostname
  23   sanitize_plugin sanitize_plugin_instance
  24   sanitize_type sanitize_type_instance
  25   group_files_by_plugin_instance
  26   get_files_from_directory
  27   filename_to_ident
  28   ident_to_filename
  29   ident_to_string
  30   get_all_hosts
  31   get_files_for_host
  32   get_files_by_ident
  33   get_selected_files
  34   get_timespan_selection
  35   get_host_selection
  36   get_plugin_selection
  37   get_faded_color
  38   sort_idents_by_type_instance
  39   type_to_module_name
  40   epoch_to_rfc1123
  41 ));
  42
  43 our $DataDir = '/var/lib/collectd/rrd';
  44
  45 return (1);
  46
  47 sub _sanitize_generic_allow_minus
  48 {
  49   my $str = "" . shift;
  50
  51   # remove all slashes
  52   $str =~ s#/##g;
  53
  54   # remove all dots and dashes at the beginning and at the end.
  55   $str =~ s#^[\.-]+##;
  56   $str =~ s#[\.-]+$##;
  57
  58   return ($str);
  59 }
  60
  61 sub _sanitize_generic_no_minus
  62 {
  63   # Do everything the allow-minus variant does..
  64   my $str = _sanitize_generic_allow_minus (@_);
  65
  66   # .. and remove the dashes, too
  67   $str =~ s#/##g;
  68
  69   return ($str);
  70 } # _sanitize_generic_no_minus
  71
  72 sub sanitize_hostname
  73 {
  74   return (_sanitize_generic_allow_minus (@_));
  75 }
  76
  77 sub sanitize_plugin
  78 {
  79   return (_sanitize_generic_no_minus (@_));
  80 }
  81
  82 sub sanitize_plugin_instance
  83 {
  84   return (_sanitize_generic_allow_minus (@_));
  85 }
  86
  87 sub sanitize_type
  88 {
  89   return (_sanitize_generic_no_minus (@_));
  90 }
  91
  92 sub sanitize_type_instance
  93 {
  94   return (_sanitize_generic_allow_minus (@_));
  95 }
  96
  97 sub group_files_by_plugin_instance
  98 {
  99   my @files = @_;
 100   my $data = {};
 101
 102   for (my $i = 0; $i < @files; $i++)
 103   {
 104     my $file = $files[$i];
 105     my $key = $file->{'plugin_instance'} || '';
 106
 107     $data->{$key} ||= [];
 108     push (@{$data->{$key}}, $file);
 109   }
 110
 111   return ($data);
 112 }
 113
 114 sub filename_to_ident
 115 {
 116   my $file = shift;
 117   my $ret;
 118
 119   if ($file =~ m#([^/]+)/([^/\-]+)(?:-([^/]+))?/([^/\-]+)(?:-([^/]+))?\.rrd$#)
 120   {
 121     $ret = {hostname => $1, plugin => $2, type => $4};
 122     if (defined ($3))
 123     {
 124       $ret->{'plugin_instance'} = $3;
 125     }
 126     if (defined ($5))
 127     {
 128       $ret->{'type_instance'} = $5;
 129     }
 130     if ($`)
 131     {
 132       $ret->{'_prefix'} = $`;
 133     }
 134   }
 135   else
 136   {
 137     return;
 138   }
 139
 140   return ($ret);
 141 } # filename_to_ident
 142
 143 sub ident_to_filename
 144 {
 145   my $ident = shift;
 146
 147   my $ret = '';
 148
 149   if (defined ($ident->{'_prefix'}))
 150   {
 151     $ret .= $ident->{'_prefix'};
 152   }
 153   else
 154   {
 155     $ret .= "$DataDir/";
 156   }
 157
 158   if (!$ident->{'hostname'})
 159   {
 160     cluck ("hostname is undefined")
 161   }
 162   if (!$ident->{'plugin'})
 163   {
 164     cluck ("plugin is undefined")
 165   }
 166   if (!$ident->{'type'})
 167   {
 168     cluck ("type is undefined")
 169   }
 170
 171   $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
 172   if (defined ($ident->{'plugin_instance'}))
 173   {
 174     $ret .= '-' . $ident->{'plugin_instance'};
 175   }
 176
 177   $ret .= '/' . $ident->{'type'};
 178   if (defined ($ident->{'type_instance'}))
 179   {
 180     $ret .= '-' . $ident->{'type_instance'};
 181   }
 182   $ret .= '.rrd';
 183
 184   return ($ret);
 185 } # ident_to_filename
 186
 187 sub ident_to_string
 188 {
 189   my $ident = shift;
 190
 191   my $ret = '';
 192
 193   $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
 194   if (defined ($ident->{'plugin_instance'}))
 195   {
 196     $ret .= '-' . $ident->{'plugin_instance'};
 197   }
 198
 199   $ret .= '/' . $ident->{'type'};
 200   if (defined ($ident->{'type_instance'}))
 201   {
 202     $ret .= '-' . $ident->{'type_instance'};
 203   }
 204
 205   return ($ret);
 206 } # ident_to_string
 207
 208 sub get_files_from_directory
 209 {
 210   my $dir = shift;
 211   my $recursive = @_ ? shift : 0;
 212   my $dh;
 213   my @directories = ();
 214   my $ret = [];
 215
 216   opendir ($dh, $dir) or die ("opendir ($dir): $!");
 217   while (my $entry = readdir ($dh))
 218   {
 219     next if ($entry =~ m/^\./);
 220
 221     $entry = "$dir/$entry";
 222
 223     if (-d $entry)
 224     {
 225       push (@directories, $entry);
 226     }
 227     elsif (-f $entry)
 228     {
 229       my $ident = filename_to_ident ($entry);
 230       if ($ident)
 231       {
 232         push (@$ret, $ident);
 233       }
 234     }
 235   }
 236   closedir ($dh);
 237
 238   if ($recursive > 0)
 239   {
 240     for (@directories)
 241     {
 242       my $temp = get_files_from_directory ($_, $recursive - 1);
 243       if ($temp && @$temp)
 244       {
 245         push (@$ret, @$temp);
 246       }
 247     }
 248   }
 249
 250   return ($ret);
 251 } # get_files_from_directory
 252
 253 sub get_all_hosts
 254 {
 255   my $dh;
 256   my @ret = ();
 257
 258   opendir ($dh, "$DataDir") or confess ("opendir ($DataDir): $!");
 259   while (my $entry = readdir ($dh))
 260   {
 261     next if ($entry =~ m/^\./);
 262     next if (!-d "$DataDir/$entry");
 263     push (@ret, sanitize_hostname ($entry));
 264   }
 265   closedir ($dh);
 266
 267   if (wantarray ())
 268   {
 269     return (@ret);
 270   }
 271   elsif (@ret)
 272   {
 273     return (\@ret);
 274   }
 275   else
 276   {
 277     return;
 278   }
 279 } # get_all_hosts
 280
 281 sub get_all_plugins
 282 {
 283   my @hosts = @_;
 284   my $ret = {};
 285   my $dh;
 286
 287   if (!@hosts)
 288   {
 289     @hosts = get_all_hosts ();
 290   }
 291
 292   for (@hosts)
 293   {
 294     my $host = $_;
 295     opendir ($dh, "$DataDir/$host") or next;
 296     while (my $entry = readdir ($dh))
 297     {
 298       my $plugin;
 299       my $plugin_instance = '';
 300
 301       next if ($entry =~ m/^\./);
 302       next if (!-d "$DataDir/$host/$entry");
 303
 304       if ($entry =~ m#^([^-]+)-(.+)$#)
 305       {
 306         $plugin = $1;
 307         $plugin_instance = $2;
 308       }
 309       elsif ($entry =~ m#^([^-]+)$#)
 310       {
 311         $plugin = $1;
 312         $plugin_instance = '';
 313       }
 314       else
 315       {
 316         next;
 317       }
 318
 319       $ret->{$plugin} ||= {};
 320       $ret->{$plugin}{$plugin_instance} = 1;
 321     } # while (readdir)
 322     closedir ($dh);
 323   } # for (@hosts)
 324
 325   if (wantarray ())
 326   {
 327     return (sort (keys %$ret));
 328   }
 329   else
 330   {
 331     return ($ret);
 332   }
 333 } # get_all_plugins
 334
 335 sub get_files_for_host
 336 {
 337   my $host = sanitize_hostname (shift);
 338   return (get_files_from_directory ("$DataDir/$host", 2));
 339 } # get_files_for_host
 340
 341 sub _filter_ident
 342 {
 343   my $filter = shift;
 344   my $ident = shift;
 345
 346   for (qw(hostname plugin plugin_instance type type_instance))
 347   {
 348     my $part = $_;
 349     my $tmp;
 350
 351     if (!defined ($filter->{$part}))
 352     {
 353       next;
 354     }
 355     if (!defined ($ident->{$part}))
 356     {
 357       return (1);
 358     }
 359
 360     if (ref $filter->{$part})
 361     {
 362       if (!grep { $ident->{$part} eq $_ } (@{$filter->{$part}}))
 363       {
 364         return (1);
 365       }
 366     }
 367     else
 368     {
 369       if ($ident->{$part} ne $filter->{$part})
 370       {
 371         return (1);
 372       }
 373     }
 374   }
 375
 376   return (0);
 377 } # _filter_ident
 378
 379 sub get_files_by_ident
 380 {
 381   my $ident = shift;
 382   my $all_files;
 383   my @ret = ();
 384
 385   #if ($ident->{'hostname'})
 386   #{
 387   #$all_files = get_files_for_host ($ident->{'hostname'});
 388   #}
 389   #else
 390   #{
 391     $all_files = get_files_from_directory ($DataDir, 3);
 392     #}
 393
 394   @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
 395
 396   return (\@ret);
 397 } # get_files_by_ident
 398
 399 sub get_selected_files
 400 {
 401   my $ident = {};
 402
 403   for (qw(hostname plugin plugin_instance type type_instance))
 404   {
 405     my $part = $_;
 406     my @temp = param ($part);
 407     if (!@temp)
 408     {
 409       next;
 410     }
 411     elsif (($part eq 'plugin') || ($part eq 'type'))
 412     {
 413       $ident->{$part} = [map { _sanitize_generic_no_minus ($_) } (@temp)];
 414     }
 415     else
 416     {
 417       $ident->{$part} = [map { _sanitize_generic_allow_minus ($_) } (@temp)];
 418     }
 419   }
 420
 421   return (get_files_by_ident ($ident));
 422 } # get_selected_files
 423
 424 sub get_timespan_selection
 425 {
 426   my $ret = 86400;
 427   if (param ('timespan'))
 428   {
 429     my $temp = int (param ('timespan'));
 430     if ($temp && ($temp > 0))
 431     {
 432       $ret = $temp;
 433     }
 434   }
 435
 436   return ($ret);
 437 } # get_timespan_selection
 438
 439 sub get_host_selection
 440 {
 441   my %ret = ();
 442
 443   for (get_all_hosts ())
 444   {
 445     $ret{$_} = 0;
 446   }
 447
 448   for (param ('hostname'))
 449   {
 450     my $host = _sanitize_generic_allow_minus ($_);
 451     if (defined ($ret{$host}))
 452     {
 453       $ret{$host} = 1;
 454     }
 455   }
 456
 457   if (wantarray ())
 458   {
 459     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 460   }
 461   else
 462   {
 463     return (\%ret);
 464   }
 465 } # get_host_selection
 466
 467 sub get_plugin_selection
 468 {
 469   my %ret = ();
 470   my @hosts = get_host_selection ();
 471
 472   for (get_all_plugins (@hosts))
 473   {
 474     $ret{$_} = 0;
 475   }
 476
 477   for (param ('plugin'))
 478   {
 479     if (defined ($ret{$_}))
 480     {
 481       $ret{$_} = 1;
 482     }
 483   }
 484
 485   if (wantarray ())
 486   {
 487     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 488   }
 489   else
 490   {
 491     return (\%ret);
 492   }
 493 } # get_plugin_selection
 494
 495 sub _string_to_color
 496 {
 497   my $color = shift;
 498   if ($color =~ m/([0-9A-Fa-f][0-9A-Fa-f])([0-9A-Fa-f][0-9A-Fa-f])([0-9A-Fa-f][0-9A-Fa-f])/)
 499   {
 500     return ([hex ($1) / 255.0, hex ($2) / 255.0, hex ($3) / 255.0]);
 501   }
 502   return;
 503 } # _string_to_color
 504
 505 sub _color_to_string
 506 {
 507   confess ("Wrong number of arguments") if (@_ != 1);
 508   return (sprintf ('%02hx%02hx%02hx', map { int (255.0 * $_) } @{$_[0]}));
 509 } # _color_to_string
 510
 511 sub get_faded_color
 512 {
 513   my $fg = shift;
 514   my $bg;
 515   my %opts = @_;
 516   my $ret = [undef, undef, undef];
 517
 518   $opts{'background'} ||= [1.0, 1.0, 1.0];
 519   $opts{'alpha'} ||= 0.25;
 520
 521   if (!ref ($fg))
 522   {
 523     $fg = _string_to_color ($fg)
 524       or confess ("Cannot parse foreground color $fg");
 525   }
 526
 527   if (!ref ($opts{'background'}))
 528   {
 529     $opts{'background'} = _string_to_color ($opts{'background'})
 530       or confess ("Cannot parse background color " . $opts{'background'});
 531   }
 532   $bg = $opts{'background'};
 533
 534   for (my $i = 0; $i < 3; $i++)
 535   {
 536     $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
 537        + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
 538   }
 539
 540   return (_color_to_string ($ret));
 541 } # get_faded_color
 542
 543 sub sort_idents_by_type_instance
 544 {
 545   my $idents = shift;
 546   my $array_sort = shift;
 547
 548   my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
 549   splice (@$idents, 0);
 550
 551   for (@$array_sort)
 552   {
 553     next if (!exists ($elements{$_}));
 554     push (@$idents, $elements{$_});
 555     delete ($elements{$_});
 556   }
 557   push (@$idents, map { $elements{$_} } (sort (keys %elements)));
 558 } # sort_idents_by_type_instance
 559
 560 sub type_to_module_name
 561 {
 562   my $type = shift;
 563   my $ret;
 564
 565   $ret = ucfirst (lc ($type));
 566
 567   $ret =~ s/[^A-Za-z_]//g;
 568   $ret =~ s/_([A-Za-z])/\U$1\E/g;
 569
 570   return ("Collectd::Graph::Type::$ret");
 571 } # type_to_module_name
 572
 573 sub epoch_to_rfc1123
 574 {
 575   my @days = (qw(Sun Mon Tue Wed Thu Fri Sat));
 576   my @months = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
 577
 578   my $epoch = @_ ? shift : time ();
 579   my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
 580   my $string = sprintf ('%s, %02d %s %4d %02d:%02d:%02d GMT', $days[$wday], $mday,
 581       $months[$mon], 1900 + $year, $hour ,$min, $sec);
 582   return ($string);
 583 }
 584
 585 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :