hechz has asked for the wisdom of the Perl Monks concerning the following question:

I am trying to boil down a sub-routine that I have written into a base case. I am reading through "Higher Order Perl", and wish to follow the advice given therein.

After I figure it out I want to pass in some coderefs and dynamically build the appropriate data structures that contain the responses from the SNMP query, and returns to main(). I'll post my original code below, and the ill-formed beginnings of my re-factoring. If advice and direction could be provided I would be most appreciative.

Current Version 

#===  FUNCTION  ======================================================
+==========
#         NAME:  snmp_get
#      PURPOSE:  fetch the Physical Address of the eth0 int
#   PARAMETERS:  $sess, the snmp_session returned by the init.
#=====================================================================
+==========
sub snmp_get($){
    my ($interfaces_table, @interfaces_oids, $int_id, $error, $snmp_re
+s);
    my $snmp_sess = shift;
    unless ($snmp_sess){
        print STDERR "snmp_session object has fallen out of scope\n" i
+f $debug;
        return;
    }
    my @interface_names_oid='1.3.6.1.2.1.2.2.1.2';
    $interfaces_table=$snmp_sess->get_entries(-columns => \@interface_
+names_oid);
    if ($interfaces_table){
        foreach my $int_oid (keys %{$interfaces_table} ){
            ( $int_id ) = ( $int_oid =~ m{\.(\d+)$} );
            push(@interfaces_oids, "1.3.6.1.2.1.2.2.1.6.$int_id") if $
+interfaces_table->{$int_oid}=~m{eth0};
        }
        $snmp_res = $snmp_sess->get_request(
            -varbindlist => \@interfaces_oids
        );
    }else{
        $error=$snmp_sess->error();
    }
    return ($snmp_res,$error);
}

[download]

New Version (in progress)

#===  FUNCTION  ======================================================
+==========
#         NAME:  snmp_get
#      PURPOSE:  fetch the Physical Address of the eth0 int
#   PARAMETERS:  $sess, the snmp_session returned by the init.
#=====================================================================
+==========
sub snmp_get(){
    my $snmp_sess = shift;
    unless ($snmp_sess){
        print STDERR "snmp_session object has fallen out of scope\n" i
+f $debug;
        return;
    }
}

$func_map = {
        INTERFACES => @{'1.3.6.1.2.1.2.2.1.2'},
        MACS       => @{\&get_ints }
}



get_ints(){
    my @interface_names_oid=$func_map{INTERFACES};
    $interfaces_table=$snmp_sess->get_entries(-columns => \@interface_
+names_oid);
    if ($interfaces_table){
        foreach my $int_oid (keys %{$interfaces_table} ){
            ( $int_id ) = ( $int_oid =~ m{\.(\d+)$} );
            push(@interfaces_oids, "1.3.6.1.2.1.2.2.1.6.$int_id") if $
+interfaces_table->{$int_oid}=~m{eth0};
        }
    }
}

get_macs(){
       $snmp_res = $snmp_sess->get_request(
            -varbindlist => \@interfaces_oids
        );
}

[download]
The thing I am failing to see, is what exactly I should pass into the "generified" snmp_get routine. I believe that it would merely be the snmp session object, and class. Also, I think I am mixing some of the concepts together unnecessarily, I am not sure if I need the dispatch table or not. Hence my asking for advice and direction.

Original Code, for context

#---------------------------------------------------------------------
+------
#  std opts
#---------------------------------------------------------------------
+------
use strict;
use warnings;

#---------------------------------------------------------------------
+------
#  Database connectivity
#---------------------------------------------------------------------
+------
use DBI;                                       # access AnyData|MySQL

#---------------------------------------------------------------------
+------
#  program pre-requsites.
#---------------------------------------------------------------------
+------
use Getopt::Long;
use Nmap::Parser;
use File::Glob;
use File::Basename;
use Net::SNMP;
use Net::Ping;
use String::CRC32;

#---------------------------------------------------------------------
+------
#  Debugging
#---------------------------------------------------------------------
+------
use Data::Dumper;
$Data::Dumper::Terse=1;
$Data::Dumper::Indent=1;

#---------------------------------------------------------------------
+------
#  Use the local home directory structure during development.
#---------------------------------------------------------------------
+------
my $dir;
BEGIN{
    unless ($ENV{PWD} =~ m{/home/}){
        $dir="/usr/local/lib/perl5"
    }else{
        $dir="$ENV{HOME}/" . dirname($0) . "/../lib/perl5";
    }
}
use lib (
    $dir
);

use util;

