view release on metacpan or  search on metacpan

lib/RRDTool/OO.pm  view on Meta::CPAN

            optional => [qw(legend)],
        },
    },
    fetch_start=> { mandatory => [qw()],
                    optional  => [qw(cfunc start end resolution)],
                  },
    fetch_next => { mandatory => [],
                    optional  => [],
                  },
    dump       => { mandatory => [],
                    optional  => [],
                  },
    restore    => { mandatory => [qw()],
                    optional  => [qw(xml range_check)],
                  },
    tune       => { mandatory => [],
                    optional  => [qw(heartbeat minimum maximum 
                                     type name)],
                  },
    first      => { mandatory => [],
                    optional  => [],
                  },
    last       => { mandatory => [],
                    optional  => [],
                  },
    info       => { mandatory => [],
                    optional  => [],
                  },
    rrdresize  => { mandatory => [],
                    optional  => [],
                  },
    rrdcgi     => { mandatory => [],
                    optional  => [],
                  },
};

my %RRDs_functions = (
    create    => \&RRDs::create,
    fetch     => \&RRDs::fetch,
    update    => \&RRDs::update,
    updatev   => \&RRDs::updatev,
    graph     => \&RRDs::graph,
    graphv    => \&RRDs::graphv,
    info      => \&RRDs::info,
    dump      => \&RRDs::dump,
    restore   => \&RRDs::restore,
    tune      => \&RRDs::tune,
    first     => \&RRDs::first,
    last      => \&RRDs::last,
    info      => \&RRDs::info,
    rrdresize => \&RRDs::rrdresize,
    xport     => \&RRDs::xport,
    rrdcgi    => \&RRDs::rrdcgi,
);

#################################################
sub option_add {
#################################################
    my($self, $method, @options) = @_;

    my @parts = split m#/#, $method;
    my $ref = $OPTIONS;
    $ref = $ref->{$_} for @parts;

    push @{ $ref->{optional} }, $_ for @options;
}

#################################################
sub check_options {
#################################################
    my($self, $method, $options) = @_;

    $options = [] unless defined $options;

    my %options_hash = (@$options);

    my @parts = split m#/#, $method;

    my $ref = $OPTIONS;

    $ref = $ref->{$_} for @parts;

    my %optional  = map { $_ => 1 } @{$ref->{optional}};
    my %mandatory = map { $_ => 1 } @{$ref->{mandatory}};

        # Check if we got all mandatory parameters
    for(@{$ref->{mandatory}}) {
        if(! exists $options_hash{$_}) {
            Log::Log4perl->get_logger("")->logcroak(
                "Mandatory parameter '$_' not set " .
                "in $method() (@{[%mandatory]}) (@$options)");
        }
    }
    
        # Check if all of the optional parameters we got are indeed
        # valid optional parameters
    if($self->{strict}) {
        for(keys %options_hash) {
            if(! exists $optional{$_} and
               ! exists $mandatory{$_}) {
                Log::Log4perl->get_logger("")->logcroak(
                    "Illegal parameter '$_' in $method()");
            }
        }
    }

    1;
}

#################################################
sub new {
#################################################
    my($class, %options) = @_;

    my $self = {
        raise_error        => 1,
        strict             => 1,
        dry_run            => 0,
        exec_subref        => undef,
        exec_args          => [],
        exec_func          => [],
        print_results      => [],
        meta               => 
            { discovered   => 0,
              cfuncs       => [],
              cfuncs_hash  => {},
              dsnames      => [],
              dsnames_hash => {},
            },
        %options,
    };

    bless $self, $class;

      # For this one, we need to be strict
    local $self->{strict} = 1;
    $self->check_options("new", [%options]);