X-Git-Url: https://git.exim.org/users/heiko/exim.git/blobdiff_plain/fefe59d9280bc0b33fb9e1e89d0d664db8078542..d54f95770344279e0fa76fa37524bc7dba42b244:/test/lib/Exim/Runtest.pm?ds=sidebyside diff --git a/test/lib/Exim/Runtest.pm b/test/lib/Exim/Runtest.pm index 1677ae3e6..32537f543 100644 --- a/test/lib/Exim/Runtest.pm +++ b/test/lib/Exim/Runtest.pm @@ -2,12 +2,15 @@ package Exim::Runtest; use 5.010; use strict; use warnings; +use File::Basename; use IO::Socket::INET; use Cwd; use Carp; -use parent 'Exporter'; -our @EXPORT_OK = qw(mailgroup dynamic_socket exim_binary); +use Exporter; +our @ISA = qw(Exporter); + +our @EXPORT_OK = qw(mailgroup dynamic_socket exim_binary flavour flavours); our %EXPORT_TAGS = ( all => \@EXPORT_OK, ); @@ -104,6 +107,36 @@ sub exim_binary { return $binaries[0], @_; } +sub flavour { + my $etc = '/etc'; + + if (@_) { + croak "do not pass a directory, it's for testing only" + unless $ENV{HARNESS_ACTIVE}; + $etc = shift; + } + + if (open(my $f, '<', "$etc/os-release")) { + local $_ = join '', <$f>; + my ($id) = /^ID="?(.*?)"?\s*$/m; + my ($version) = /^VERSION_ID="?(.*?)"?\s*$/m; + return "$id$version"; + } + + if (open(my $f, '<', "$etc/debian_version")) { + chomp(local $_ = <$f>); + $_ = int $_; + return "debian$_"; + } + + undef; +} + +sub flavours { + my %h = map { /\.(\S+)$/, 1 } + glob('stdout/*.*'), glob('stderr/*.*'); + return sort keys %h; +} 1; @@ -131,6 +164,16 @@ Otherwise search the binary (while honouring C, C<../scripts/os-type> and C<../os-arch>) and return the the path to the binary and the unmodified I<@argv>. +=item B() + +Find a hint for the current flavour (Linux distro). It does so by checking +typical files in the F directory. + +=item B() + +Return a list of available flavours. It does so by scanning F and +F for I files (extensions after the numerical prefix. + =back =cut