fradrive/utils/develop-status.pl

#!/usr/bin/env perl

use strict;
use warnings;

my $develop = 'develop';
my $runner = 'podman';

if($ENV{PWD}=~m#/utils$#) {
  chdir("..");
}

my %listOutside=(
  running=>1,
  _default=>0, # everything for which no key exists
);

for my $arg(@ARGV) {
  if('-a' eq $arg) {
    %listOutside=(_default=>1);
    next
  }
  if('-h' eq $arg) {
    usage()
  }
  usage("Invalid argument: '$arg'");
}

sub usage {
  my $msg = shift;
  print "$msg\n\n" if $msg;
  print "$0 [args]

  -h   display this help text

  -a   show all containers with fitting names even when without containerfile
";
  exit 1 if $msg;
  exit 0
}

print "== Development status ==\n";

# Find out container status
#my @cont = split /\R/, qx($runner ps --no-trunc);
#shift @cont; # remove title row
#
#my %cont = ();
#for(@cont) {
#  m#^([0-9a-f]+)\s# || do { warn "cannot parse output of container runner ($_); status incomplete!"; next };
#  $cont{$1} = 1;
#}

my @cont = split /\R/, qx($runner ps -a --no-trunc -f name='^fradrive.' --format='{{.State}} ::: {{.ID}} ::: {{.Names}}');
my %cont = ();
for(@cont) {
  m#(.*) ::: (.*) ::: (.*)# || next;
  $cont{$2} = {
    state=>$1,
    id=>$2,
    name=>$3,
    used=>0,
  }
}


if(not -e $develop) {
  print "No develop directory, seems to be nothing active.\n";
  exit
}

my @devs = filesFromDir($develop,
  [
  qr((?:^\.)),
  [qr((?:[0-9]{4}-[0-9]{2}-[0-9]{2}T)), 1, "File '%fn' does not look like a development dir, skip"],
  ]);

#my $devDir = undef;
#opendir($devDir, "$develop") or die "Cannot open develop directory, because: $!";
#while(my $devStamp = readdir($devDir)) {
#  next if $devStamp=~m#^\.#;
#  print "+ Development $devStamp found\n";
#  if($devStamp!~m#[0-9]{4}-[0-9]{2}-[0-9]{2}T#) {
#    warn "$0: Does not look like a development dir, skip"
#  }
#  devdirInfo($devStamp, "$develop/$devStamp")
#}

for my $k(sort {
  $cont{$a}{state} cmp $cont{$b}{state} ||
  $cont{$a}{name} cmp $cont{$b}{name}
} grep { !$cont{$_}{used} } keys %cont) {
  my $c = $cont{$k};
  my $show = $listOutside{$c->{state}} // $listOutside{_default};
  print "Fradrive container outside develop file: ($c->{state}) $c->{name} $c->{id}\n" if $show
}

for my $devStamp(@devs) {
  print "+ Development $devStamp found\n";
  devdirInfo($devStamp, "$develop/$devStamp")
}

exit 0;

sub devdirInfo {
  my ($name, $path) = @_;
  my @fns = filesFromDir($path, [qr((?:^\.))]);
  for my $fn(@fns) {
    print "  + Containerfile $fn found\n";
    checkContainerFile("$path/$fn");
  }
}

sub checkContainerFile {
  my $fn = shift;
  my $fh = undef;
  my %h = ();
  open($fh, '<', $fn) or do {
    warn "$0: Can not read $fn, because: $!\n";
    return
  };
  for(<$fh>) {
    next if m#^\s*$#;
    m#(.*)=(.*)# or do { warn "$0: Bad row in containerfile '$fn': $_" };
    my ($k, $v) = ($1, $2);
    if(exists $h{$k}) {
      warn "$0: In containerfile '$fn': Key '$k' is set multiple times!\n"
    }
    $h{$k} = $v;
  }
  print "      $_=$h{$_}\n" for sort keys %h;
  my $id = $h{CONTAINER_ID};
  $cont{$id}{used} = 1;
  if(not defined $id) {
    warn "$0: In containerfile '$fn': No CONTAINER_ID set\n";
    return
  }
  my $stateLine = qx($runner container inspect -f='{{.State.Status}} ::: {{.Name}}' "$id");
  if($stateLine=~m#^(.*?) ::: (.*)$#) {
  #  print "    Container is running\n"
    my ($state, $name) = ($1, $2);
    print "    Containername: $name\n";
    if('running' eq $state) {
      print "    Container is running\n";
    } else {
      print "    !!! Container is not running but instead in state '$state'\n";
    }
  } else {
    print "    !!! Container is not in the memory anymore !!!\n";
    print "STATE: $stateLine\n"
  }
  #if($cont{$id}) {
  #  print "    Container is running\n"
  #} else {
  #  print "    !!! Container is NOT running\n"
  #}
  #$RUNNER ps --no-trunc
}

#my @find = split /\R/, qx(find $develop);
#
#
#print "FIND\n";
#print " --- $_\n" for @find;
#print "CONT\n";
#print " --- $_\n" for @cont;

#print "CONT $_\n" for sort keys %cont;


sub filesFromDir {
  my ($path, $exclude) = @_;
  my $dirh = undef;
  my @ret = ();
  my @warn = ();
  opendir($dirh, $path);
  DIR: while(my $fn = readdir($dirh)) {
    for(@$exclude) {
      my ($re, $negate, $msg) = ($_);
      ($re, $negate, $msg) = @$_ if 'ARRAY' eq ref $_;
      if($negate xor $fn=~m#$re#) {
        if(defined $msg) {
          $msg=~s#%fn#$fn#;
          push @warn, [$fn, $msg]
        }
        next DIR
      }
    }
    push @ret, $fn
  }
  @ret = sort @ret;
  @warn = sort {$a->[0] cmp $b->[0]} @warn;
  for(@warn) {
    warn "$0: $_\n";
  }
  return @ret
}