#!/opt/vdops/bin/perl # Track the volume of discards on physical ports # V Who When What # --------------------------------------------------------------------------- # 1.3.6 skendric 2011-06-30 Track ifName in data file # 1.3.5 skendric 2011-06-29 Track prefix in data file # 1.3.0 skendric 2011-06-27 Identify IF via chassis/slot/port rather than # ifName # 1.2.0 skendric 2011-06-24 Track each interface # 1.1.0 skendric 2011-06-24 Skip SPAN ports # 1.0.0 skendric 2011-06-22 First Version # # Source: http://www.skendric.com/device # # This software is available under the GNU GENERAL PUBLIC LICENSE, see # http://www.fsf.org/licenses/gpl.html # # This script takes the following approach: # - Accepts a list of targets # - Query each interface on the device for ifInDiscards and ifOutDiscards # and sum them # - Read an ASCII database which tracks the numbers read last time # - Calculate the diff, append to log files # - Save the newly recorded figure # # Requirements: # -The target(s) must be pingable # # -PERL modules: the FHCRC::Netops collection # # # Assumptions: # # # Tested on: # - perl-5.12.2 # - net-snmp-5.6 # # # Instructions: # - Customize the script for your site, in particular, the section # listing which devices to ignore # - Run manually and check for errors # # # Caveats: # # Known Bugs: # # # To do: # -Add support for SNMPv3 # # Begin script # =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= # Header stuff # =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= # Load modules use v5.12.0; use strict; use warnings FATAL => 'all'; use feature 'say'; use feature 'switch'; no autovivification qw(exists fetch); use Array::Utils qw(array_minus); use Carp qw(carp cluck croak confess); use Data::Dumper; use English qw( -no_match_vars ); use File::Path; use Getopt::Std; use List::MoreUtils qw(any); use FHCRC::Netops::IFTools 1.3.3; use FHCRC::Netops::NetopsTools 2.3.1; use FHCRC::Netops::NetopsData 1.4.4; use FHCRC::Netops::SNMPTools 1.5.4; use FHCRC::Netops::Utilities 1.4.5; # Declare global variables # We consider a port 'active' if the sum of ifInDiscards + ifOutDiscards, # gathered during this run, are greater than zero # 'quint' means 'target prefix chassis slot port' my %active_ports_by_device; # Number of ports which saw discards since the # last run, keyed by target my @alarm_if; # List of quints for which discards exceeds # threshold my $current_time; # Time in seconds my $data_file; # Where we store data my $date; # Human readable date my $discard_threshold; # Number of discards past which we will alarm my %discards_by_device; # Hash of discards across all active ports # since the last time we ran, keyed by target my %discards_by_if; # Hash of discards, keyed by quint my %disk; # Data read from disk, keyed by quint my $gone_days; # If we haven't contacted this interface in this # many days, we remove it from the data file my $home_dir; # Home directory beneath which I stash files my %ifName; # Keyed by quint my @ignore_if_types; # List of ifType to ignore my $gross_log_file; # Store total discards across flock my $last_date; # Date from disk file my $last_time; # Time from disk file my %live; # Data gathered during this pass, keyed by quint my $mean_log_file; # Store mean discards per switch in this file my %merged; # %live merged with %disk my $log_dir; # Directory where I store log files my %mean_discards_by_device; # Average discards, considering only active ports, # keyed by target my $mean_discards_across_active_ports; # Considering only ports which have seen # discards (active ports): this variable stores # the average my $rpt_dir; # Directory where I write report files my %skip_interface; # Hash of switches keyed by switch-ifName # These are interfaces with known issues which # we want to ignore, i.e. which we know about # and which we do not want triggering e-mail my %span_port_iid; # Hash of SPAN port iid, keyed by quint my $summary_file; # Where to write the summary report my $suppress_days; # If we haven't seen this interface in this many # days, we ignore its discard counter, even if it # has incremented since the last read. The point # here is to suppress alarms on interfaces which # have seen substantial activity but for which # that activity has accumulated over more than # our usual cycle time my $time; # Human readable time my $total_active_ports; # Number of ports flock-wide which saw discards # since the last run my $total_live_ports; # Total number of ports across all devices my $total_discards; # Total number of discards across all devices # since we last ran my %verified_by_if; # Last time we've seen this port, keyed by triplet # Define global variables # Debug definitions # 15 = # 14 = ifName/ifType (do_the_work and slice_if_name) # 13 = Merged (compare_counts) # 12 = Live (gather_discards) # 11 = Disk (read_data) # 10 = SPAN ports (identify_span_ports) # 9 = Database SELECT operations # 8 = Per IP/MAC/Port processing # 7 = Database INSERT/UPDATE/DELETE # 6 = Dump SNMP var # 5 = Dump snmp_packets # 4 = Grody: print big var # 3 = Verbose: print mid var # 2 = Simple: print small var # 1 = Basic: subroutine trace # 0 = Disable debugging $program_name = 'discard-alarm'; $usage = 'Usage: discard-alarm -s {yes|no} [-t {threshold}] [-d {integer}] [-r] [-z {netops_global_config}] [-y {netops_alarm_config}] [-a | -e {expr} | -f {filename} | target1 target2 target3 ...]'; $version = '1.3.6'; # Directories $home_dir = '/home/netops'; $log_dir = "$home_dir/logs/discard-alarm"; $rpt_dir = "$home_dir/rpts"; # Files $data_file = "$rpt_dir/discard-alarm.data"; $log_file = "$log_dir/discard-alarm.log"; $gross_log_file = "$log_dir/discard-alarm-gross.log"; $mean_log_file = "$log_dir/discard-alarm-mean.log"; $summary_file = "$rpt_dir/discard-alarm-summary.txt"; # Global counters $total_active_ports = 0; $total_discards = 0; $total_live_ports = 0; # Ignore interfaces whose ifTypes contain these strings @ignore_if_types = qw/other pppoe software loopback virtual vlan/; # Skip specific target / interface combinations %skip_interface = ( "gbsr-a-esx GigabitEthernet2/2" => 1, "gbsr-b-esx GigabitEthernet2/2" => 1, ); # Thresholds $discard_threshold = 1000; # Time $current_time = time(); $date = get_date(); $time = get_time(); $gone_days = 30; $last_date = $QUERY; $last_time = $QUERY; $suppress_days = 3; # Grab arguments getopts('ad:e:f:rs:t:y:z:', \%option); @target = @ARGV; # Set mode if ($option{r}) { $mode = 'report' } elsif (-t STDIN) { $mode = 'interactive' } else { $mode = 'batch' } # =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= # Begin Main Program # =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= { check_args(); # Check arguments read_config(); # Read Netops config file compile_mibs(); # Compile MIB files build_target(); # Build list of targets target_check(); # Look for errors in @target basic_info(); # Gather information sanity_check(); # Sanity check read_data(); # Read data file identify_span_ports(); # Flag ports receiving mirrored traffic do_the_work(); # Gather data from devices compare_counts(); # Update our notion of port counters look_for_alarms(); # Review data, looking for problems write_alarm_log(); # Record issues write_data(); # Write new data file write_device_logs(); # Log total number of ports write_summary(); # Write summary file print_report(); # Print report notify_staff(); # Mail report } # =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= # End Main Program # =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= ######################################################################## # Sort on the 'target chassis slot port' construct ######################################################################## sub by_quint { my ($a_host, $a_prefix, $a_chassis, $a_slot, $a_port); my ($b_host, $b_prefix, $b_chassis, $b_slot, $b_port); ($a_host, $a_prefix, $a_chassis, $a_slot, $a_port) = split $SPACE, $a; ($b_host, $b_prefix, $b_chassis, $b_slot, $b_port) = split $SPACE, $b; if (($a_host cmp $b_host) != 0) { $a_host cmp $b_host } elsif (($a_prefix cmp $b_prefix) != 0) { $a_prefix cmp $b_prefix } elsif (($a_chassis <=> $b_chassis) != 0) { $a_chassis <=> $b_chassis } elsif (($a_slot <=> $b_slot) != 0) { $a_slot <=> $b_slot } elsif (($a_port <=> $b_port) != 0) { $a_port <=> $b_port } } ######################################################################## # Compare the current discards (%live) to those from the data file (%disk) # and store the merged result in %merged. ######################################################################## sub compare_counts { # Debug trace trace_location('begin') if $debug; # Notify operator print_it('Comparing counts...'); # Walk through %live comparing the discard counter we just acquired with # the counter stored on disk for my $quint (sort by_quint keys %live) { my ($host, $prefix, $chassis, $slot, $port); my ($changed, $delta, $disk_count, $event, $ifName, $live_count, $verified); say $quint if $debug == 13; # Get the current data $live_count = $live{$quint}; # Grab an entry from the disk file if (exists $disk{$quint}) { ($host, $prefix, $chassis, $slot, $port, $ifName, $disk_count, $changed, $verified) = split /\s+/, $disk{$quint}; } # Debug info if ($debug == 13) { say " live = $live_count"; given ($disk_count) { when (undef) { say ' disk = none' } default { say " disk = $disk_count" } } } # Compare # New port: save it to %merged but ignore its discard counters if (not exists $disk{$quint}) { $event = 'New Port'; $merged{$quint} = "$quint $ifName{$quint} $live_count $current_time $current_time"; } # Typical case: we've seen this port before and its discard counters # haven't incremented elsif ($live_count == $disk_count) { $event = 'No Change'; $merged{$quint} = "$quint $ifName{$quint} $disk_count $changed $current_time"; $discards_by_if{$quint} = 0; $verified_by_if{$quint} = $current_time; } # This port has discarded frames since we last talked to it elsif ($live_count != $disk_count) { $event = 'Activity'; $delta = abs($live_count - $disk_count); $merged{$quint} = "$quint $ifName{$quint} $live_count $current_time $current_time"; $discards_by_if{$quint} = $delta; $verified_by_if{$quint} = $current_time; } # The usual 'should never happen' clause else { $event = 'Error'; $merged{$quint} = "$quint ? ? ? ?"; say 'Should not reach here in compare_counts'; } # Debug info say " $event: $merged{$quint}" if $debug == 13; } # End 'Walk through %live' # Handle unresponsive ports # OK, that's good: %merged now contains an updated view of everything # captured in %live. However, what about devices for which %disk # contains information, but %live does not? i.e. devices which didn't # respond during this pass: let's handle these say 'Handling unresponsive ports' if $debug == 13; for my $quint (sort by_quint keys %disk) { my ($host, $prefix, $chassis, $slot, $port); my ($changed, $disk_count, $event, $ifName, $verified); # Grab an entry from the disk file ($host, $prefix, $chassis, $slot, $port, $ifName, $disk_count, $changed, $verified) = split /\s+/, $disk{$quint}; # If we didn't see this port in %live, include it in %merged if (not exists $live{$quint}) { $event = 'Unresponsive'; $merged{$quint} = "$quint $ifName $disk_count $changed $verified"; say "$event: merged{$quint} = $merged{$quint}" if $debug == 13; } } # End 'Handle unresponsive ports' # Make things look pretty say('') if $mode eq 'interactive'; # Debug trace trace_location('end') if $debug; return 1; } ######################################################################## # Gather data from devices ######################################################################## sub do_the_work { # Debug trace trace_location('begin') if $debug; # Notify operator print_it('Gathering discards...'); # Walk target for my $target (@target) { my (%arg, $ifDescr_ref, $ifName_ref, $ifType_ref); say "Processing $target" if $debug; # Acquire ifName and ifType $ifDescr_ref = walk_oid($target, $ifDescr_oid); $ifName_ref = walk_oid($target, $ifName_oid); $ifType_ref = walk_oid($target, 'ifType', 1); # Debug info if ($debug == 14) { say 'Dumping ifName : ifType'; for my $iid (sort keys %$ifName_ref) { printf " %-30s %-30s\n", $ifName_ref->{$iid}, $ifType_ref->{$iid}; } } # Define %arg %arg = ( host => $target, ifDescr => $ifDescr_ref, ifName => $ifName_ref, ifType => $ifType_ref, ); # Gather discards $arg{'ov'} = 'ifInDiscards'; gather_discards(\%arg); $arg{'ov'} = 'ifOutDiscards'; gather_discards(\%arg); # Entertain the operator print $BANG if ($mode eq 'interactive' and not $debug); } # Count ports $total_live_ports = keys %live; # Make things look pretty say "\n" if $mode eq 'interactive'; # Debug trace trace_location('end') if $debug; return 1; } ######################################################################## # Gather ifIn/OutDiscards ######################################################################## sub gather_discards { my $arg = shift; my $discard_ref; # Array of varbinds from a walk on $ov my $host; # Device to query my $ifDescr_ref; # Array of varbinds from a walk on ifDescr my $ifName_ref; # Array of varbinds from a walk on ifName my $ifType_ref; # Array of varbinds from a walk on ifType my $ov; # ifInDiscards or ifOutDiscards # Debug trace trace_location('begin') if $debug; # Sanity check confess 'No parameter' unless defined $arg; confess 'Paramter must be a hash ref' unless ref $arg eq 'HASH'; confess 'Must define host' unless defined $arg->{host}; confess 'Must define ov' unless defined $arg->{ov}; confess 'ifDescr must be hash ref' unless ref $arg->{ifDescr} eq 'HASH'; confess 'ifName must be hash ref' unless ref $arg->{ifName} eq 'HASH'; confess 'ifType must be hash ref' unless ref $arg->{ifType} eq 'HASH'; confess 'Object Value must be ifInDiscards or ifOutDiscards' unless ($arg->{ov} eq 'ifInDiscards' or $arg->{ov} eq 'ifOutDiscards'); # Extract arguments $host = $arg->{host}; $ov = $arg->{ov}; $ifDescr_ref = $arg->{ifDescr}; $ifName_ref = $arg->{ifName}; $ifType_ref = $arg->{ifType}; # Default info say " Handling $ov on $host" if $debug > 2; # Build discards $discard_ref = walk_oid($host, $ov); # Build %live data structure PORT: for my $iid (sort keys %$discard_ref) { my ($prefix, $chassis, $slot, $port); my ($count, $discards, $ifDescr, $ifName, $ifType, $quint, $str); # Sanity check unless (defined $ifDescr_ref->{$iid}) { say " Cannot find ifDescr for ifIndex $iid, skipping" if $debug == 12; next PORT; } unless (defined $ifName_ref->{$iid}) { say " Cannot find ifName for ifIndex $iid, skipping" if $debug == 12; next PORT; } unless (defined $ifType_ref->{$iid}) { say " Cannot find ifType for ifIndex $iid, skipping" if $debug == 12; next PORT; } # Extract specifies for this IID $discards = $discard_ref->{$iid}; $ifDescr = $ifDescr_ref->{$iid}; $ifName = $ifName_ref->{$iid}; $ifType = $ifType_ref->{$iid}; # Debug info say " ifIndex $iid : ifName $ifName : ifDescr $ifDescr = $discards" if $debug == 12; # Skip ports unless they are physical (test ifType) if ( any {$ifType =~ /$_/i} @ignore_if_types) { say " Skipping $ifName / $ifType because ifType isn't physical" if $debug == 12; next PORT; } # Skip ports unless they are physical (test ifName) if ( any {$ifName =~ /$_/i} @ignore_if_types) { say " Skipping $ifName / $ifType because ifName isn't physical" if $debug == 12; next PORT; } # Skip ports unless they are physical (test ifDescr) if ( any {$ifDescr =~ /$_/i} @ignore_if_types) { say " Skipping $ifName/ $ifType because ifDescr isn't physical" if $debug == 12; next PORT; } # Parse ifName $ifName = shrink_if_descr($ifName); $str = slice_if_name($ifName); unless (defined $str) { log_it("For $host, could not parse $ifName, skipping"); next PORT; } ($prefix, $chassis, $slot, $port) = split $COLON, $str; $quint = "$host $prefix $chassis $slot $port"; say " quint = $quint" if $debug == 12; # Save stats $live{$quint} += $discards; $ifName{$quint} = $ifName; # Debug info say " live{$quint} = ", $live{$quint} if $debug == 12; } # End PORT # Debug trace trace_location('end') if $debug; return 1; } ######################################################################## # Identify SPAN ports ######################################################################## sub identify_span_ports { # Debug trace trace_location('begin') if $debug; # Notify operator say 'Identifying SPAN ports...' if $mode eq 'interactive'; # Walk targets for my $target (@target) { my $span_port_ref; say "Processing $target" if $debug == 10; # Acquire portCopyStatus $span_port_ref = snmpWalk( {host => $target, oid => 'portCopyStatus'} ); # Save active SPAN ports PORT: for my $varbind (@$span_port_ref) { my ($prefix, $chassis, $slot, $port); my ($dst, $ifName, $quint, $src, $status, $str); $status = $varbind->{val}; next PORT unless defined $status; next PORT unless $status eq 'active'; ($src, $dst) = split /\./, $varbind->{iid}; # Produce quint $ifName = snmpGet( {host => $target, oid => "$ifName_oid.$dst"} ); unless (defined $ifName and $ifName ne $EMPTY_STR) { log_it("For $target, cannot parse ifName.$dst, skipping"); next PORT; } $ifName = shrink_if_descr($ifName); $str = slice_if_name($ifName); ($prefix, $chassis, $slot, $port) = split $COLON, $str; # Build quint $quint = "$target $prefix $chassis $slot $port"; # Save results $span_port_iid{$quint} = $dst; log_it("For $target, $ifName is a SPAN port"); # Debug info say " $ifName: ifIndex $dst is a SPAN port" if $debug == 10; } # End 'Save active SPAN ports' # Entertain operator print $BANG if ($mode eq 'interactive' and not $debug); } # Make things look pretty say "\n" if $mode eq 'interactive'; # Debug trace trace_location('end') if $debug; return 1; } ######################################################################## # Examine the data structures we've built, look for interfaces whose # discard counters have exceeded $discard_threshold. While we're here, # calculate various summary counters ######################################################################## sub look_for_alarms { # Debug trace trace_location('begin') if $debug; # Notify operator print_it('Looking for alarms...'); # Walk through the interfaces for which we saw discards since our last run # Remember that this data structure does not include newly added ports, i.e. # ports which we saw today for the first time IF: for my $quint (sort by_quint keys %discards_by_if) { my ($target, $prefix, $chassis, $slot, $port); my ($discards, $ifName, $suppress_seconds); say "Considering $quint" if $debug; # Populate local variables ($target, $prefix, $chassis, $slot, $port) = split $SPACE, $quint; $discards = $discards_by_if{$quint}; $ifName = $ifName{$quint}; $suppress_seconds = $suppress_days * 60 * 60 * 24; # Ignore SPAN ports if (defined $span_port_iid{$quint}) { log_it("$quint reports $discards discards but is a SPAN port, ignoring"); next IF; } # Ignore ports which we haven't seen recently if ($current_time - $verified_by_if{$quint} > $suppress_seconds) { my $last = epoch_to_tstamp($verified_by_if{$quint}); log_it("$quint reports $discards discards but we have not seen it since $last, ignoring"); next IF; } # Ignore devices flagged as down for maintenance if (any {$target eq $_} @down_for_maintenance) { log_it("$quint reports $discards discards but belongs to down_for_maintenance, ignoring"); next IF; } # Skip interfaces belonging to the skip list if ($skip_interface{"$target $ifName"}) { log_it("For $target, $ifName belongs to skip list, ignoring"); say "For $target, $ifName belongs to skip list, ignoring" if $debug; next IF; } # Record alarms for ports whose discard counter exceeds threshold if ($discards > $discard_threshold) { $total_active_ports++; $alarm_count{$target}++; push @alarm_if, $quint; push @{$alarms{$target}}, $ifName; $shit_happens++; log_it("$quint reports $discards discards which exceeds the threshold of $discard_threshold: in alarm"); } # Update summary counters $active_ports_by_device{$target}++; $discards_by_device{$target} += $discards; $total_discards += $discards; } # End 'Walk through interfaces' # Calculate more summary counters for my $target (sort keys %discards_by_device) { my ($discards, $ports); $discards = $discards_by_device{$target}; $ports = $active_ports_by_device{$target}; $ports //= 0; given ($ports) { when (0) { $mean_discards_by_device{$target} = 0 } default { $mean_discards_by_device{$target} = int ($discards / $ports) } } } if ($total_active_ports > 0) { $mean_discards_across_active_ports = int ($total_discards / $total_active_ports); } else { $mean_discards_across_active_ports = 0; } # Make things look pretty say('') if $mode eq 'interactive'; # Debug trace trace_location('end') if $debug; return 1; } ######################################################################## # Print report ######################################################################## sub print_report { my $handle; my $now = get_now(); my $rough_number; my $total = @target; my $troubled = keys %alarms; my @troubled = keys %alarms; $troubled[0] //= $DASH; # Debug trace trace_location('begin') if $debug; # Notify operator print_it('Printing report...'); # Direct output to screen or to file if ($mode eq 'interactive') { $handle = *STDOUT; } else { open $handle, '>', $report_file or die "Cannot open $report_file: $!\n"; } # Initialize $rough_number = fuzzy_number($total_discards); print {$handle} <) { my ($prefix, $chassis, $slot, $port); my ($changed, $discards, $ifName, $quint, $target, $verified); # Grab date/time if ($line =~ /Date/) { ($last_date, $last_time) = ($line =~ /Date:\s+(\w+\s+\w+\s+\d+,\s+\d+)\s+at\s+(\d\d:\d\d:\d\d)/); next LINE; } # Skip blank lines next LINE if $line =~ /^\s*$/; # Skip comments and dashes next LINE if $line =~ /^#|^\-/; # Read a line of data ($target, $prefix, $chassis, $slot, $port, $ifName, $discards, $changed, $verified) = split /\s+/, $line; # Sanity check if (not defined $target or not defined $prefix or not defined $chassis or not defined $slot or not defined $port or not defined $ifName or not defined $discards or not defined $changed or not defined $verified) { log_it("Mangled line: $line"); next LINE; } if ($target eq $EMPTY_STR or $prefix eq $EMPTY_STR or $chassis eq $EMPTY_STR or $slot eq $EMPTY_STR or $port eq $EMPTY_STR or $ifName eq $EMPTY_STR or $discards eq $EMPTY_STR or $changed eq $EMPTY_STR or $verified eq $EMPTY_STR) { log_it("Mangled line: $line"); next LINE; } # Build quad $quint = "$target $prefix $chassis $slot $port"; # Build data structure $disk{"$quint"} = "$quint $ifName $discards $changed $verified"; # Debug info say "disk{$quint} = $disk{$quint}" if $debug == 11; } # End LINE loop # Clean-up close $data or warn "Cannot close $data_file: $!"; # Make things look pretty say('') if $mode eq 'interactive'; # Debug trace trace_location('end') if $debug; return 1; } ######################################################################## # Sanity check ######################################################################## sub sanity_check { # Debug trace trace_location('begin') if $debug; # Notify operator print_it('Sanity check...'); # Verify that we have a data file die "Cannot touch $data_file: $!" unless touch_file($data_file, 0664); # Verify that the data file is readable/writeable die "Cannot read $data_file: $!" unless -r $data_file; die "Cannot write $data_file: $!" unless -w $data_file; # Verify that we have a log directory unless (-e $log_dir) { mkpath($log_dir, 0, 0750) or die "Cannot create $log_dir: $!"; } die "Cannot write to $log_dir" unless -w $log_dir; # Initialize for my $target (@target) { $active_ports_by_device{$target} = 0; $discards_by_device{$target} = 0; $mean_discards_by_device{$target} = 0; } # Make things look pretty say('') if $mode eq 'interactive'; # Debug trace trace_location('end') if $debug; return 1; } ######################################################################## # Write new data file ######################################################################## sub write_data { my $handle; my $now = get_now(); my $time = time; # Debug trace trace_location('begin') if $debug; # Notify operator print_it('Writing data file...'); # Check for blanks unless ($dome) { say 'Running in test mode: skipping data file update'; return 1; } # Open data file unless (open $handle, '>', $data_file) { print_it("Cannot open data file $data_file: $!"); return 0; } print {$handle} <', $gross_log_file) { print {$log} "Date Time Total Discards\n\n"; close $log or warn "Cannot close $gross_log_file: $!"; } else { warn "Cannot open $gross_log_file: $!"; } } # Create mean file and add header, if not already there unless (-e $mean_log_file) { if (open my $log, '>', $mean_log_file) { print {$log} "Date Time Mean Discards per Device\n\n"; close $log or warn "Cannot close $mean_log_file: $!"; } else { warn "Cannot open $mean_log_file: $!"; } } # Write gross discards if (open my $log, '>>', $gross_log_file) { printf {$log} "%10s %8s %58d\n", $date, $time, $total_discards; close $log or warn "Cannot close $gross_log_file: $!"; } else { warn "Cannot open $gross_log_file: $!"; } # Write mean discards across the flock if (open my $log, '>>', $mean_log_file) { printf {$log} "%10s %8s %58d\n", $date, $time, $mean_discards_across_active_ports; close $log or warn "Cannot close $mean_log_file: $!"; } else { warn "Cannot open $mean_log_file: $!"; } # Write per device logs for my $target (sort @target) { # Create gross file and add header, if not already there unless (-e "$log_dir/$target-gross") { if (open my $log, '>', "$log_dir/$target-gross") { print {$log} "Date Time Total Discards\n\n"; close $log or warn "Cannot close $log_dir/$target-gross: $!"; } else { warn "Cannot open $log_dir/$target-gross: $!"; } } # Create mean file and add header, if not already there unless (-e "$log_dir/$target-mean") { if (open my $log, '>', "$log_dir/$target-mean") { print {$log} "Date Time Mean Discards\n\n"; close $log or warn "Cannot close $log_dir/$target-mean: $!"; } else { warn "Cannot open $log_dir/$target-mean: $!"; } } # Write gross data if (open my $log, '>>', "$log_dir/$target-gross") { printf {$log} "%10s %8s %58d\n", $date, $time, $discards_by_device{$target}; close $log or warn "Cannot close $log_dir/$target-gross: $!"; } else { warn "Cannot open $log_dir/$target-gross: $!"; } # Write mean data if (open my $log, '>>', "$log_dir/$target-mean") { printf {$log} "%10s %8s %58d\n", $date, $time, $mean_discards_by_device{$target}; close $log or warn "Cannot close $log_dir/$target-mean: $!"; } else { warn "Cannot open $log_dir/$target-mean: $!"; } } # End 'Write per device logs' # Make things look pretty say('') if $mode eq 'interactive'; # Debug trace trace_location('end') if $debug; return 1; } ######################################################################## # Write summary file ######################################################################## sub write_summary { my $handle; my $now = get_now(); my $rough_number; my $total = @target; my $troubled = keys %alarms; my @troubled = keys %alarms; $troubled[0] //= $DASH; # Debug trace trace_location('begin') if $debug; # Notify operator print_it('Writing summary file...'); # Open report file unless (open $handle, '>', $summary_file) { print_it("Cannot open $summary_file: $!"); return 0; } # Initialize $rough_number = fuzzy_number($total_discards); print {$handle} <