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;

}