Subversion Repositories havirt

#!/usr/bin/env perl

# Common library for havirt. Basically, just a place to put things which may be used by any
# part of havirt. More for organizations purposes.

# Copyright 2024 Daily Data, Inc.
# 
# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following 
# conditions are met:
#
#   Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
#   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer 
#   in the documentation and/or other materials provided with the distribution.
#   Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived
#   from this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT
# NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
# THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


# v0.0.1 20240602 RWR
# Initial setup

package havirt;


use warnings;
use strict;  

use Data::Dumper qw(Dumper); # Import the Dumper() subroutine

# define the version number
# see https://metacpan.org/pod/release/JPEACOCK/version-0.97/lib/version.pod
use version;
our $VERSION = version->declare("0.0.1");


use Exporter;

our @ISA = qw( Exporter );
our @EXPORT = qw( 
                  &readDB &writeDB
                  &report
                  &loadNodePopulations
                );



sub readDB {
   my ($filename) = @_;
   my $yaml = YAML::Tiny->new( {} );
   if ( -f $filename ) {
      $yaml = YAML::Tiny->read( $filename );
   }
   return $yaml->[0];
}

sub writeDB {
   my ($filename,$data) = @_;
   my $yaml = YAML::Tiny->new( $data );
   $yaml->write( $filename );
}

sub loadNodePopulations {
   return if $main::nodePopulations;
   $main::nodePopulations = &readDB( $main::nodePopulationDBName );
}

sub report {
   if ( $main::reportFormat eq 'tsv' ) {
      return &report_tsv( @_ );
   } else {
      return &report_screen( @_ );
   }
}

sub report_tsv {
   my ( $header, $data ) = @_;
   my @output;
   push @output, join( "\t", @$header );
   for( my $line = 0; $line < @$data; $line++ ) {
      push @output, join( "\t", @{$data->[$line]} );
   } # for
   return join( "\n", @output ) . "\n";
}

sub report_screen {
   my ( $header, $data ) = @_;
   my @output;
   my @widths;
   my $column;
   my $row;
   # First, initialize by using the length of the headers
   for ( $column = 0; $column < @$header; $column++ ) {
      @widths[$column] = length( $header->[$column] );
   }
   # now, go through all data in each row, for each column, and increment the width if it is larger
   for ( $row = 0; $row < @$data; $row++ ) {
      for ( $column = 0; $column < @$header; $column++ ) {
         $widths[$column] = length( $data->[$row][$column] ) 
            if length( $data->[$row][$column] ) > $widths[$column];
      } # for column
   } # for row
   # actually do the print now
   my @format;
   for ( $column = 0; $column < @widths; $column++ ) {
      push ( @format, '%' . $widths[$column] . 's' );
   }
   my $format = join( ' ', @format ) . "\n";
   my $output = sprintf( $format, @$header );
   for ( $row = 0; $row < @$data; $row++ ) {
      $output .= sprintf( $format, @{$data->[$row]} );
   } # for row
   return $output;
}