view release on metacpan or  search on metacpan

lib/API/DirectAdmin.pm  view on Meta::CPAN

    mysql  => 'Mysql',
    user   => 'User',
    dns    => 'DNS',
    ip     => 'Ip',
);

# init
sub new {
    my $class = shift;
    $class = ref ($class) || $class;
    
    my $self = {
        auth_user   => '',
        auth_passwd => '',
        host        => '',
        ip          => '',
        debug       => $DEBUG,
	    allow_https => 1,
	    fake_answer => $FAKE_ANSWER,
        (@_)
    };

    confess "Required auth_user!"   unless $self->{auth_user};
    confess "Required auth_passwd!" unless $self->{auth_passwd};
    confess "Required host!"        unless $self->{host};

    return bless $self, $class;
}

# initialize components
sub init_components {
    my ( %c ) = @_;
    my $caller = caller;

    for my $alias (  keys %c ) {

        my $item = $c{$alias};

        my $sub = sub {
            my( $self ) = @_;
            $self->{"_$alias"} ||= $self->load_component($item);
            return $self->{"_$alias"} || confess "Not implemented!";
        };
        
        no strict 'refs';
 
        *{"$caller\::$alias"} = $sub;
    }
}

# loads component package and creates object
sub load_component {
    my ( $self, $item ) = @_;

    my $pkg = ref($self) . '::' . $item;

    my $module = "$pkg.pm";
       $module =~ s/::/\//g;

    local $@;
    eval { require $module };
    if ( $@ ) {
	confess "Failed to load $pkg: $@";
    }

    return $pkg->new(directadmin => $self);

}

# Filter hash
# STATIC(HASHREF: hash, ARRREF: allowed_keys)
# RETURN: hashref only with allowed keys
sub filter_hash {
    my ($self, $hash, $allowed_keys) = @_;
    
    return {} unless defined $hash;
    
    confess "Wrong params" unless ref $hash eq 'HASH' && ref $allowed_keys eq 'ARRAY';

    my $new_hash = { };

    foreach my $allowed_key (@$allowed_keys) {
        if (exists $hash->{$allowed_key}) {
            $new_hash->{$allowed_key} = $hash->{$allowed_key};
        }
        elsif (exists $hash->{lc $allowed_key}) {
            $new_hash->{$allowed_key} = $hash->{lc $allowed_key};
        };
    }

    return $new_hash;
}

# all params derived from get_auth_hash
sub query {
    my ( $self, %params ) = @_;

    my $command   = delete $params{command};
    my $fields    = $params{allowed_fields} || '';

    my $allowed_fields;
    warn 'query_abstract ' . Dumper( \%params ) if $self->{debug};

    confess "Empty command" unless $command;

    $fields = "host port auth_user auth_passwd method allow_https command $fields";
    @$allowed_fields = split /\s+/, $fields;

    my $params = $self->filter_hash( $params{params}, $allowed_fields );

    my $query_string = $self->mk_full_query_string( {
        command => $command,
        %$params,
    } );

    carp Dumper $query_string if $self->{debug};
    
    my $server_answer =  $self->process_query(
        method        => $params{method} || 'GET',
        query_string  => $query_string,
        params 	      => $params,