Subversion Repositories havirt

Rev

Rev 3 | Rev 10 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 3 Rev 4
Line 1... Line 1...
1 
#!/usr/bin/env perl
 1 
#!/usr/bin/env perl
2 
 
 2 
 
3 
# Common library for havirt. Basically, just a place to put things which may be used by any
 3 
# Common library for havirt. Basically, just a place to put things which may be used by any
- 
 
 4 
# part of havirt. More for organizations purposes.
- 
 
 5 
 
- 
 
 6 
# Copyright 2024 Daily Data, Inc.
- 
 
 7 
#
- 
 
 8 
# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
4 
# part of havirt.
 9 
# conditions are met:
- 
 
 10 
#
- 
 
 11 
#   Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
- 
 
 12 
#   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer
- 
 
 13 
#   in the documentation and/or other materials provided with the distribution.
- 
 
 14 
#   Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived
- 
 
 15 
#   from this software without specific prior written permission.
- 
 
 16 
#
- 
 
 17 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT
- 
 
 18 
# NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
- 
 
 19 
# THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
- 
 
 20 
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- 
 
 21 
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
- 
 
 22 
# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- 
 
 23 
 
5 
 
 24 
 
6 
# v0.0.1 20240602 RWR
 25 
# v0.0.1 20240602 RWR
7 
# Initial setup
 26 
# Initial setup
8 
 
 27 
 
9 
package havirt;
 28 
package havirt;
10 
 
 29 
 
11 
 
 30 
 
12 
our $VERSION = '0.01';
 - 
 
13 
use warnings;
 31 
use warnings;
14 
use strict;
32 
use strict;
15 
 
 33 
 
16 
use Data::Dumper qw(Dumper); # Import the Dumper() subroutine
 34 
use Data::Dumper qw(Dumper); # Import the Dumper() subroutine
17 
 
 35 
 
- 
 
 36 
# define the version number
- 
 
 37 
# see https://metacpan.org/pod/release/JPEACOCK/version-0.97/lib/version.pod
- 
 
 38 
use version;
- 
 
 39 
our $VERSION = version->declare("0.0.1");
- 
 
 40 
 
- 
 
 41 
 
18 
use Exporter;
 42 
use Exporter;
19 
 
 43 
 
20 
our @ISA = qw( Exporter );
 44 
our @ISA = qw( Exporter );
21 
our @EXPORT = qw(
45 
our @EXPORT = qw(
22 
                  &readDB &writeDB
 46 
                  &readDB &writeDB
- 
 
 47 
                  &report
23 
                  &report_tsv &report_screen
 48 
                  &loadNodePopulations
24 
                );
 49 
                );
25 
 
 50 
 
26 
 
 51 
 
27 
 
 52 
 
28 
sub readDB {
 53 
sub readDB {
Line 38... Line 63...
38 
   my ($filename,$data) = @_;
 63 
   my ($filename,$data) = @_;
39 
   my $yaml = YAML::Tiny->new( $data );
 64 
   my $yaml = YAML::Tiny->new( $data );
40 
   $yaml->write( $filename );
 65 
   $yaml->write( $filename );
41 
}
 66 
}
42 
 
 67 
 
- 
 
 68 
sub loadNodePopulations {
- 
 
 69 
   return if $main::nodePopulations;
- 
 
 70 
   $main::nodePopulations = &readDB( $main::nodePopulationDBName );
- 
 
 71 
}
- 
 
 72 
 
- 
 
 73 
sub report {
- 
 
 74 
   if ( $main::reportFormat eq 'tsv' ) {
- 
 
 75 
      return &report_tsv( @_ );
- 
 
 76 
   } else {
- 
 
 77 
      return &report_screen( @_ );
- 
 
 78 
   }
- 
 
 79 
}
- 
 
 80 
 
43 
sub report_tsv {
 81 
sub report_tsv {
44 
   my ( $header, $data ) = @_;
 82 
   my ( $header, $data ) = @_;
45 
   my @output;
 83 
   my @output;
46 
   push @output, join( "\t", @$header );
 84 
   push @output, join( "\t", @$header );
47 
   for( my $line = 0; $line < @$data; $line++ ) {
 85 
   for( my $line = 0; $line < @$data; $line++ ) {