File Coverage

blib/lib/SNMP/Insight/Moose/MIB.pm

Criterion	Covered	Total	%
statement	58	58	100.0
branch	20	26	76.9
condition			n/a
subroutine	13	13	100.0
pod	4	4	100.0
total	95	101	94.0

package SNMP::Insight::Moose::MIB;

#ABSTRACT: Moose glue to write MIB roles

use Moose;
use Moose::Exporter;
use Carp;

our $VERSION = '0.002';    #TRIAL VERSION:

use SNMP::Insight::Meta::Attribute::Trait::MIBEntry;

Moose::Exporter->setup_import_methods(
    with_meta      => [ 'mib_oid', 'mib_name', 'has_scalar', 'has_table' ],
    role_metaroles => {
        role => ['SNMP::Insight::Meta::Class::Trait::MIB'],
    },
);

sub mib_oid {
    my $meta = shift;
    $meta->mib_oid(shift);
}

sub mib_name {
    my $meta = shift;
    $meta->mib_name(shift);
}

sub has_scalar {
    my ( $meta, $name, %options ) = @_;

    my $oid = $options{oid};
    $oid =~ /^\./ or $oid = $meta->mib_oid . "." . $oid;
    $oid =~ s/^\.//o;

    my $munger_code;
    if ( $options{munger} ) {
        $munger_code = _load_munger( $meta, $options{munger} );
    }

    my %attribute_options = (
        traits     => ['MIBEntry'],
        is         => 'ro',
        lazy       => 1,
        oid        => $oid,
        entry_type => 'scalar',
        default    => sub {
            my $self = shift;
            $self->_mib_read_scalar( $oid, $munger_code );
        },
    );
    $options{munger} and $attribute_options{munger} = $munger_code;

    $meta->add_attribute( $name, %attribute_options );
}

sub has_table {
    my ( $meta, $name, %options ) = @_;

    my $table_oid = $options{oid};
    $table_oid or croak "Table $name has no oid";
    $table_oid =~ /^\./ or $table_oid = $meta->mib_oid . "." . $table_oid;
    $table_oid =~ s/^\.//o;

    my $columns = $options{columns};
    $columns or croak "Table $name has no columns definition";
    while ( my ( $col_name, $col_opts ) = each(%$columns) ) {
        _create_column( $meta, $table_oid, $col_name, $col_opts );
    }

    my $index = $options{index};
    if ($index) {

        # TODO handle multi column index

        $meta->has_attribute($index)
          or croak "Cannot find index $index for table $name";
    }

    $meta->add_attribute(
        $name,

        traits     => ['MIBEntry'],
        entry_type => 'table',
        oid        => $table_oid,

        is   => 'ro',
        lazy => 1,

        default => sub {
            my $self = shift;
            $self->_mib_read_table(
                index   => $index,
                columns => [ keys %$columns ]
            );
        },
    );
}

sub _load_munger {
    my ( $meta, $munger ) = @_;

    # easy case
    return $munger if ref($munger) eq "CODE";

    my $metamethod = $meta->find_method_by_name($munger)
      or croak "No $munger found";
    return $metamethod->body;
}

sub _create_column {
    my ( $meta, $table_oid, $col_name, $col_opts ) = @_;

    ref $col_opts eq 'ARRAY' or $col_opts = [$col_opts];

    my ( $sub_id, $munger ) = @$col_opts;

    my $col_oid = "$table_oid.1.$sub_id";
    my $munger_code;
    $munger and $munger_code = _load_munger( $meta, $munger );

    my %attribute_options = (
        is   => 'ro',
        lazy => 1,

        traits     => ['MIBEntry'],
        oid        => $col_oid,
        entry_type => 'column',

        default => sub {
            my $self = shift;
            $self->_mib_read_tablerow( $col_oid, $munger_code );
        },
    );
    $munger and $attribute_options{munger} = $munger_code;

    $meta->add_attribute( $col_name, %attribute_options );
}

1;

# Local Variables:
# mode: cperl
# indent-tabs-mode: nil
# cperl-indent-level: 4
# cperl-indent-parens-as-block: t
# End:

__END__

=pod

=head1 NAME

SNMP::Insight::Moose::MIB - Moose glue to write MIB roles

=head1 VERSION

version 0.002

=head1 METHODS

=head2 mib_oid

Declare the oid of the current MIB. E.g. in IFMIB.pm

  mib_oid '1.3.6.1.2.1.31';

=head2 mib_name

Declare the name of the current MIB. E.g.

  mib_name 'IF-MIB';

=head2 has_scalar $name => %options

  has_scalar 'fooVal' => ( oid => '3' );

Declare a scalar entry of a given C<$name> into the current MIB role.
Oid is relative to the MIB oid declare with mib_oid, unless it starts with a dot.

=head2 has_table $name %options

Declare a table of a given C<$name> into the current MIB role.

  has_table "fooTable" => (
    oid     => "1.1",
    index   => "fooTableIndex",
    columns => {
        'fooTableIndex'    => 1,
        'fooTableBars'     => 2,
        'fooTableBaazes'     => [ 3, 'munge_baazes' ],
    }
  );

=over 4



=back

* oid => $oid

* index => $index

* columns => %columns

=head1 AUTHOR

Gabriele Mambrini <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Gabriele Mambrini.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut