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   12835 use strict;
  8         19  
  8         223  
15 8     8   3752 use IO::File;
  8         60395  
  8         1012  
16 8     8   1583 use XAO::Utils;
  8         20  
  8         517  
17 8     8   2646 use XAO::Base;
  8         24  
  8         307  
18 8     8   2598 use XAO::Objects;
  8         21  
  8         279  
19 8     8   49 use XAO::Projects qw(:all);
  8         16  
  8         986  
20              
21 8     8   128 use base qw(Test::Unit::TestCase);
  8         27  
  8         7278  
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 22552 my $self=shift;
30              
31 25         65357 chomp(my $pwd=`pwd`);
32              
33 25         446 my $root;
34 25         666 foreach my $d ("$pwd/t/xao","$pwd/t/testcases/testroot","$pwd/testcases/testroot") {
35 25 50       954 if(-d $d) {
36 25         114 $root=$d;
37 25         109 last;
38             }
39             }
40              
41 25   33     209 $root||="$pwd/t/xao";
42              
43 25         736 XAO::Base::set_root($root);
44              
45 25         493 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 2428 my $self=shift;
69 25         280 $self->get_stdout();
70 25         145 $self->get_stderr();
71 25         231 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 49 my $self=shift;
88             $self->assert(!$self->{tempfileout},
89 1         38 "Already catching STDOUT");
90              
91 1 50       57 open(TEMPSTDOUT,">&STDOUT") || die;
92 1   50     56 my $tempstdout=IO::File->new_from_fd(fileno(TEMPSTDOUT),"w") || die;
93 1         229 $self->assert($tempstdout,
94             "Can't make a copy of STDOUT");
95 1         20 $self->{tempstdout}=$tempstdout;
96              
97 1         167 $self->{tempfileout}=IO::File->new_tmpfile();
98             $self->assert($self->{tempfileout},
99 1         7 "Can't create temporary file");
100              
101 1         25 open(STDOUT,'>&' . $self->{tempfileout}->fileno);
102             }
103              
104             sub get_stdout ($) {
105 26     26 0 163 my $self=shift;
106              
107 26         142 my $file=$self->{tempfileout};
108 26 100       119 return undef unless $file;
109              
110 1         8 open(STDOUT,'>&' . $self->{tempstdout}->fileno);
111 1         30 $self->{tempstdout}->close();
112              
113 1         29 $file->seek(0,0);
114 1         97 my $text=join('',$file->getlines);
115 1         75 $file->close;
116              
117 1         43 delete $self->{tempfileout};
118 1         4 delete $self->{tempstdout};
119              
120 1         5 return $text;
121             }
122              
123             sub catch_stderr ($) {
124 1     1 0 29 my $self=shift;
125             $self->assert(!$self->{tempstderr},
126 1         5 "Already catching STDERR");
127              
128 1 50       35 open(TEMPSTDERR,">&STDERR") || die;
129 1   50     7 my $tempstderr=IO::File->new_from_fd(fileno(TEMPSTDERR),"w") || die;
130 1         71 $self->assert($tempstderr,
131             "Can't make a copy of STDERR");
132 1         15 $self->{tempstderr}=$tempstderr;
133              
134 1         96 $self->{tempfileerr}=IO::File->new_tmpfile();
135             $self->assert($self->{tempfileerr},
136 1         7 "Can't create temporary file");
137              
138 1         13 open(STDERR,'>&' . $self->{tempfileerr}->fileno);
139             }
140              
141             sub get_stderr ($) {
142 26     26 0 127 my $self=shift;
143              
144 26         50 my $file=$self->{tempfileerr};
145 26 100       68 return undef unless $file;
146              
147 1         11 open(STDERR,'>&' . $self->{tempstderr}->fileno);
148 1         28 $self->{tempstderr}->close();
149              
150 1         9 $file->seek(0,0);
151 1         36 my $text=join('',$file->getlines);
152 1         66 $file->close;
153              
154 1         32 delete $self->{tempfileerr};
155 1         4 delete $self->{tempstderr};
156              
157 1         4 return $text;
158             }
159              
160             1;
161             __END__