1# This program is copyright 2010-2011 Percona Ireland Ltd. 2# Feedback and improvements are welcome. 3# 4# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED 5# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF 6# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 7# 8# This program is free software; you can redistribute it and/or modify it under 9# the terms of the GNU General Public License as published by the Free Software 10# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar 11# systems, you can issue `man perlgpl' or `man perlartistic' to read these 12# licenses. 13# 14# You should have received a copy of the GNU General Public License along with 15# this program; if not, write to the Free Software Foundation, Inc., 59 Temple 16# Place, Suite 330, Boston, MA 02111-1307 USA. 17# ########################################################################### 18# AdvisorRules package 19# ########################################################################### 20{ 21# Package: AdvisorRules 22# AdvisorRules is a parent class for advisor rule modules like 23# <QueryAdivsorRules>. 24package AdvisorRules; 25 26use strict; 27use warnings FATAL => 'all'; 28use English qw(-no_match_vars); 29use constant PTDEBUG => $ENV{PTDEBUG} || 0; 30 31sub new { 32 my ( $class, %args ) = @_; 33 foreach my $arg ( qw(PodParser) ) { 34 die "I need a $arg argument" unless $args{$arg}; 35 } 36 my $self = { 37 %args, 38 rules => [], 39 rule_info => {}, 40 }; 41 return bless $self, $class; 42} 43 44# Arguments: 45# * file scalar: file name with POD to parse rules from 46# * section scalar: section name for rule items, should be RULES 47# * rules arrayref: optional list of rules to load info for 48# Parses rules from the POD section/subsection in file, adding rule 49# info found therein to %rule_info. Then checks that rule info 50# was gotten for all the required rules. 51sub load_rule_info { 52 my ( $self, %args ) = @_; 53 foreach my $arg ( qw(file section ) ) { 54 die "I need a $arg argument" unless $args{$arg}; 55 } 56 my $rules = $args{rules} || $self->{rules}; 57 my $p = $self->{PodParser}; 58 59 # Parse rules and their info from the file's POD, saving 60 # values to %rule_info. 61 $p->parse_from_file($args{file}); 62 my $rule_items = $p->get_items($args{section}); 63 my %seen; 64 foreach my $rule_id ( keys %$rule_items ) { 65 my $rule = $rule_items->{$rule_id}; 66 die "Rule $rule_id has no description" unless $rule->{desc}; 67 die "Rule $rule_id has no severity" unless $rule->{severity}; 68 die "Rule $rule_id is already defined" 69 if exists $self->{rule_info}->{$rule_id}; 70 $self->{rule_info}->{$rule_id} = { 71 id => $rule_id, 72 severity => $rule->{severity}, 73 description => $rule->{desc}, 74 }; 75 } 76 77 # Check that rule info was gotten for each requested rule. 78 foreach my $rule ( @$rules ) { 79 die "There is no info for rule $rule->{id} in $args{file}" 80 unless $self->{rule_info}->{ $rule->{id} }; 81 } 82 83 return; 84} 85 86sub get_rule_info { 87 my ( $self, $id ) = @_; 88 return unless $id; 89 return $self->{rule_info}->{$id}; 90} 91 92# Used for testing. 93sub _reset_rule_info { 94 my ( $self ) = @_; 95 $self->{rule_info} = {}; 96 return; 97} 98 99sub _d { 100 my ($package, undef, $line) = caller 0; 101 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } 102 map { defined $_ ? $_ : 'undef' } 103 @_; 104 print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; 105} 106 1071; 108} 109# ########################################################################### 110# End AdvisorRules package 111# ########################################################################### 112