/[soft]/rpm/urpmi/trunk/t/helper.pm
ViewVC logotype

Contents of /rpm/urpmi/trunk/t/helper.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4852 - (show annotations) (download)
Fri Jun 8 18:50:43 2012 UTC (8 years, 2 months ago) by tv
File size: 4417 byte(s)
(system_should_partially_fail,urpmi_partial) introduce them for next commit
1 package helper;
2
3 use Test::More;
4 use base 'Exporter';
5 our @EXPORT = qw(need_root_and_prepare
6 start_httpd httpd_port
7 urpmi_addmedia urpmi_removemedia urpmi_update
8 urpm_cmd run_urpm_cmd urpmi_cmd urpmi urpmi_partial test_urpmi_fail urpme
9 urpmi_cfg set_urpmi_cfg_global_options
10 system_ system_should_fail
11 rpm_is_jbj_version
12 check_installed_fullnames check_installed_names check_nothing_installed
13 check_installed_and_remove check_installed_fullnames_and_remove check_installed_and_urpme
14 );
15
16 my $using_root;
17 sub need_root_and_prepare() {
18 if ($< != 0) {
19 #- can't test
20 pass();
21 exit(0);
22 }
23 -d 'media' or die "02create_pkgs.t not done\n";
24
25 system('rm -rf root');
26 isnt(-d 'root', "test root dir can not be removed $!");
27 mkdir 'root';
28 $using_root = 1;
29 $ENV{LC_ALL} = 'C';
30 }
31
32 my $server_pid;
33 sub httpd_port { 6969 }
34 sub start_httpd() {
35 system('perl -MNet::Server::Single -e 1') == 0 or die "module Net::Server::Single is missing (package perl-Net-Server)\n";
36 $server_pid = fork();
37 if ($server_pid == 0) {
38 exec './simple-httpd', $::pwd, "$::pwd/tmp", httpd_port();
39 exit 1;
40 }
41 'http://localhost:' . httpd_port();
42 }
43
44 chdir 't' if -d 't';
45
46 mkdir 'tmp';
47 chomp($::pwd = `pwd`);
48 my $urpmi_debug_opt = '-q';
49 #$urpmi_debug_opt = '-v --debug';
50
51 sub urpm_cmd {
52 my ($prog, $o_perl_para) = @_;
53 $o_perl_para ||= '';
54 "perl $o_perl_para -I.. ../$prog --urpmi-root $::pwd/root $urpmi_debug_opt";
55 }
56 sub urpm_cmd_no_quiet {
57 my ($prog, $o_perl_para) = @_;
58 $o_perl_para ||= '';
59 "perl $o_perl_para -I.. ../$prog --urpmi-root $::pwd/root";
60 }
61 sub run_urpm_cmd {
62 my ($prog, $o_perl_para) = @_;
63 my $cmd = urpm_cmd_no_quiet($prog, $o_perl_para);
64 print "# $cmd\n";
65 `$cmd`;
66 }
67 sub urpmi_cmd() { urpm_cmd('urpmi') }
68
69 sub urpmi_addmedia {
70 my ($para) = @_;
71 system_(urpm_cmd('urpmi.addmedia') . " $para");
72 }
73 sub urpmi_removemedia {
74 my ($para) = @_;
75 system_(urpm_cmd('urpmi.removemedia') . " $para");
76 }
77 sub urpmi_update {
78 my ($para) = @_;
79 system_(urpm_cmd('urpmi.update') . " $para");
80 }
81 sub urpmi_partial {
82 my ($para) = @_;
83 system_should_partially_fail(urpmi_cmd() . " --ignoresize $para");
84 }
85 sub urpmi {
86 my ($para) = @_;
87 system_(urpmi_cmd() . " --ignoresize $para");
88 }
89 sub test_urpmi_fail {
90 my ($para) = @_;
91 system_should_fail(urpmi_cmd() . " $para");
92 }
93 sub urpme {
94 my ($para) = @_;
95 system_(urpm_cmd('urpme') . " $para");
96 }
97 sub urpmi_cfg() {
98 "$::pwd/root/etc/urpmi/urpmi.cfg";
99 }
100 sub set_urpmi_cfg_global_options {
101 my ($options) = @_;
102 require_ok('urpm::cfg');
103 ok(my $config = urpm::cfg::load_config(urpmi_cfg()));
104 $config->{global} = $options;
105 ok(urpm::cfg::dump_config(urpmi_cfg(), $config), 'set_urpmi_cfg_global_options');
106 }
107
108 sub system_ {
109 my ($cmd) = @_;
110 system($cmd);
111 ok($? == 0, $cmd);
112 }
113 sub system_should_partially_fail {
114 my ($cmd) = @_;
115 system($cmd);
116 ok($? == 17 << 8, $cmd);
117 }
118 sub system_should_fail {
119 my ($cmd) = @_;
120 system($cmd);
121 # on some error questions ("Do you want to... (y/N)?"), urpmi doesn't output "\n":
122 print "\n";
123 $? & 127 ? is($? & 127, 0, "should fail nicely but not get killed: $cmd")
124 : ok($? != 0, "should fail: $cmd");
125 }
126
127 sub rpm_is_jbj_version {
128 # checking for --yaml support
129 `rpm --help` =~ /yaml/;
130 }
131
132 sub check_installed_fullnames {
133 my (@names) = @_;
134 is(`rpm -qa --root $::pwd/root | sort`, join('', map { "$_\n" } sort(@names)));
135 }
136
137 sub check_installed_names {
138 my (@names) = @_;
139 is(`rpm -qa --qf '%{name}\\n' --root $::pwd/root | sort`, join('', map { "$_\n" } sort(@names)));
140 }
141
142 sub check_nothing_installed() {
143 is(`rpm -qa --root $::pwd/root`, '');
144 }
145
146 sub check_installed_and_remove {
147 my (@names) = @_;
148 check_installed_names(@names);
149 system_("rpm --root $::pwd/root -e " . join(' ', @names)) if @names;
150 check_nothing_installed();
151 }
152
153 sub check_installed_fullnames_and_remove {
154 my (@names) = @_;
155 check_installed_fullnames(@names);
156 system_("rpm --root $::pwd/root -e " . join(' ', @names)) if @names;
157 check_nothing_installed();
158 }
159
160 sub check_installed_and_urpme {
161 my (@names) = @_;
162 check_installed_names(@names);
163 urpme(join(' ', @names));
164 check_nothing_installed();
165 }
166
167
168 END {
169 $using_root and system('rm -rf root');
170 $server_pid and kill(9, $server_pid);
171 system('rm -rf tmp');
172 }
173
174 1;

  ViewVC Help
Powered by ViewVC 1.1.28