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); }

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 ); }
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

In reply to Advice on transforming a sub into a re-entrant recursive-able method. by hechz

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.