##########################################################################
# package WINSTools.pm
#
# This module contains routines for analyzing the contents of a WINS 
# database, presented as a flat file

# V      Who       When        What
# ---------------------------------------------------------------------------
# 1.0.1  skendric  2009-01-26  Debug prints to terminal rather than syslog
# 1.0.0  skendric  2009-01-21  First version
#
#
#
# Authors:  Stuart Kendrick <sbk {insert at sign here } skendric
#                                {insert dot here} com>
#
# Source:  http://www.skendric.com/device/soma
#
# This software is available under the GNU GENERAL PUBLIC LICENSE, see
# http://www.fsf.org/licenses/gpl.html
#


package FHCRC::VDOPS::WINSTools;

#### Load modules ####
use strict;
use warnings;
use Carp qw(carp cluck croak confess);
use Data::Dumper;
use Exporter;
use Net::IPAddress qw(validaddr);
use Perl6::Say;
use Switch;

use lib '/home/soma/lib';
use FHCRC::VDOPS::SomaData;
use FHCRC::VDOPS::Utilities;

#### Set-up export stuff ####
our @ISA = qw(Exporter);
our @EXPORT =    qw(
                          extract_wins_names
                    );

# Declare package local variables


##### Only subroutines below here ####



########################################################################
# Build a hash of WINS names keyed by IP address
########################################################################
sub extract_wins_names {
  my %version;           # Hash of database versions keyed by IP address

  # Debug trace
  trace_location('begin') if $debug;

  # Open file
  open my $file, '<', $wins_file or die "Cannot open $wins_file: $!";

  # Walk file, extracting node information
  LINE:
  while (my $line = <$file>) {
    my ($name, $suffix, $type, $state, $version, $group, $date, $time, $ampm, $ip, $owner);

    # Skip blank lines
    next LINE if $line =~ /^$/;

    # Skip if this line contains the column headers
    next LINE if $line =~ /NAME/ and $line =~ /TYPE/ and $line =~ /STATE/;

    # Strip leading white space
    ($line = $line) =~ s/^\s+//;

    # Grab fields
    ($name, $suffix, $type, $state, $version, $group, $date, $time, $ampm, $ip, $owner) = split /\s+/, $line, 12;

    # Ignore unless key fields are defined
    unless (defined $name and defined $suffix and defined $state and defined $ip and defined $version) {
      say "Malformed line:  $line" if $debug;
      next LINE;
    }

    # Ignore unless at least one character belongs to the ASCII set
    unless ($name =~ /\w/) {
      say "Unprintable name $name, skipping $ip" if $debug == 8;
      next LINE;
    }

    # Ignore unless suffix is bracket delimited
    unless ($suffix =~ /\[/ and $suffix =~ /\]/) {
      say "Malformed suffix $suffix, skipping $name" if $debug == 8;
      next LINE;
    }

    # Ignore unless suffix is a workstation
    ($suffix) = ($suffix =~ /\[(\w\w\w)\]/);
    unless ($suffix eq '00h') {
      say "Not a workstation:  $name $suffix" if $debug == 8;
      next LINE;
    }

    # Ignore unless state is active
    unless ($state eq 'ACTIVE') {
      say "State is $state, skipping $name" if $debug == 8;
      next LINE;
    }

    # Ignore unless IP address is well-formed
    unless (validaddr($ip)) {
      say "Malformed address $ip, skipping $name" if $debug == 8;
      next LINE;
    }

    # If we've seen this IP address before, compare versions and 
    # store the most recent
    if (defined $wins{$ip}) {
      switch ($version{$ip} cmp $version) {
        case 0 {
          say "Duplicate $name, same ver $version, skipping $ip" if $debug == 8;
          next LINE;
        }
        case 1 {
          say "Duplicate but older $name, keeping $wins{$ip} for $ip" if $debug == 8;
          next LINE;
        }
        case -1 {
          say "Newer $name, overwriting $wins{$ip} on $ip" if $debug == 8;
          $wins{$ip} = $name;
        }
      }
    }

    # Save the result
    $version{$ip} = $version;
    $wins{$ip} = $name;

  }

  # Debug trace
  trace_location('end') if $debug;
  
  return 1;
} 



1;