Maintainable and robust Pattern Matching with changing goalposts

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

Hi,
I have two specific questions, and one non-specific question
1. How can I make the code below more robust?
2. How can I make it easier to maintain?
3. Any suggestions for a "better" way to do it?

Before getting to the code itself, here is some background to provide context.

I should point out to start with that the code in its present form does work, but I am concerned about its maintainability.
I should also point out that I'm not asking for anybody to re-write the code for me, but rather to point me in the right direction to achieve the above.

Recently, I was tasked with coming up with a near real-time inventory system for the devices attached to a number of remote networks that our team manages. There are around 200 separate networks, and each typically comprises a single (RH Linux) server with a number of switching devices and wireless access points attached. In total, there are around 5000 devices.

The approach I took was to write three separate (Perl) scripts as follows:
1. A script that runs periodically on each remote server, collects the required data via SNMP, and reports it back to a central server.
2. A script that runs periodically on the central server, which parses the reports, and inserts or updates rows in a database, as appropriate.
3. A cgi script which presents the data as an interactive web front-end in a table format, with various filtering and sorting options.

The code below is the parsing routine from the 2nd script.

A typical example of the format of the reports is as follows:

Device:X.X.X.X   ## (the IP address of the device)
Type:Switch
Model:Unknown
Flash:SNMPv2-SMI::mib-2.16.19.6.0 = STRING:flash:c2900xl-c3h2s-mz.120-
+5.WC9a.bin
Sysdescr:SNMPv2-MIB::sysDescr.0 = STRING: Cisco Internetwork Operating
+ System Software  IOS (tm) C2900XL Software (C2900XL-C3H2S-M), Versio
+n 12.0(5)WC9a, RELEASE SOFTWARE (fc1) Copyright (c) 1986-2004 by cisc
+o Systems, Inc. Compiled Tue 13-Jan-04 11:54 by antonino
Device:X.X.X.X
Type:Switch
Model:SNMPv2-SMI::mib-2.47.1.1.1.1.13.1 = STRING: WS-C2950ST-24-LRE
Flash:SNMPv2-SMI::mib-2.16.19.6.0 = STRING:flash:/c2950lre-i6l2q4-mz.1
+21-22.EA1/c2950lre-i6l2q4-mz.121-22.EA1.bin
Sysdescr:SNMPv2-MIB::sysDescr.0 = STRING: Cisco Internetwork Operating
+ System Software  IOS (tm) C2950lre Software (C2950lre-I6L2Q4-M), V
ersion 12.1(22)EA1, RELEASE SOFTWARE (fc1) Copyright (c) 1986-2004 by 
+cisco Systems, Inc. Compiled Mon 12-Jul-04 08:38 by madison
[download]