#---------------------------------------------------------------------
+------
#  some globals
#---------------------------------------------------------------------
+------
my (%options, $dsn, $dbh, $debug, @files, $timeout);    # 
my $localaddr = util::resolvname($ENV{HOSTNAME});
my $localport = sprintf("%5d",int(rand(65535)));  # reset to a random 
+highport
my $community=$options{community} || 'public';

#===  FUNCTION  ======================================================
+==========
#         NAME:  help
#  DESCRIPTION:  Print help information
#=====================================================================
+==========
sub help {
    print STDERR <<eof
$0:
    { --infilex | -ix <filename> } (this can be a quoted pattern match
+ *.xml) |
    { --infilet | -it <filename> } (this can be a quoted pattern match
+ *.txt) |
    { --db | -d <sid>}  { --dbhost | -h } { --dbuser | -u } { --dbpass
+ | -p } |
    { --outfile | -o }

----------------------------------------------------------------------
+--

    --infile requires an nmap XML file.  --db and --outfile are mutual
+ly
             exclusive, the outfile is in CSV format.
    --db requires: --dbhost --dbpass --dbuser
eof
;
    exit 1;
}                                              #end{help}

#===  FUNCTION  ======================================================
+==========
#         Name:         options
#         DESCRIPTION:  process command line options
#=====================================================================
+==========
sub options {
    GetOptions(\%options,
        'infilex|ix=s',                       # input XML forced as an
+ array
        'infilet|it=s',                       # input TXT forced as an
+ array
        'db|d=s',                               # commit to DB
        'dbhost|h=s',                         # host on which the data
+base resides.
        'dbuser|u=s',                         # username to connect to
+ MySQL
        'dbpass|p=s',                         # password for the above
+ user.
        'outfile|o=s',                        # commit to CSV
        'debug|D' => \$debug,                 # debugging?
        'help|h|?'                            # access the help routin
+e
    );
    if ( -e "$options{dbpass}" ){
        $options{dbpass}=sub{
            my $passtok;
            open(PASSFILE,"<$options{dbpass}");
            while(<PASSFILE>){
                next unless (/^.+$/);           # skip blanks.
                chomp($passtok=$_);
                ($passtok) = ($passtok ? /(.+)\b\s*#.*user.*/ : /^(.+)
+$/);
                return $passtok if $passtok;
            }
            return($passtok);
            }->();
    }
    print Dumper %options if $debug;
    return(%options);
}                                              #end{options}


#===  FUNCTION  ======================================================
+==========
#         NAME:  globfile
#      PURPOSE:  parse shell globs
#=====================================================================
+==========
sub globfile {
    my @files = ($options{infilex} ? glob($options{infilex}) : glob($o
+ptions{infilet}));
    die "no files found in" . 
        $options{infilex} ? $options{infilex} 
        : $options{infilet} . 
        "\n" unless @files;
    return(@files);
}

