143 lines
3.6 KiB
Perl
143 lines
3.6 KiB
Perl
package Util;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use diagnostics;
|
|
|
|
use DateTime;
|
|
|
|
use feature 'say';
|
|
|
|
my $ntfy_url = 'https://ntfy.vps.chriphost.de';
|
|
my $ntfy_token = 'tk_rx8fd6hojuz4ekcb72j7juugkbmga'; # May be public
|
|
my $ntfy_topic = 'fail-alerts';
|
|
|
|
sub notify {
|
|
my ($msg) = @_;
|
|
|
|
system( 'curl', '-H', "Authorization: Bearer $ntfy_token",
|
|
'-d', $msg, "$ntfy_url/$ntfy_topic" );
|
|
|
|
sleep(1);
|
|
}
|
|
|
|
sub notify_file {
|
|
my ($file) = @_;
|
|
|
|
system(
|
|
'curl', '-H', "Authorization: Bearer $ntfy_token",
|
|
'-T', $file, '-H', "Filename: $file",
|
|
"$ntfy_url/$ntfy_topic"
|
|
);
|
|
|
|
sleep(1);
|
|
}
|
|
|
|
sub shell_quote {
|
|
my ($string) = @_;
|
|
$string =~ s/'/'"'"'/g;
|
|
return "'$string'";
|
|
}
|
|
|
|
sub date_now {
|
|
my $dt = DateTime->now( time_zone => 'local' );
|
|
my $date = $dt->iso8601;
|
|
|
|
return $date;
|
|
}
|
|
|
|
sub rewrite_file {
|
|
my ( $file, $matches, $replacement ) = @_;
|
|
|
|
open( my $readhandle, '<', $file ) or die "failed to open $file: $!";
|
|
my @lines;
|
|
my $found = 0;
|
|
while ( my $line = <$readhandle> ) {
|
|
if ( index( $line, $matches ) != -1 ) {
|
|
$line = $replacement;
|
|
$found = 1;
|
|
}
|
|
push @lines, $line;
|
|
}
|
|
close($readhandle) or die "failed to close $file: $!";
|
|
|
|
die "no line containing $matches found in $file" unless $found;
|
|
|
|
open( my $writehandle, '>', $file ) or die "failed to open $file: $!";
|
|
print $writehandle @lines or die "failed to write $file: $!";
|
|
close($writehandle) or die "failed to close $file: $!";
|
|
|
|
say "Updated $file with $replacement";
|
|
}
|
|
|
|
sub cpu_count {
|
|
open( my $handle, '/proc/cpuinfo' ) or die "Can't open cpuinfo: $!\n";
|
|
my $count = scalar( map /^processor/, <$handle> );
|
|
close $handle;
|
|
|
|
return $count;
|
|
}
|
|
|
|
sub find_files {
|
|
my ($dir) = @_;
|
|
|
|
opendir( my $dhandle, $dir ) or die "opendir($dir): $!";
|
|
my @files = sort grep { -f "$dir/$_" } readdir($dhandle);
|
|
closedir($dhandle);
|
|
|
|
return @files;
|
|
}
|
|
|
|
sub find_subdirs {
|
|
my ($dir) = @_;
|
|
|
|
opendir( my $dhandle, $dir ) or die "opendir($dir): $!";
|
|
my @subdirs =
|
|
sort grep { $_ ne '.' && $_ ne '..' && -d "$dir/$_" } readdir($dhandle);
|
|
closedir($dhandle);
|
|
|
|
return @subdirs;
|
|
}
|
|
|
|
sub execute_query {
|
|
my ( $experiment, $queryname, $db_conf, $builds_dir, $do_notify_file ) = @_;
|
|
|
|
my $module = "Queries::$queryname";
|
|
my $file = "$module.pm";
|
|
$file =~ s/::/\//g;
|
|
|
|
require $file;
|
|
|
|
my $query = $module->can('query') or die "$module can't query()";
|
|
my $args = $module->can('args') or die "$module can't args()";
|
|
my $filename = $module->can('filename') or die "$module can't filanem()";
|
|
my $postprocess = $module->can('postprocess')
|
|
or die "$module can't postprocess()";
|
|
|
|
my $querystring = $query->($experiment);
|
|
my $argsstring = $args->();
|
|
my $filenamestring = $filename->();
|
|
|
|
# TODO: Pass the values instead of rewriting db.conf.
|
|
# Can also use DBI's database handle directly.
|
|
my $result =
|
|
qx{mariadb --defaults-file=$db_conf $argsstring -e "$querystring"};
|
|
die "Query failed: $?" if $? != 0;
|
|
|
|
$postprocess->($result);
|
|
|
|
system( 'mkdir', '-p', "$builds_dir/$experiment" );
|
|
open( my $results_handle, '>', "$builds_dir/$experiment/$filenamestring" )
|
|
or die "failed to open file: $!";
|
|
print $results_handle $result;
|
|
close($results_handle) or die "failed to close file: $!";
|
|
|
|
if ( defined $do_notify_file and $do_notify_file == 1 ) {
|
|
notify_file("$builds_dir/$experiment/$filenamestring");
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
1;
|