1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
# Make output flow in sync
$| = 1;
# Hide debug output and print verbose output to STDOUT
my $verbose = qr/^\s*(#|Searching|Indexing|Updating|Updated|Exporting|WARNING)/;
$SIG{__WARN__} = sub {
print STDOUT @_ if $Zim::DEBUG || $ENV{ZIM_DEBUG};
return if $_[0] =~ /^##/;
if ($_[0] =~ $verbose) { print STDOUT @_ }
else { print STDERR @_ }
};
# Set XDG environment
# make modules find local files and hide system
$ENV{XDG_CONFIG_HOME} = './t/config/';
$ENV{XDG_CONFIG_DIRS} = './non_exiting_path/';
$ENV{XDG_DATA_HOME} = './t/share/';
$ENV{XDG_DATA_DIRS} = './share/';
# should be "./blib/share" but test run befor ebuilding share
$ENV{XDG_CACHE_HOME} = './t/cache/';
# Force zim using utf8 - repeat to avoid warning
$Zim::CODESET = $Zim::CODESET = 'utf8';
# Package to generate new empty object classes. These are used in tests
# to instantiate mock objects. So each mock object has it's own unique class.
# You can pass methods, attributes and parent classes to the constructor.
#
# Usage:
#
# my $object = Mock::Object->new(
# ISA => 'Foo::Bar',
# method1 => sub { .. },
# attrib1 => 'Foo!'
# );
package Mock::Object;
use strict;
no strict 'refs';
our $I = 1;
sub new {
my ($class, %param) = @_;
my $isa = delete($param{ISA}) || '';
my $package = $class . $I++;
eval << "EOC";
package $package;
use strict;
use vars qw/\$AUTOLOAD/;
our \%_METHODS_;
our \@ISA = qw/$isa/;
sub AUTOLOAD {
\$AUTOLOAD =~ s/.*:://;
return \$_METHODS_{\$AUTOLOAD}->(\@_)
if exists \$_METHODS_{\$AUTOLOAD};
return (); # all methods exist by default !
}
1;
EOC
die $@ if $@;
my $methods = \%{"$package\:\:_METHODS_"};
$$methods{$_} = delete $param{$_}
for grep {ref($param{$_}) eq 'CODE'} keys %param;
bless \%param, $package;
}
1;
|
