File Coverage

blib/lib/XAO/testcases/base.pm
Criterion Covered Total %
statement 75 88 85.2
branch 7 10 70.0
condition 3 7 42.8
subroutine 13 17 76.4
pod 0 10 0.0
total 98 132 74.2


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             XAO::testcases::base - base class for easier project testing
4              
5             =head1 DESCRIPTION
6              
7             This class extends Test::Unit::TestCase with a couple of methods useful
8             for project testing.
9              
10             =cut
11              
12             ###############################################################################
13             package XAO::testcases::base;
14 8     8   13861 use strict;
  8         19  
  8         230  
15 8     8   4422 use IO::File;
  8         62453  
  8         988  
16 8     8   1527 use XAO::Utils;
  8         17  
  8         477  
17 8     8   2772 use XAO::Base;
  8         22  
  8         313  
18 8     8   2810 use XAO::Objects;
  8         20  
  8         257  
19 8     8   53 use XAO::Projects qw(:all);
  8         14  
  8         1029  
20              
21 8     8   138 use base qw(Test::Unit::TestCase);
  8         26  
  8         7600  
22              
23             sub siteconfig {
24 0     0 0 0 my $self=shift;
25 0         0 return $self->{'siteconfig'};
26             }
27              
28             sub set_up {
29 25     25 0 23258 my $self=shift;
30              
31 25         72473 chomp(my $pwd=`pwd`);
32              
33 25         451 my $root;
34 25         746 foreach my $d ("$pwd/t/xao","$pwd/t/testcases/testroot","$pwd/testcases/testroot") {
35 25 50       1025 if(-d $d) {
36 25         198 $root=$d;
37 25         122 last;
38             }
39             }
40              
41 25   33     255 $root||="$pwd/t/xao";
42              
43 25         1086 XAO::Base::set_root($root);
44              
45 25         568 push @INC,$root;
46             }
47              
48             sub set_up_project {
49 0     0 0 0 my $self=shift;
50              
51 0         0 my $config=XAO::Objects->new(
52             objname => 'Config',
53             sitename => 'test',
54             );
55              
56 0         0 create_project(
57             name => 'test',
58             object => $config,
59             set_current => 1,
60             );
61              
62 0         0 $config->init();
63              
64 0         0 $self->{'siteconfig'}=$config;
65             }
66              
67             sub tear_down {
68 25     25 0 2762 my $self=shift;
69 25         259 $self->get_stdout();
70 25         189 $self->get_stderr();
71 25         262 drop_project('test');
72             }
73              
74             sub timestamp ($$) {
75 0     0 0 0 my $self=shift;
76 0         0 time;
77             }
78              
79             sub timediff ($$$) {
80 0     0 0 0 my $self=shift;
81 0         0 my $t1=shift;
82 0         0 my $t2=shift;
83 0         0 $t1-$t2;
84             }
85              
86             sub catch_stdout ($) {
87 1     1 0 96 my $self=shift;
88             $self->assert(!$self->{tempfileout},
89 1         40 "Already catching STDOUT");
90              
91 1 50       63 open(TEMPSTDOUT,">&STDOUT") || die;
92 1   50     60 my $tempstdout=IO::File->new_from_fd(fileno(TEMPSTDOUT),"w") || die;
93 1         237 $self->assert($tempstdout,
94             "Can't make a copy of STDOUT");
95 1         21 $self->{tempstdout}=$tempstdout;
96              
97 1         220 $self->{tempfileout}=IO::File->new_tmpfile();
98             $self->assert($self->{tempfileout},
99 1         7 "Can't create temporary file");
100              
101 1         33 open(STDOUT,'>&' . $self->{tempfileout}->fileno);
102             }
103              
104             sub get_stdout ($) {
105 26     26 0 191 my $self=shift;
106              
107 26         139 my $file=$self->{tempfileout};
108 26 100       167 return undef unless $file;
109              
110 1         8 open(STDOUT,'>&' . $self->{tempstdout}->fileno);
111 1         45 $self->{tempstdout}->close();
112              
113 1         30 $file->seek(0,0);
114 1         103 my $text=join('',$file->getlines);
115 1         88 $file->close;
116              
117 1         48 delete $self->{tempfileout};
118 1         10 delete $self->{tempstdout};
119              
120 1         9 return $text;
121             }
122              
123             sub catch_stderr ($) {
124 1     1 0 28 my $self=shift;
125             $self->assert(!$self->{tempstderr},
126 1         4 "Already catching STDERR");
127              
128 1 50       31 open(TEMPSTDERR,">&STDERR") || die;
129 1   50     6 my $tempstderr=IO::File->new_from_fd(fileno(TEMPSTDERR),"w") || die;
130 1         91 $self->assert($tempstderr,
131             "Can't make a copy of STDERR");
132 1         16 $self->{tempstderr}=$tempstderr;
133              
134 1         103 $self->{tempfileerr}=IO::File->new_tmpfile();
135             $self->assert($self->{tempfileerr},
136 1         13 "Can't create temporary file");
137              
138 1         11 open(STDERR,'>&' . $self->{tempfileerr}->fileno);
139             }
140              
141             sub get_stderr ($) {
142 26     26 0 142 my $self=shift;
143              
144 26         62 my $file=$self->{tempfileerr};
145 26 100       73 return undef unless $file;
146              
147 1         3 open(STDERR,'>&' . $self->{tempstderr}->fileno);
148 1         28 $self->{tempstderr}->close();
149              
150 1         21 $file->seek(0,0);
151 1         38 my $text=join('',$file->getlines);
152 1         67 $file->close;
153              
154 1         35 delete $self->{tempfileerr};
155 1         5 delete $self->{tempstderr};
156              
157 1         4 return $text;
158             }
159              
160             1;
161             __END__