Mon::Protocol - Methods for parsing / dumping a protocol block

Mon documentation Contained in the Mon distribution.

Index

Code Index:

NAME

Top

Mon::Protocol - Methods for parsing / dumping a protocol block

SYNOPSIS

Top

    use Mon::Protocol;

DESCRIPTION

Top

METHODS

Top

new

Creates a new object. A hash can be supplied which sets the default values. An example which contains all of the variables that you can initialize:

    $c = new Mon::Protocol;
dump_data

Returns the current internal structure as a string dump suitable for passing to parse_data.

parse_data

Parses a command block (from begin_block to end_block), as generated by dump_data.

type(new_type)

Sets or returns the type of the current command block. See @TYPES for valid type codes.

In the future, it is possible that this module will perform additional checking based on the type, for now it is left to the application to interpret this.

get_section_list

Returns an array containing all section names within the block.

get_section(section_name)

Returns a hash containing the key/value pairs of the specific section.

delete_section(section_name)

Completely removes the specified section from the block.

add_to_section(section_name,$hash_ref)

Adds the key/value pairs in the hash to the specified section.

	$foo->add_to_section("_hostgroup", { "ns1.baz.com" -> "ok" });
delete_from_section(section_name,$key)

Deletes the key/value pair from the section.

	$foo->delete_from_section("_hostgroup", "ns1.baz.com");
error

Should any of the functions return an error (-1), this function can be used to retrieve a more elaborate error message and to reset the internal error state.

Mon documentation Contained in the Mon distribution. 
#
# Perl module for parsing / dumping a mon protocol block
#
# $Id: Protocol.pm 1.3 Thu, 11 Jan 2001 08:42:17 -0800 trockij $
#
# Copyright (C) 1999 Lars Marowsky-Brée <lmb@teuto.net>
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#

package Mon::Protocol;
require Exporter;
require 5.004;
use IO::File;
use Socket;
use Text::ParseWords;

sub new;
sub dump_data;
sub parse_data;
sub type;
sub get_section;
sub get_section_list;
sub add_to_section;
sub delete_section;
sub delete_from_section;
sub error;
sub DESTROY;
sub _esc_str;
sub _un_esc_str;

@ISA = qw(Exporter);
@EXPORT_OK = qw($VERSION @);

$VERSION = "0.11";

@TYPES = qw(cmd_monitor cmd_alert cmd_logger res_monitor res_alert res_logger);

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    my %vars = @_;

    $self->{'type'} = $vars{'type'} || "UNKNOWN";
    
    bless ($self, $class);
    return $self;
}


sub dump_data {
    my ($self) = shift;

    my ($tmp);

    $tmp.="begin_block=".$self->{'type'}."\n";

    my ($section);
    foreach $section (sort keys %{$self->{'data'}}) {
       $tmp.="begin=".$section."\n";

       my ($key,$data);

       while ( ($key,$data) = each %{$self->{'data'}->{$section}} ) {
	  $tmp .= "$key=". _esc_str ($data) . "\n";
       }
       $tmp.="end=".$section."\n";
       
    }
    
    $tmp.="end_block=".$self->{'type'}."\n";

    return $tmp;
}


