148 lines
3.4 KiB
Perl
Executable File
148 lines
3.4 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
my $develop = 'develop';
|
|
my $runner = 'podman';
|
|
|
|
if($ENV{PWD}=~m#/utils$#) {
|
|
chdir("..");
|
|
}
|
|
|
|
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;
|
|
#}
|
|
|
|
|
|
|
|
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"],
|
|
]);
|
|
|
|
for my $devStamp(@devs) {
|
|
print "+ Development $devStamp found\n";
|
|
devdirInfo($devStamp, "$develop/$devStamp")
|
|
}
|
|
#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")
|
|
#}
|
|
|
|
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};
|
|
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
|
|
}
|
|
|
|
|
|
|