sbotools2

Maintenance fork of the original sbotools version 2
git clone git://git.server.ky/slackcoder/sbotools2
Log | Files | Refs | README

Sbotools.pm (4114B)

      1 package Test::Sbotools;
      2 
      3 use strict;
      4 use warnings;
      5 
      6 use Exporter 'import';
      7 use Test::More;
      8 use Test::Execute;
      9 use FindBin '$RealBin';
     10 use Capture::Tiny 'capture_merged';
     11 use Test::Exit;
     12 use lib "$RealBin/../SBO-Lib/lib";
     13 
     14 # From Test::Execute
     15 $path = "$RealBin/../";
     16 
     17 our @EXPORT_OK = qw/
     18   sbocheck
     19   sboclean
     20   sboconfig
     21   sbofind
     22   sboinstall
     23   sboremove
     24   sbosnap
     25   sboupgrade
     26   set_noclean
     27   set_distclean
     28   set_gpg_verify
     29   set_jobs
     30   set_repo
     31   set_lo
     32   set_version
     33   set_pkg_dir
     34   set_sbo_home
     35   make_slackbuilds_txt
     36   restore_perf_dummy
     37   replace_tags_txt
     38   load
     39 /;
     40 
     41 local $Test::Builder::Level = $Test::Builder::Level + 1;
     42 
     43 sub sbocheck { script('sbocheck', @_); }
     44 sub sboclean { script('sboclean', @_); }
     45 sub sboconfig { script('sboconfig', @_); }
     46 sub sbofind { script('sbofind', @_); }
     47 sub sboinstall { script('sboinstall', @_); }
     48 sub sboremove { script('sboremove', @_); }
     49 sub sbosnap { script('sbosnap', @_); }
     50 sub sboupgrade { script('sboupgrade', @_); }
     51 
     52 sub set_noclean { _set_config('NOCLEAN', @_); }
     53 sub set_distclean { _set_config('DISTCLEAN', @_); }
     54 sub set_gpg_verify { _set_config('GPG_KEY', @_); }
     55 sub set_jobs { _set_config('JOBS', @_); }
     56 sub set_pkg_dir { _set_config('PKG_DIR', @_); }
     57 sub set_sbo_home { _set_config('SBO_HOME', @_); }
     58 sub set_lo { _set_config('LOCAL_OVERRIDES', @_); }
     59 sub set_version { _set_config('SLACKWARE_VERSION', @_); }
     60 
     61 my $sbt = 0;
     62 my $repo = 0;
     63 sub set_repo {
     64 	_set_config('REPO', @_);
     65 	if (-e "/usr/sbo/repo" and not $repo) {
     66 		$repo = 1;
     67                 system('mv', '/usr/sbo/repo', "/tmp/repo.backup");
     68 
     69 		# if $sbt is true, the SLACKBUILDS.TXT has been created by
     70 		# make_slackbuilds_txt and should not be backed up
     71 		if ($sbt) { system('rm', "/tmp/repo.backup/SLACKBUILDS.TXT"); }
     72 	}
     73 }
     74 
     75 my %config;
     76 my %settings = (
     77 	DISTCLEAN         => '-d',
     78         GPG_KEY           => '-g',
     79 	JOBS              => '-j',
     80 	LOCAL_OVERRIDES   => '-o',
     81 	NOCLEAN           => '-c',
     82 	PKG_DIR           => '-p',
     83 	REPO              => '-r',
     84 	SBO_HOME          => '-s',
     85 	SLACKWARE_VERSION => '-V',
     86 );
     87 sub _set_config {
     88 	my ($config, $value) = @_;
     89 
     90 	# if %config is empty, populate it
     91 	if (not %config) {
     92 		sboconfig('-l', { test => 0, expected =>
     93 			sub {
     94 				my $text = shift;
     95 				foreach my $setting (keys %settings) { $text =~ /\Q$setting\E=(.*)/ and $config{$setting} = $1 // 'FALSE'; }
     96 			},
     97 		});
     98 	}
     99 
    100 	if (defined $value) {
    101 		sboconfig($settings{$config}, $value, { test => 0 });
    102 		note "Saving original value of '$config': $config{$config}";
    103 	} else {
    104 		sboconfig($settings{$config}, $config{$config}, { test => 0 });
    105 	}
    106 }
    107 
    108 my $sbtn = "/usr/sbo/repo/SLACKBUILDS.TXT";
    109 sub make_slackbuilds_txt {
    110 	if (not -e $sbtn) { $sbt = 1; system('mkdir', '-p', '/usr/sbo/repo'); system('touch', $sbtn); }
    111 }
    112 
    113 sub restore_perf_dummy {
    114 	if (!-e '/usr/sbo/distfiles/perf.dummy') {
    115 		system('mkdir', '-p', '/usr/sbo/distfiles');
    116 		system('cp', "$RealBin/travis-deps/perf.dummy", '/usr/sbo/distfiles');
    117 	}
    118 }
    119 
    120 my $tags = 0;
    121 my $tags_txt = '/usr/sbo/repo/TAGS.txt';
    122 sub replace_tags_txt {
    123 	if (-e $tags_txt) {
    124 		if (! $tags) {
    125 			$tags = 2;
    126 			rename $tags_txt, "$tags_txt.bak";
    127 		}
    128 	} else {
    129 		$tags = 1 if $tags == 0;
    130 	}
    131 
    132 	system('mkdir', '-p', '/usr/sbo/repo');
    133 	open my $fh, '>', $tags_txt;
    134 	print $fh $_ for @_;
    135 	close $fh;
    136 }
    137 
    138 # Restore original values when exiting
    139 END {
    140 	if (%config) {
    141 		_set_config($_) for keys %settings;
    142 	}
    143 	if ($sbt) {
    144 		system(qw!rm -rf!, $sbtn);
    145 	}
    146 	if ($repo) {
    147 		system(qw! rm -rf /usr/sbo/repo !);
    148                 system('mv', "/tmp/repo.backup", '/usr/sbo/repo');
    149 	}
    150 	if ($tags) {
    151 		system(qw!rm -rf !, $tags_txt);
    152 	}
    153 	if ($tags == 2) {
    154 		rename "$tags_txt.bak", $tags_txt;
    155 	}
    156 }
    157 
    158 sub load {
    159 	my ($script, %opts) = @_;
    160 
    161 	local @ARGV = exists $opts{argv} ? @{ $opts{argv} } : '-h';
    162 	my ($ret, $exit, $out, $do_err);
    163 	my $eval = eval {
    164 		$out = capture_merged { $exit = exit_code {
    165 			package main;
    166 			$ret = do "$RealBin/../$script";
    167 			$do_err = $@;
    168 		}; };
    169 		1;
    170 	};
    171 	my $err = $@;
    172 
    173 	my $explain = { ret => $ret, exit => $exit, out => $out, eval => $eval, err => $err, do_err => $do_err };
    174 	note explain $explain if $opts{explain};
    175 	return $explain;
    176 }
    177 
    178 
    179 1;