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
                );

# read a DB file (just a YAML)
# if $lock is set, will create a "lock" file so other processes will
# not try to write to it. Using custom code as flock is automagically
# release when the file is read

sub readDB {
   my $lock = shift;
   my $lockFileName = "$main::statusDBName.lock";
   my $lockTime = 5; # maximum time to wait for lock to clear
   # wait for lock to clear if it exists, if we are wanting a lock
   # and we have tried it for $locktime iterations
   while ( $lock && -f $lockFileName && $lockTime-- ) {
      sleep 1; # wait one second, then try again
   }
   if ( $lock ) {
      die "Something has $main::statusDBName locked, aborting\n" if -f $lockFileName;
      `touch $lockFileName`;
   }
   my $yaml = YAML::Tiny->new( {} );
   if ( -f $main::statusDBName ) {
      $yaml = YAML::Tiny->read( $main::statusDBName );
   }
   $main::statusDB = $yaml->[0];
}

sub writeDB {
   my $yaml = YAML::Tiny->new( $main::statusDB );
   $yaml->write( $main::statusDBName );
   unlink "$main::statusDBName.lock" if -f "$main::statusDBName.lock"; # release any lock we might have on it
}

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;
}