#===  FUNCTION  ======================================================
+==========
#         NAME:  dbinit
#      PURPOSE:  Configure the database handle
#  DESCRIPTION:  Configure the CSV/MySQL database handle.
#=====================================================================
+==========
sub dbinit {
    $DBI::dbi_debug=1 if $debug;               # set the DB driver to 
+debug
    if ($options{db}){
        $dsn = "DBI:mysql:database=$options{db};host=$options{dbhost};
+port=3306";
        $dbh = DBI->connect($dsn, $options{dbuser}, $options{dbpass}) 
+or die "MySQL: $!\n";
    }elsif ($options{csv}){
       $dbh = DBI->connect('dbi:AnyData(RaiseError=>1):');
       $dbh->func(  'device', 
                    'CSV', 
                    $options{outfile},
                    { col_names => 'deviceid,fingerprint,name,descript
+ion,slaid,devicetypeid,firstseen,lastseen'},
                    'ad_catalog' 
              );
    }                                          #end if-elsif
    return($dbh);
}                                              #end{dbinit}

#===  FUNCTION  ======================================================
+==========
#         NAME:  snmp_init
#      PURPOSE:  Import the methods from net SNMP and retrun the sessi
+on opject
#                to my caller
#      RETURNS:  A communications handle.
#=====================================================================
+==========
sub snmp_init($$;$$) {
    my ($hostname, $port ) =@_;
    my ($snmp_sess, $error)=Net::SNMP->session(
                            -hostname   =>  "$hostname",
                            -port       =>  "$port",
                            -localaddr  =>  "$localaddr",
                            -localport  =>  "$localport",
                            -timeout    =>  "3",
                            -community  =>  "$community"
                        );
    
    return($snmp_sess);
}                                               #end{snmp_init}

#===  FUNCTION  ======================================================
+==========
#         NAME:  snmp_get
#      PURPOSE:  fetch the Physical Address of the eth0 int
#   PARAMETERS:  $sess, the snmp_session returned by the init.
#=====================================================================
+==========
sub snmp_get($){
    my ($interfaces_table, @interfaces_oids, $int_id, $error, $snmp_re
+s);
    my $snmp_sess = shift;
    unless ($snmp_sess){
        print STDERR "snmp_session object has fallen out of scope\n" i
+f $debug;
        return;
    }
    my @interface_names_oid='1.3.6.1.2.1.2.2.1.2';
    $interfaces_table=$snmp_sess->get_entries(-columns => \@interface_
+names_oid);
    if ($interfaces_table){
        foreach my $int_oid (keys %{$interfaces_table} ){
            ( $int_id ) = ( $int_oid =~ m{\.(\d+)$} );
            push(@interfaces_oids, "1.3.6.1.2.1.2.2.1.6.$int_id") if $
+interfaces_table->{$int_oid}=~m{eth0};
        }
        $snmp_res = $snmp_sess->get_request(
            -varbindlist => \@interfaces_oids
        );
    }else{
        $error=$snmp_sess->error();
    }
    return ($snmp_res,$error);
} 


#===  FUNCTION  ======================================================
+==========
#         NAME:  text_processor
#      PURPOSE:  parse a plain text list of hostnames/IPs
#      RETURNS:  nested hash LIKE NMAP::Parser
#=====================================================================
+==========
sub text_processor {
    my $routine=(caller 0)[3];
    my $file = shift;
    my $host={} ;
    my ($name, $ip, $os);                                 # ersatz NMA
+P::Parser datastruct
    open (INFILE,"$file");
    foreach (<INFILE>){
        /(^\p{IsAlpha}+)/ ? $name=$1 : chomp($ip=$_);
        if ($name){
            $ip=util::resolvip($name);
        }elsif ($ip){
            $name= util::resolvip($ip) || $ip;
        }
        $host->{'addrs'}->{'ipv4'} = "$ip";
        $host->{'hostnames'} = ["$name"];
#        sub os_sid {
#            $host->{'os'}->{'osmatch_count'} = 1;
#            $host->{'os'}->{'osmatch_name'} = ['nix']; 
#        }
    }
}

#===  FUNCTION  ======================================================
+==========
#         NAME:  ins_host_data
#      PURPOSE:  insert into the device table.
#=====================================================================
+==========
sub ins_host_data {
    $dbh=&dbinit;
    &help unless $dbh;                        # bail if the DBH is mis
+sing.
    my $host = shift;
    my $os = $host->os_sig();
    my $device_type;
    my $ip         = sub { $host->{addrs}->{ipv4} || '' }->() ;
    my $descr      = sub { $os->{osmatch_name}->[0] || $os->name  || '
+' }->() ;
    my $sla        = '2';
    chomp (my $datetime = `date '+%Y-%m-%d %H:%M:%S'`);
#---------------------------------------------------------------------
+------
#  Is the host up on port 22?
#---------------------------------------------------------------------
+------
    my $p = Net::Ping->new('syn', 2, 64);
    #$p->port_number(getservbyname("ssh", "tcp"));
    my $res=$p->ping($ip, 2);
    # $res=$p->ack($ip);
    ($res)= $p->{econnrefused} ? 0 : $p->ack($ip);
    $p->close();
    my ($snmp_sess, $error, $snmp_res, $mac);

#---------------------------------------------------------------------
+------
#  transform the IP to a name, resolve the IP if the name is not prese
+nt.
#---------------------------------------------------------------------
+------
    my $name       = sub { $host->{hostnames}->[0] || util::resolvip($
+host->{addrs}->{ipv4}) || '' }->() ;
       $name       =~ tr{A-Z}{a-z};
       $name       = (split(/\./,$name))[0] unless ($name =~ /^\d+\./)
+;

#---------------------------------------------------------------------
+------
#  wedged in the SNMP handling. This is a poor spot for it. inefficien
+t.
#---------------------------------------------------------------------
+------
       $snmp_sess = &snmp_init($name, '161', $localaddr, $localport, '
+', $community);
       ($snmp_res, $error)=  &snmp_get($snmp_sess);
#---------------------------------------------------------------------
+------
#  if there is an error, bail. Whilst adding the name of the affected 
#  device if it isn't already in the message.
#---------------------------------------------------------------------
+------
    if ($error){
        my $msg="SNMP Connect: $error";
        $msg .= ($error =~ /$name/) ? "\n" : " \x27$name\x27\n";
        print STDERR "$msg";
        return;
    }
    ($mac) = (values(%{ $snmp_res })) ; 
    if (!$mac){
        print STDERR "ERROR: $name returned no MAC address\n";
        return ;
    }
    $mac=~s/0x|..$//g;                          # slice off the ugly
#---------------------------------------------------------------------
+------
#  Set the numerics that RGIL is using.
#---------------------------------------------------------------------
+------
    my $devt  = sub {
                    if ($os->{osmatch_count} gt 0){
                        $device_type=1 if ($os->{osmatch_name}->[0] =~
+ /Linux/);
                        $device_type=2 if ($os->{osmatch_name}->[0] =~
+ /Windows/);
                        $device_type=3 if ($os->{osmatch_name}->[0] !~
+ /Linux|Windows/);
                    }else{
                        $device_type=99;
                    }
                return($device_type);
                }->();                    #end-if-else,sub            
+       


    if ($host->{status}=~m{^up$} && $res && $snmp_res){

#---------------------------------------------------------------------
+------
#  generate the "checksum data"
#---------------------------------------------------------------------
+------
    my ($fingerprint)=(crc32("$name $mac")) unless !$mac;
    # if (length($fingerprint) < 10){ return }
    if ($debug){
        print "\n\t$fingerprint=crc32($name $mac)\n"unless !$mac;
    }
              my @db_res=$dbh->selectrow_array("select * from device w
+here fingerprint=" . $dbh->quote($fingerprint));
              if (@db_res){
                    print STDERR "$name and $mac already present, upda
+ting last seen!\n";
                    print STDERR "\nupdate device set lastseen\x27=$da
+tetime\x27 where fingerprint=\x27$fingerprint\x27\n" if $debug;
                    $dbh->do("update device set lastseen=" . $dbh->quo
+te($datetime) . " where fingerprint=" .  $dbh->quote($fingerprint));
                    return;
              }else{
                  print STDERR "\nINSERT INTO device set deviceid='', 
+fingerprint=\x27$fingerprint\x27, name=\x27$name\x27, description=\x2
+7$descr, slaid=\x27$sla\x27, devicetypeid=\x27$devt\x27, firstseen=\x
+27$datetime\x27, lastseen=\x27$datetime\x27\n" if $debug;
                  $dbh->do("INSERT INTO device set 
                                deviceid="     . $dbh->quote("''") .  
+",
                                fingerprint="  . $dbh->quote($fingerpr
+int) . ", 
                                name="         . $dbh->quote($name) . 
+", 
                                description="  . $dbh->quote($descr) .
+ ", 
                                slaid="        . $dbh->quote($sla) . "
+, 
                                devicetypeid=" . $dbh->quote($devt) . 
+", 
                                firstseen="    . $dbh->quote($datetime
+) . ",
                                lastseen="     . $dbh->quote($datetime
+)
                        );
                        print STDERR "\nINSERT INTO ip set fingerprint
+=$fingerprint, ip=inet_aton($ip)\n" if $debug;
                        my $ip_fingerprint=crc32($ip);
                        $dbh->do("INSERT INTO ip set
                                    fingerprint=" . $dbh->quote($finge
+rprint) . ", 
                                    ip="          . "inet_aton(" . $db
+h->quote($ip) . ")"
                                );
            }
    }else{
        print STDERR "\n\tskipping $host->{addrs}->{ipv4}: not up/no O
+S determined.\n"
    }                                          #end if-else
}                                              #end{ins_host_data}


#---------------------------------------------------------------------
+------
#  MAIN
#---------------------------------------------------------------------
+------
options;
our $quiet=1 unless $debug;                     # quiesce resolver uti
+lity
if ( (!$options{infilex} && !$options{infilet} ) &&
        ( !$options{outfile} ||
            (
                !$options{db}     &&
                !$options{dbhost} &&
                !$options{dbuser} &&
                !$options{dbpass}
            )
        )
    ){
    help;
}                                              #end-if
$options{csv} = 1 if $options{outfile};
my $np;
@files=&globfile;
foreach my $file (@files){
#---------------------------------------------------------------------
+------
#  Here is some logic to ensure that we are processing a filename
#  that matches the argument supplied. This might be better placed in
#  globfile(), meh.
#---------------------------------------------------------------------
+------
    my ($typ, $ext)=sprintf("%s",grep(/le[tx]/,keys %options)); # $ext
+ is. null I was just being lazy with space.
    $ext=($typ=~/x$/) ? 'xml' : 'txt';                          # if w
+e were passed XML we should've globbed xml 
    ($file !~/$ext/) ?                                          # mism
+atched?, then error out and exit.
        sub {
                print STDERR "ERROR:filename and option conflict- expe
+cted\n\t\x22--$typ '*.$ext'\x22\nand got\n\t$file\n";
                exit 99
            }->() 
        : 
        print "\nProcessing file $file...\n";                   # othe
+rwise, print and move on.
    if ($options{infilex}){
        $np = new Nmap::Parser;
        $np->callback(\&ins_host_data);
        $np->parsefile($file);
    }elsif ($options{infilet}){
        &ins_host_data(&process_text);
    }else{
        die "Unsupported file-type\n";
    }
}                                              #end-for

[download]

Replies are listed 'Best First'.
Re: Advice on transforming a sub into a re-entrant recursive-able method.
by tilly (Archbishop) on Jul 21, 2008 at 18:30 UTC
    I think you're failing to see it because you're unclear on what you wish to accomplish. That also makes it hard to give you a good answer. So I'll settle for giving good advice, and some of it may pertain.

    My first piece of advice is to stop using prototypes. Prototypes in Perl do not do what you think, and what they do in most cases is something you really don't want. The (unfortunately now MIA, so go to the wayback machine) article FMTYEWTK about Prototypes in Perl explains this in great detail.

    Of course you've avoided most of the pain by using method calls, which causes the prototype to be ignored. Thereby they serve no purpose other than to confuse the maintenance programmer.

    Another general tip is that it is generally good programming style to declare lexical variables as close to their scope as possible. So move your declarations in.

    Error handling. Rather than return errors, I prefer throwing an exception with die. That way if someone forgets to have error handling you still know that things went wrong. (Opinions differ on this.)

    A more relevant tip is that you shouldn't rewrite code without a reason. You have code. It works. A rewrite takes effort and may not work. So why do it?

    Now let's look at your rewrite. You say you're trying to follow the advice in Higher Order Perl. I'd take that to mean that you're interested in doing things like having lazy lists. If you want to do that, then you need to start your rewrite from the inside out. So you want to start your rewrite with get_entries. So you'd want to have a function named something like get_entries_iterator that returns a function that you can call to get each entry in turn. And then you'd call it repeatedly to get each entry.

    My second response to Re: Let's get lazy should give you a sense of what this could look like.

[reply]
      I have now established what I wish to accomplish! the input to the initial call of get SNMP will always be the same, and IP. What I want the sub to do is then call itself with different arguments and behave in a certain manner. That manner being to first get the list of interfaces, and say map them to a hash, then get the interface MAC addresses and place them as the values. My eventual goal is to have the type of device determined as well so that get_snmp will know to use different OIDs for different hardware... Different vendors put their values in different places
[reply]
Re: Advice on transforming a sub into a re-entrant recursive-able method.
by almut (Canon) on Jul 21, 2008 at 17:44 UTC

    What seems a little strange is the no-arguments prototype () with all your functions (hint: just get rid of it), and the missing sub keyword for get_ints and get_macs. Also, you'd need a semicolon at the end of the $func_map = {...} declaration. Then, add strictures and fix the remaining problems that Perl complains about...

[reply]
[d/l]
[select]
      So the basic tack is right? (like I wrote, the rewrite is more pseudo-perl than anything else).
[reply]

        I haven't really looked at the semantic aspects of your rewrite yet, because I'm not exactly sure which advice from Higher Order Perl you're trying to follow, in particular which coderefs you want to pass to where...

        As it is, it's not clear to me how the three functions are related. Is snmp_get the toplevel function? If so, how is it supposed to call the other routines (via coderefs you pass in as args?), etc.  Could you elaborate a bit on how you want the new version to operate, i.e. what you want to call with which args, and what it should return (a few lines of sample code showing how you're planning to use it would help).

[reply]
[d/l]
Re: Advice on transforming a sub into a re-entrant recursive-able method.
by Limbic~Region (Chancellor) on Jul 21, 2008 at 18:22 UTC
    hechz,
    I am not sure what you are trying to do. In your current version, you overwrite every argument you pass in except the session so it seems like there isn't much point in them. I can't see what it is that you are trying to make re-entrant nor what you are trying to recurse on.

    Are you trying to create a function that can return the snmp data piece meal? If so, I think this article I wrote on creating and using iterators may help you. If you can give a better description of what you are trying to accomplish rather than how you are trying to accomplish it I might be able to help more.

    Cheers - L~R

[reply]
Re: Advice on transforming a sub into a re-entrant recursive-able method.
by ikegami (Patriarch) on Jul 21, 2008 at 18:58 UTC
    How is what you started with not re-entrant?
[reply]

Back to Seekers of Perl Wisdom