=head1 NAME

SNMP::Persist - The SNMP pass_persist threaded backend

=head1 VERSION

Version 0.05

=cut

our $VERSION = '0.05';

=head1 SYNOPSIS

        use SNMP::Persist qw(&define_oid &start_persister &define_subtree);
        use strict;
        use warnings;


        #define base oid to host the subtree
        define_oid(".1.3.6.1.4.1.2021.248");

        #start the thread serving answers
        start_persister();

        #set first application number

        #loop forever to update the values
        while(1) {

          my %subtree;
          my $gameName;
          my $index=1;						#set first application number

          foreach $gameName ("game1", "game2") {                     #for each application
            $subtree{"1." . $index}=["INTEGER",$index];              #set game index data pair
            $subtree{"2." . $index}=["STRING",$gameName];            #set game name data pair
            $subtree{"3." . $index}=["Counter32", 344.2 ];           #set total memory data pair
            $index++;                                                #next application
          }

          #new values have arrived - notify the subtree controller
          define_subtree(\%subtree);

          #don't update for next 5 minutes
          sleep(300);
        }


The script can be used in the following way from snmpd.conf:

pass_persist .1.3.6.1.4.1.2021.248 <user script location>


=head1 DESCRIPTION

The SNMP-Persist module is a backend for pass_persist feature of net-snmp.

It simplifies the process of sharing user-specified data via SNMP and
development of persistent net-snmp applications controlling a chosen
MIB subtree.

It is particularly useful if data gathering process takes too long.
The responder is a separate thread, which is not influenced by updates
of MIB subtree data.
The answer to a snmp request is fast and doesn't rely on potentially
slow source of data.

=cut






package SNMP::Persist;

use 5.008;
use warnings;
use strict;
use threads;
use threads::shared;
use Exporter;

our @EXPORT_OK=qw(&define_subtree &start_persister &define_oid);
our @ISA=qw(Exporter);

my $mib : shared;
my $mutex	: shared;
my $base_oid : shared   = ".1.3.6.1.4.1.2021.240";
my $conversation_thread;

$|=1;

sub define_subtree {
  my $subtree=shift;
  my $value;
  my $item;

  #I expect a hash of two-elements arrays as an argument
  #will create a copy of it to allow sharing between threads
  #(sharing an array - empties an array :/ )

  #lets lock $mutex to hold queries till the update is finished
  #or wait till the query is finished
  lock($mutex);

  $mib=&share({});

  #the traverse & copy procedure
  foreach $value (keys %{$subtree}) {
	$mib->{$value}=&share([]);
	$mib->{$value}[0]=$subtree->{$value}[0];
	$mib->{$value}[1]=$subtree->{$value}[1];
  } #foreach

#do the sort here or after each getnext request
#  #now, lets decide the order
#  #sorted table of all oids
#  my @s = sort { _oid_cmp($a, $b) } keys %{ $mib };
#  #add a next_oid value to table of each oid
#  for (my $i = 0; $i < @s; $i++) {
#	$mib->{@s[$i]}[2]=@s[$i+1];
#  } #for
} #define_subtree-end



sub define_oid {
  #set new base_oid
  $base_oid=shift;
} #define_oid-end




sub start_persister {
  if (!$conversation_thread) {
  	$conversation_thread=threads->create("_conversation_update","");
  } else {
	warn "Will not start conversation thread more then once.";
  }
} #start-end




sub _conversation_update {

  #lets support PING, getnext and get queries in a loop
  while(<>) {
    if ( /PING\n/ ){
      print "PONG\n";
    } elsif ( /getnext\n/ ) {
      lock($mutex);
      #get next line with full oid
      my $req_oid=<STDIN>;
      if (! defined($mib)) {
        print "NONE\n";
        next; 
      }
      my $found=0;
      my $oid = _get_oid($req_oid); 
      #we don't need the sort really, what a waste it was!
      #sort all saved oids to a table
      #my @s = sort { _oid_cmp($a, $b) } keys %{ $mib };
      my ($oid_higher, $oid_hash);
      foreach $oid_hash (keys %{ $mib }) {
        #if higher then the requested one
	if (_oid_cmp($oid, $oid_hash) == -1 ) {
	  if (defined($oid_higher)) {
	    #if lower the the highest so far
	    if (_oid_cmp($oid_higher,$oid_hash) == 1) {
	      $oid_higher=$oid_hash;  
	    }	  
	  } else {
	    $oid_higher=$oid_hash;
	  }
	  $found=1;
	}
      } #for
      if (!$found) {
        print "NONE\n";
      } else {
        print "$base_oid.".$oid_higher."\n";   #print full oid
        print $mib->{$oid_higher}[0]."\n";             #print type
        print $mib->{$oid_higher}[1]."\n";             #print value
      }
    } elsif ( /get\n/ ) {
      lock($mutex);
      my $req_oid=<STDIN>; #get next line with full oid
      if (! defined($mib)) {
        print "NONE\n";
        next;
      }
      my $oid = _get_oid($req_oid);
      if (defined $oid && defined($mib->{$oid})) {
        print "$base_oid.$oid\n";	#print full oid
        print $mib->{$oid}[0]."\n";	#print type 
        print $mib->{$oid}[1]."\n";	#print value
      } else {
        print "NONE\n";
      }
    } #if
  } #while
#exit if snmpd has stopped
exit(0);
} #conversation_thread-end

sub _oid_cmp {
  my ($x, $y) = @_;
  return -1 unless $y;
  my @a = split /\./, $x;
  my @b = split /\./, $y;

  my $i = 0; #oid string index
  
  #traverse the oid strings to compare them and return the value (-1,0,1)
  while (1) {
    if ($i > $#a) {
      if ($i > $#b) {
        return 0;
      } else {
        return -1;
      }
    } elsif ($i > $#b) {
      return 1;
    }

    if ($a[$i] < $b[$i]) {
      return -1;
    } elsif ($a[$i] > $b[$i]) {
      return 1;
    }
    $i++;
  } #while_end
} #oid_cmp-end


#remove the base from the OID
#and a sort of lousy input validation
sub _get_oid {
  my $oid = shift;
  chomp $oid;

  my $base = $base_oid;
  $base =~ s/\./\\./g;

  if ($oid !~ /^$base(\.|$)/) {
    #requested oid doesn't match base oid
    return 0;
  }

  $oid =~ s/^$base\.?//;
  return $oid;
} #get_oid-end




1;







=head1 FUNCTIONS


=head2 B<define_subtree(\%hash)>

Start the thread responsible for handling snmp requests.
The function expects a reference to a predefined hash of arrays. 
Each array has to be built of two elements:

=over 5

=item * data type 

any SMI datatype supported by net-snmp (e.g. "INTEGER", "STRING", "Counter32") 

=item * value

a value set accordingly to the data type

=back


=head2 B<define_oid($string)>

Define the base oid for a mib subtree controlled by a script

=head2 B<start_persister( )>

Create or update the subtree data



=head1 AUTHOR

Anna Wiejak, C<< <anias at popoludnica.pl> >>



=head1 BUGS

Please report any bugs or feature requests to
C<bug-snmp-persist at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=SNMP-Persist>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc SNMP::Persist

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/SNMP-Persist>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/SNMP-Persist>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SNMP-Persist>

=item * Search CPAN

L<http://search.cpan.org/dist/SNMP-Persist>

=back

=head1 COPYRIGHT & LICENSE

Copyright 2006 Anna Wiejak, all rights reserved.

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

=cut

1; # End of SNMP::Persist