| 3 | 
           rodolico | 
           1 | 
           #!/usr/bin/env perl
  | 
        
        
            | 
            | 
           2 | 
              | 
        
        
            | 
            | 
           3 | 
           # Common library for havirt. Basically, just a place to put things which may be used by any
  | 
        
        
            | 
            | 
           4 | 
           # part of havirt.
  | 
        
        
            | 
            | 
           5 | 
              | 
        
        
            | 
            | 
           6 | 
           # v0.0.1 20240602 RWR
  | 
        
        
            | 
            | 
           7 | 
           # Initial setup
  | 
        
        
            | 
            | 
           8 | 
              | 
        
        
            | 
            | 
           9 | 
           package havirt;
  | 
        
        
            | 
            | 
           10 | 
              | 
        
        
            | 
            | 
           11 | 
              | 
        
        
            | 
            | 
           12 | 
           our $VERSION = '0.01';
  | 
        
        
            | 
            | 
           13 | 
           use warnings;
  | 
        
        
            | 
            | 
           14 | 
           use strict;  
  | 
        
        
            | 
            | 
           15 | 
              | 
        
        
            | 
            | 
           16 | 
           use Data::Dumper qw(Dumper); # Import the Dumper() subroutine
  | 
        
        
            | 
            | 
           17 | 
              | 
        
        
            | 
            | 
           18 | 
           use Exporter;
  | 
        
        
            | 
            | 
           19 | 
              | 
        
        
            | 
            | 
           20 | 
           our @ISA = qw( Exporter );
  | 
        
        
            | 
            | 
           21 | 
           our @EXPORT = qw( 
  | 
        
        
            | 
            | 
           22 | 
                             &readDB &writeDB
  | 
        
        
            | 
            | 
           23 | 
                             &report_tsv &report_screen
  | 
        
        
            | 
            | 
           24 | 
                           );
  | 
        
        
            | 
            | 
           25 | 
              | 
        
        
            | 
            | 
           26 | 
              | 
        
        
            | 
            | 
           27 | 
              | 
        
        
            | 
            | 
           28 | 
           sub readDB {
  | 
        
        
            | 
            | 
           29 | 
              my ($filename) = @_;
  | 
        
        
            | 
            | 
           30 | 
              my $yaml = YAML::Tiny->new( {} );
  | 
        
        
            | 
            | 
           31 | 
              if ( -f $filename ) {
  | 
        
        
            | 
            | 
           32 | 
                 $yaml = YAML::Tiny->read( $filename );
  | 
        
        
            | 
            | 
           33 | 
              }
  | 
        
        
            | 
            | 
           34 | 
              return $yaml->[0];
  | 
        
        
            | 
            | 
           35 | 
           }
  | 
        
        
            | 
            | 
           36 | 
              | 
        
        
            | 
            | 
           37 | 
           sub writeDB {
  | 
        
        
            | 
            | 
           38 | 
              my ($filename,$data) = @_;
  | 
        
        
            | 
            | 
           39 | 
              my $yaml = YAML::Tiny->new( $data );
  | 
        
        
            | 
            | 
           40 | 
              $yaml->write( $filename );
  | 
        
        
            | 
            | 
           41 | 
           }
  | 
        
        
            | 
            | 
           42 | 
              | 
        
        
            | 
            | 
           43 | 
           sub report_tsv {
  | 
        
        
            | 
            | 
           44 | 
              my ( $header, $data ) = @_;
  | 
        
        
            | 
            | 
           45 | 
              my @output;
  | 
        
        
            | 
            | 
           46 | 
              push @output, join( "\t", @$header );
  | 
        
        
            | 
            | 
           47 | 
              for( my $line = 0; $line < @$data; $line++ ) {
  | 
        
        
            | 
            | 
           48 | 
                 push @output, join( "\t", @{$data->[$line]} );
  | 
        
        
            | 
            | 
           49 | 
              } # for
  | 
        
        
            | 
            | 
           50 | 
              return join( "\n", @output ) . "\n";
  | 
        
        
            | 
            | 
           51 | 
           }
  | 
        
        
            | 
            | 
           52 | 
              | 
        
        
            | 
            | 
           53 | 
           sub report_screen {
  | 
        
        
            | 
            | 
           54 | 
              my ( $header, $data ) = @_;
  | 
        
        
            | 
            | 
           55 | 
              my @output;
  | 
        
        
            | 
            | 
           56 | 
              my @widths;
  | 
        
        
            | 
            | 
           57 | 
              my $column;
  | 
        
        
            | 
            | 
           58 | 
              my $row;
  | 
        
        
            | 
            | 
           59 | 
              # First, initialize by using the length of the headers
  | 
        
        
            | 
            | 
           60 | 
              for ( $column = 0; $column < @$header; $column++ ) {
  | 
        
        
            | 
            | 
           61 | 
                 @widths[$column] = length( $header->[$column] );
  | 
        
        
            | 
            | 
           62 | 
              }
  | 
        
        
            | 
            | 
           63 | 
              # now, go through all data in each row, for each column, and increment the width if it is larger
  | 
        
        
            | 
            | 
           64 | 
              for ( $row = 0; $row < @$data; $row++ ) {
  | 
        
        
            | 
            | 
           65 | 
                 for ( $column = 0; $column < @$header; $column++ ) {
  | 
        
        
            | 
            | 
           66 | 
                    $widths[$column] = length( $data->[$row][$column] ) 
  | 
        
        
            | 
            | 
           67 | 
                       if length( $data->[$row][$column] ) > $widths[$column];
  | 
        
        
            | 
            | 
           68 | 
                 } # for column
  | 
        
        
            | 
            | 
           69 | 
              } # for row
  | 
        
        
            | 
            | 
           70 | 
              # actually do the print now
  | 
        
        
            | 
            | 
           71 | 
              my @format;
  | 
        
        
            | 
            | 
           72 | 
              for ( $column = 0; $column < @widths; $column++ ) {
  | 
        
        
            | 
            | 
           73 | 
                 push ( @format, '%' . $widths[$column] . 's' );
  | 
        
        
            | 
            | 
           74 | 
              }
  | 
        
        
            | 
            | 
           75 | 
              my $format = join( ' ', @format ) . "\n";
  | 
        
        
            | 
            | 
           76 | 
              my $output = sprintf( $format, @$header );
  | 
        
        
            | 
            | 
           77 | 
              for ( $row = 0; $row < @$data; $row++ ) {
  | 
        
        
            | 
            | 
           78 | 
                 $output .= sprintf( $format, @{$data->[$row]} );
  | 
        
        
            | 
            | 
           79 | 
              } # for row
  | 
        
        
            | 
            | 
           80 | 
              return $output;
  | 
        
        
            | 
            | 
           81 | 
           }
  |