sub parse_data {
    my ($self) = shift;
    
    my ($raw) = @_;
    my (@l) = split(/\n/o,$raw);
    
    my ($l,%tmp,$type);

    $l = shift @l;

    if ($l =~ /^begin_block=(\S+)$/oi) {
       $type = lc($1);
    } else {
       $self->{'error'} = "No begin_block found";
       return -1;
    }
    
    my ($section,$in_section) = ("",0);
LINE:    while ($l = shift @l) {
       next if ($l =~ /^\s*$/o);
       if ($in_section == 0) {
          if ($l =~ /^begin=(\S+)$/oi) {
	     $section = lc($1);
	     $in_section = 1;
	  } elsif ($l =~ /^end_block=(\S+)$/oi) {
	     if (lc($1) eq $type) {
	        $in_section = -1;
		last LINE;
	     } else {
	        $self->{'error'} = "end_block does not match begin.";
	        return -1;
	     }
	  } else {
	    $self->{'error'} = "Garbled input at global level.";
	    return -1;
	  }
       } else {
         if ($l =~ /^end=(\S+)$/oi) {
	    if (lc($1) eq $section) {
	       $in_section = 0;
	       $section = "";
	       next LINE;
	    } else {
	       $self->{'error'} = "end section does not match begin.";
	       return -1;
	    }
	 }
	 
	 my ($key,$value);
	 
	 if (($key,$value) = $l =~ /^([^=]+)=(.*)/o) {
	    $key = lc($key);
	    $tmp{$section}{$key} = _un_esc_str ($value);
	 } else {
	    $self->{'error'} = "Garbled input at section level: $l";
	    return -1;
	 }
       }
       
    }
    
    $self->{'type'} = $type;
    %{$self->{'data'}} = %tmp;
    
    return 0;
}

sub type {
    my ($self) = shift;

    if (@_) { 
       my ($type) = lc(shift);

       if (grep($_ eq $type,@TYPES)) {
          $self->{'type'} = $type;
       } else {
          $self->{'type'} = "UNKNOWN";
	  $self->{'error'} = "Unknown type supplied.";
	  return -1;
       }
    }

    return $self->{'type'};
}

sub get_section {
    my ($self) = shift;
    my ($section) = lc(shift);
    
    if (defined($self->{'data'}->{$section})) {
       return %{$self->{'data'}->{$section}}; 
    } else {
       $self->{'error'} = "$section: No such section.";
       return -1;
    }
}

sub get_section_list {
    my ($self) = shift;
    return sort keys %{$self->{'data'}};
}

sub add_to_section {
    my ($self) = shift;
    
    my $section = lc(shift);
    my ($rdata) = @_;
    
    my ($key,$value);
    while ( ($key,$value) = each %$rdata) {
       $key = lc($key);
       $self->{'data'}->{$section}->{$key} = $value;   
    }
    
    return 1;
}

sub delete_section {
    my ($self) = shift;
    my ($section) = lc(shift);
    
    if (defined($self->{'data'}->{$section})) {
       delete $self->{'data'}->{$section};
       return 0; 
    } else {
       $self->{'error'} = "$section: No such section.";
       return -1;
    }
}

sub delete_from_section {
    my ($self) = shift;
    my ($section) = lc(shift);
    my ($key) = lc(shift);
    
    if (defined($self->{'data'}->{$section}->{$key})) {
       delete $self->{'data'}->{$section}->{$key};
       return 0; 
    } else {
       $self->{'error'} = "$section/$key: No such key in section.";
       return -1;
    }
}

sub error {
    my ($self) = shift;
    my $err = $self->{'error'};
    $self->{'error'}= "";
    return $err;
}

sub DESTROY {
    my $self = shift;
}


#
# convert a string to a hex-escaped string, returning
# the escaped string.
#
# $str is the string to be escaped
# if $inquotes is true, backslashes are doubled, making
#       the escaped string suitable to be enclosed in
#       single quotes and later passed to Text::quotewords.
#       For example,   var='quoted value'
#
sub _esc_str {
    my $str = shift;
    my $inquotes = shift;

    my $escstr = "";

    for (my $i = 0; $i < length ($str); $i++)
    {
    	my $c = substr ($str, $i, 1);

	if (ord ($c) < 32 ||
	    ord ($c) > 126 ||
	    $c eq "\"" ||
	    $c eq "\'")
	{
	    $c = sprintf ("\\%02x", ord($c));
	}
	elsif ($inquotes && $c eq "\\")
	{
	    $c = "\\\\";
	}

	$escstr .= $c;
    }

    $escstr;
}


#
# convert a hex-escaped string into an unescaped string,
# returning the unescaped string
#
sub _un_esc_str {
    my $str = shift;

    $str =~ s{\\([0-9a-f]{2})}{chr(hex($1))}eg;

    $str;
}

1;