The main problem I faced is that the format of the returned SNMP string is inconsistent, as we have many different device makes, models, etc. And we are constantly adding more. So extracting the information I require is a bit of a nightmare, and because of the changing format the code will require ongoing maintenance.
Since writing this code, I have obtained a copy of Damian Conway's Best Practices book, and after reading this I have a couple ideas for improving the code.
One is to abstract the pattern matches into a hash, and the other is to replace the horrendous series of if/elsif's with a tabular ternary (if that's possible/practical).
I would very much appreciate any comments or suggestions. Here is the code:

    111 sub parse_logfiles {
    112     my $ref;
    113     for my $host (sort keys %{$hostref}) {
    114         my $ip;
    115         my $file = "$logdir/$host,$domain.devices";
    116         open(INFILE, "<$file") || next;
    117         while (<INFILE>) {
    118             chomp();
    119             if (/^Device:/) {
    120                 $ip = (split(/:/))[1];
    121             }
    122             elsif (/^Type:/) {
    123                 $ref->{$host}{$ip}{type} = (split(/:/))[1];
    124                 for my $field (@devicefields) {
    125                     $ref->{$host}{$ip}{$field} = "Unknown";
    126                 }
    127             }
    128             elsif (/^Model:/) {
    129                 if (/((WS|AIR).*)/) {
    130                     #print STDERR "Match:$ip\n";
    131                     $ref->{$host}{$ip}{model} = uc($1);
    132                     $ref->{$host}{$ip}{model} =~ s/\s+$//g;
    133                 }
    134             }
    135             elsif (/^Flash:/) {
    136                 if (/flash[\:\/]+(c[at]*?\d{4}[\w\.\-]+)(\.bin
+|\/)/) {
    137                     #print STDERR "Match:$ip\n";
    138                     $ref->{$host}{$ip}{software_ver} = $1;
    139                 }
    140             }
    141             elsif (/^Sysdescr:/) {
    142                 $ref->{$host}{$ip}{manufacturer} = "Cisco" if 
+(/Cisco/i);
    143                 $ref->{$host}{$ip}{manufacturer} = "TUT System
+s" if (/Expresso GS|MDU Lite/i);
    144                 $ref->{$host}{$ip}{manufacturer} = "Gigalink" 
+if (/Gigalink/i);
    145                 $ref->{$host}{$ip}{manufacturer} = "Huawei" if
+ (/Huawei/i);
    146                 $ref->{$host}{$ip}{manufacturer} = "Orinoco" i
+f (/AP-2000|AP-1000/i);
    147                 $ref->{$host}{$ip}{manufacturer} = "Lucent" if
+ (/WavePOINT/i);
    148                 $ref->{$host}{$ip}{manufacturer} = "HP" if (/H
+P/);
    149                 $ref->{$host}{$ip}{manufacturer} = "Paradyne" 
+if (/Paradyne/i);
    150                 $ref->{$host}{$ip}{manufacturer} = "Colubris" 
+if (/CN320/);
    151                 $ref->{$host}{$ip}{manufacturer} = "SMC" if (/
+TigerSwitch/);
    152                 $ref->{$host}{$ip}{manufacturer} = "Ricoh" if 
+(/RICOH/);
    153
    154                 $ref->{$host}{$ip}{sys_desc} = $_;
    155                 $ref->{$host}{$ip}{sys_desc} =~ s/.*STRING:\s+
+//;
    156                 my $foo = $ref->{$host}{$ip}{manufacturer};
    157
    158                 if (/Internetwork.*Version\s([\w\.\(\)]+)/) {
    159                      #print STDERR "Match:$ip\n";
    160                      $ref->{$host}{$ip}{software_ver} = $1 if 
+$ref->{$host}{$ip}{software_ver} eq "Unknown";
    161                 }
    162                 elsif (/Version\s([\w\.\(\)]+)/) {
    163                     #print STDERR "Match:$ip\n";
    164                     $ref->{$host}{$ip}{software_ver} = $1 if $
+ref->{$host}{$ip}{software_ver} eq "Unknown";
    165                 }
    166                 if ($ref->{$host}{$ip}{model} eq "Unknown") {
    167                     if ($foo eq "Cisco") {
    168                         if (/Internetwork.*(C[0-9]+[a-zA-Z]*?)
+\s/) {
    169                             #print STDERR "Match:$ip\n";
    170                             $ref->{$host}{$ip}{model} = uc($1)
+;
    171                         }
    172                         elsif (/Cisco\s+(\d+)\s+Series\s+AP\s+
+([\w\.]+)/) {
    173                             #print STDERR "Match:$ip\n";
    174                             $ref->{$host}{$ip}{model} = "AP$1"
+;
    175                             $ref->{$host}{$ip}{software_ver} =
+ $2;
    176                         }
    177                         elsif (/Cisco\s+(AP\w+)\s+([\d\.]+)/) 
+{
    178                             $ref->{$host}{$ip}{model} = $1;
    179                             $ref->{$host}{$ip}{software_ver} =
+ $2;
    180                         }
    181                     }
    182                     elsif ($foo eq "Huawei") {
    183                         if (/Software Version\s(\d\.\d+)[\.|\s
+]+(Quidway \w+)/) {
    184                             $ref->{$host}{$ip}{software_ver} =
+ $1;
    185                             $ref->{$host}{$ip}{model} = $2;
    186                         }
    187                     }
    188                     elsif ($foo eq "Paradyne") {
    189                         if (/PARADYNE (BitStorm [0-9]+).*Relea
+se: ([\d\.]+)/) {
    190                             $ref->{$host}{$ip}{model} = $1;
    191                             $ref->{$host}{$ip}{software_ver} =
+ $2;
    192                         }
    193                     }
    194                     elsif ($foo eq "Orinoco") {
    195                         if (/(AP-[0-9]+)\s*?(v[\w\.\(\)]+)\s+(
+SN-\w+)/) {
    196                             $ref->{$host}{$ip}{model} = $1;
    197                             $ref->{$host}{$ip}{software_ver} =
+ $2;
    198                             $ref->{$host}{$ip}{serialnumber} =
+ $3;
    199                         }
    200                     }
    201                     elsif ($foo eq "Ricoh") {
    202                         if (/RICOH\s+(\w+\s+\w+)\s+([\w\.]+)/)
+ {
    203                             $ref->{$host}{$ip}{model} = $1;
    204                             $ref->{$host}{$ip}{software_ver} =
+ $2;
    205                         }
    206                     }
    207                     elsif ($foo eq "Gigalink") {
    208                         if (/Gigalink\s+(T-LAN.*)/) { $ref->{$
+host}{$ip}{model} = $1; }
    209                     }
    210                     elsif ($foo eq "Colubris") {
    211                         if (/STRING:\s+(\w+).*Serial number\s+
+([\w\-]+).*Firmware version\s+([0-9\.]+)/) {
    212                             $ref->{$host}{$ip}{model} = $1;
    213                             $ref->{$host}{$ip}{serialnumber} =
+ $2;
    214                             $ref->{$host}{$ip}{software_ver} =
+ $3;
    215                         }
    216                     }
    217                     elsif ($foo eq "TUT Systems") {
    218                         if (/(Expresso)\s(GS|MDU Lite-LR)/) { 
+$ref->{$host}{$ip}{model} = "$1 $2"; }
    219                     }
    220                     elsif ($foo eq "HP") {
    221                         if (/(JETDIRECT.*?)\,(.*?)\,(EEPROM\s[
+\w\d\.]+)/) {
    222                             $ref->{$host}{$ip}{model} = "$1 $2
+";
    223                             $ref->{$host}{$ip}{software_ver} =
+ $3;
    224                         }
    225                     }
    226                     elsif ($foo eq "Lucent") {
    227                         if (/(WavePOINT\-\w+)\s+(V[\d\.]+)\s+(
+SN\-\w+)/) {
    228                             $ref->{$host}{$ip}{model} = $1;
    229                             $ref->{$host}{$ip}{software_ver} =
+ $2;
    230                             $ref->{$host}{$ip}{serialnumber} =
+ $3;
    231                         }
    232                     }
    233                     else {
    234                         unless ($ref->{$host}{$ip}{sys_desc} =
+~ /Unknown$/) {
    235                             &Log(*LOGFILE, "WARNING:$host:$ip:
+Could not determine MODEL from:$ref->{$host}{$ip}{sys_desc} ");
    236                         }
    237                     }
    238                 }
    239                 $ref->{$host}{$ip}{sys_desc} =~ s/system\.sysD
+escr\.0 \=//g;
    240                 $ref->{$host}{$ip}{sys_desc} =~ s/Copyright.*/
+/;
    241                 $ref->{$host}{$ip}{sys_desc} =~ s/.*STRING:\s+
+//;
    242                 $ref->{$host}{$ip}{sys_desc} =~ s/[\/\'\"]//g;
    243                 $ref->{$host}{$ip}{sys_desc} =~ s/\s+$//g;
    244             }
    245         }
    246         close INFILE;
    247         unlink($file);
    248     }
    249     return $ref;
    250 }
[download]

Comment on Maintainable and robust Pattern Matching with changing goalposts Select or Download Code

Replies are listed 'Best First'.
Re: Maintainable and robust Pattern Matching with changing goalposts by ikegami (Patriarch) on Sep 16, 2005 at 17:13 UTC
It looks like you could take advantage of dispatch tables. `my %header_handlers = ( Device => \&process_device, Type => \&process_type, ... ); ... my $handler = $header_handlers{$header}; &{$handler}($ref) if defined $handler;` [download]	[reply] [d/l]
Re^2: Maintainable and robust Pattern Matching with changing goalposts by McDarren (Abbot) on Sep 19, 2005 at 07:43 UTC
Thanks [id://ikegami] :) I sort of get the gist of what you are saying, although this is a completely new concept to me. Just did a quick google on "Perl dispatch tables" and discovered that the topic is covered in Higher Order Perl by [id://dominus]. Now I have a good reason to get a copy. (Although I also note that it will be available online soon :)	[reply]
Re: Maintainable and robust Pattern Matching with changing goalposts by Skeeve (Parson) on Sep 16, 2005 at 19:13 UTC
How about something like this for the Manufacturer list? `my(%manufacturers)= ( Cisco => qr/Cisco/i, 'TUT Systems'=> qr/Expresso GS\|MDU Lite/i, Gigalink => qr/Gigalink/i, Huawei => qr/Huawei/i, Orinoco => qr/AP-2000\|AP-1000/i, Lucent => qr/WavePOINT/i, HP => qr/HP/, Paradyne => qr/Paradyne/i, Colubris => qr/CN320/, SMC => qr/TigerSwitch/, Ricoh => qr/RICOH/, ); $ref->{$host}{$ip}{'manufacturer'}='unknown'; while (($manu, $re)= each(%manufacturers)) { if (/$re/) { $ref->{$host}{$ip}{'manufacturer'}=$manu; last; } }` [download] This only works if the sequence of the checks is unimportant. If the sequence does matter, I'd change that to an array: my(@manufacturers)= ( Cisco => qr/Cisco/i, 'TUT Systems'=> qr/Expresso GS\|MDU Lite/i, Gigalink => qr/Gigalink/i, Huawei => qr/Huawei/i, Orinoco => qr/AP-2000\|AP-1000/i, Lucent => qr/WavePOINT/i, HP => qr/HP/, Paradyne => qr/Paradyne/i, Colubris => qr/CN320/, SMC => qr/TigerSwitch/, Ricoh => qr/RICOH/, ); $ref->{$host}{$ip}{'manufacturer'}='unknown'; $manu= undef; foreach $re (@manufacturers) { if (defined $manu) { if (/$re/) { $ref->{$host}{$ip}{'manufacturer'}=$manu; last; } $manu= undef; } else { $manu= $re; } } print $m; [download] `$\=~s;s.;q^\|D9JYJ^^qq^\//\\\///^;ex;print`	[reply] [d/l] [select]
Re^2: Maintainable and robust Pattern Matching with changing goalposts by Skeeve (Parson) on Sep 16, 2005 at 19:41 UTC
To enhance my previous code a bit. One could also add regular expressions for finding the version etc. from the string like this (example given just for Cisco) my(%manufacturers)= ( Cisco => { key => qr/Cisco/i, version => qr/Internetwork.(C[0-9]+[a-zA-Z]?)\|Cisco\s+(\d+)\| +Cisco\s+(AP\w+)/, # the re will pick any possible Version number in $1.. $n }, 'TUT Systems'=> { key => qr/Expresso GS\|MDU Lite/i, version => qr//, }, Gigalink => { key => qr/Gigalink/i, version => qr//, }, Huawei => { key => qr/Huawei/i, version => qr//, }, Orinoco => { key => qr/AP-2000\|AP-1000/i, version => qr//, }, Lucent => { key => qr/WavePOINT/i, version => qr//, }, HP => { key => qr/HP/, version => qr//, }, Paradyne => { key => qr/Paradyne/i, version => qr//, }, Colubris => { key => qr/CN320/, version => qr//, }, SMC => { key => qr/TigerSwitch/, version => qr//, }, Ricoh => { key => qr/RICOH/, version => qr//, }, ); $_='Sysdescr:SNMPv2-MIB::sysDescr.0 = STRING: Cisco Internetwork Opera +ting System Software IOS (tm) C2900XL Software (C2900XL-C3H2S-M), Ve +rsion 12.0(5)WC9a, RELEASE SOFTWARE (fc1) Copyright (c) 1986-2004 by +cisco Systems, Inc. Compiled Tue 13-Jan-04 11:54 by antonino'; $m=undef; $manu= undef; $hash= undef; while (($manu, $hash)= each(%manufacturers)) { # code as before except that we get the "key"-re from a hash if (/$hash->{'key'}/) { $m=$manu; last; } $hash= undef; } if (defined $hash) { no warnings qw/uninitialized/; # if we found a hash we execute the version re $version= join('', /$hash->{'version'}/); # and join all the version numbers found - which is at most 1 ;) } print <<RESULT; $m $version RESULT [download] `$\=~s;s.;q^\|D9JYJ^^qq^\//\\\///^;ex;print`	[reply] [d/l] [select]