File Coverage

blib/lib/OpenGuides/Build.pm
Criterion Covered Total %
statement 21 131 16.0
branch 0 74 0.0
condition 0 7 0.0
subroutine 7 11 63.6
pod 0 4 0.0
total 28 227 12.3


line stmt bran cond sub pod time code
1             package OpenGuides::Build;
2              
3 1     1   989 use strict;
  1         3  
  1         119  
4              
5 1     1   9 use vars qw( $VERSION );
  1         1  
  1         73  
6             $VERSION = '0.04';
7              
8 1     1   3153 use Module::Build;
  1         145110  
  1         48  
9 1     1   831 use OpenGuides::Config;
  1         7  
  1         16  
10 1     1   103 use File::Path;
  1         4  
  1         125  
11 1     1   9 use base 'Module::Build';
  1         3  
  1         427  
12              
13             sub ACTION_install {
14 0     0 0   my $self = shift;
15 0           $self->SUPER::ACTION_install;
16 0           $self->ACTION_install_extras;
17              
18 0           eval "use Config::Tiny";
19 0 0         die "Config::Tiny is required to set up this application.\n" if $@;
20              
21 0           my $config = OpenGuides::Config->new( file => "wiki.conf" );
22              
23             # Initialise the database if necessary.
24             # Using destdir here is a bit far-fetched, unless we expect
25             # packagers to ship pre-initialised databases. However, it is
26             # better than ignoring it. A better solution would be to allow
27             # more control over whether the database is initialised here.
28 0 0 0       my $dbname = ( $config->dbtype eq 'sqlite' && defined $self->destdir ) ?
29             File::Spec->catdir($self->destdir, $config->dbname) :
30             $config->dbname;
31 0           my $dbuser = $config->dbuser;
32 0           my $dbpass = $config->dbpass;
33 0           my $dbhost = $config->dbhost;
34 0           my $dbtype = $config->dbtype;
35              
36 0           my %cgi_wiki_exts = ( postgres => "Pg",
37             mysql => "MySQL",
38             sqlite => "SQLite" );
39              
40 0           my $cgi_wiki_module = "Wiki::Toolkit::Setup::" . $cgi_wiki_exts{$dbtype};
41 0           eval "require $cgi_wiki_module";
42 0 0         die "There was a problem: $@" if $@;
43              
44 0           print "Checking database schema...\n";
45             {
46 1     1   9 no strict 'refs';
  1         3  
  1         1719  
  0            
47 0           &{$cgi_wiki_module . "::setup"}( $dbname, $dbuser, $dbpass, $dbhost );
  0            
48             }
49             }
50              
51             sub ACTION_fakeinstall {
52 0     0 0   my $self = shift;
53 0           $self->SUPER::ACTION_fakeinstall;
54 0           $self->ACTION_install_extras( fake => 1 );
55 0           print "Checking database schema...\n";
56             }
57              
58             sub ACTION_install_extras {
59 0     0 0   my ($self, %args) = @_;
60 0   0       my $FAKE = $args{fake} || 0;
61              
62 0           eval "use Config::Tiny";
63 0 0         die "Config::Tiny is required to set up this application.\n" if $@;
64              
65 0           my $config = OpenGuides::Config->new( file => "wiki.conf" );
66              
67             # Install the scripts where we were told to.
68 0 0         my $install_directory = defined $self->destdir ? File::Spec->catdir( $self->destdir, $config->install_directory ) : $config->install_directory;
69 0           my $script_name = $config->script_name;
70 0 0         my $template_path = defined $self->destdir ? File::Spec->catdir( $self->destdir, $config->template_path ) : $config->template_path;
71 0 0         my $custom_template_path = defined $self->destdir ? File::Spec->catdir( $self->destdir, $config->custom_template_path ) : $config->custom_template_path;
72 0           my $custom_lib_path = $config->custom_lib_path;
73 0 0         my $static_path = defined $self->destdir ? File::Spec->catdir( $self->destdir, $config->static_path ) : $config->static_path;
74 0           my @extra_scripts = @{ $self->config_data( "__extra_scripts" ) };
  0            
75 0           my @templates = @{ $self->config_data( "__templates" ) };
  0            
76 0           my @static_files = @{ $self->config_data( "__static_files" ) };
  0            
77              
78 0           print "Installing scripts to $install_directory:\n";
79             # Allow for blank script_name - assume "index.cgi".
80 0   0       my $script_filename = $script_name || "index.cgi";
81 0 0         if ( $FAKE ) {
82 0           print "wiki.cgi -> $install_directory/$script_filename (FAKE)\n";
83             } else {
84 0 0         if ( $script_filename ne "wiki.cgi" ) {
85 0 0         File::Copy::copy("wiki.cgi", $script_filename)
86             or die "Can't copy('wiki.cgi', '$script_filename'): $!";
87             }
88 0           my $copy = $self->copy_if_modified(
89             $script_filename,
90             $install_directory
91             );
92 0 0         if ( $copy ) {
93 0           $self->fix_shebang_line($copy);
94 0           $self->make_executable($copy);
95 0 0         $self->add_custom_lib_path( $copy, $custom_lib_path )
96             if $custom_lib_path;
97             } else {
98 0           print "Skipping $install_directory/$script_filename (unchanged)\n";
99             }
100 0 0         print "(Really: wiki.cgi -> $install_directory/$script_filename)\n"
101             unless $script_filename eq "wiki.cgi";
102             }
103              
104 0 0         if ( $FAKE ) {
105 0           print "Trying to ensure that wiki.conf is protected.\n";
106             } else {
107 0           my $mentionswikidotconf = 0;
108 0           print "Trying to ensure that wiki.conf is protected by .htaccess.. ";
109 0 0         if (-f "$install_directory/.htaccess") {
110 0 0         if (open HTACCESS, "$install_directory/.htaccess") {
111 0           while () {
112 0 0         if (/wiki\.conf/) {
113 0           $mentionswikidotconf = 1;
114             }
115             }
116 0           close HTACCESS;
117             } else {
118 0           warn "Could not open $install_directory/.htaccess for reading: $!";
119             }
120             }
121 0 0         if ($mentionswikidotconf == 0) {
122 0 0         if (open HTACCESS, ">>$install_directory/.htaccess") {
123 0           print HTACCESS "# Added by OpenGuides installer\n";
124 0           print HTACCESS "\ndeny from all\n";
125 0           close HTACCESS;
126 0           print "apparent success. You should check that this is working!\n";
127             } else {
128 0           warn "Could not open $install_directory/.htaccess for writing: $!";
129             }
130             } else {
131 0           print ".htaccess appears to already mention wiki.conf.\n";
132             }
133             }
134              
135 0           foreach my $script ( @extra_scripts ) {
136 0 0         if ( $FAKE ) {
137 0           print "$script -> $install_directory/$script (FAKE)\n";
138             } else {
139 0           my $copy = $self->copy_if_modified( $script, $install_directory );
140 0 0         if ( $copy ) {
141 0           $self->fix_shebang_line($copy);
142 0 0         $self->make_executable($copy) unless $script eq "wiki.conf";
143 0 0         $self->add_custom_lib_path( $copy, $custom_lib_path )
144             if $custom_lib_path;
145             } else {
146 0           print "Skipping $install_directory/$script (unchanged)\n";
147             }
148             }
149             }
150              
151 0           print "Installing templates to $template_path:\n";
152 0           foreach my $template ( @templates ) {
153 0 0         if ( $FAKE ) {
154 0           print "templates/$template -> $template_path/$template (FAKE)\n";
155             } else {
156 0 0         $self->copy_if_modified(from => "templates/$template", to_dir => $template_path, flatten => 1)
157             or print "Skipping $template_path/$template (unchanged)\n";
158             }
159             }
160 0 0         if ( $FAKE ) {
161 0           print "Making $custom_template_path.\n";
162             } else {
163 0 0         unless (-d $custom_template_path) {
164 0           print "Creating directory $custom_template_path.\n";
165 0 0         File::Path::mkpath $custom_template_path or warn "Could not make $custom_template_path";
166             }
167             }
168              
169 0           print "Installing static files to $static_path:\n";
170 0           foreach my $static_file ( @static_files ) {
171 0 0         if ( $FAKE ) {
172 0           print "static/$static_file -> $static_path/$static_file (FAKE)\n";
173             } else {
174 0 0         $self->copy_if_modified(from => "static/$static_file", to_dir => $static_path, flatten => 1)
175             or print "Skipping $static_path/$static_file (unchanged)\n";
176             }
177             }
178             }
179              
180             sub add_custom_lib_path {
181 0     0 0   my ($self, $copy, $lib_path) = @_;
182 0           local $/ = undef;
183 0 0         open my $fh, $copy or die $!;
184 0           my $content = <$fh>;
185 0 0         close $fh or die $!;
186 0           $content =~ s|use strict;|use strict\;\nuse lib qw( $lib_path )\;|s;
187              
188             # Make sure we can write to the file before we try to (see perldoc -f stat)
189 0           my @file_info = stat( $copy );
190 0           my $orig_mode = $file_info[2] & 07777;
191 0 0         chmod( $orig_mode | 0222, $copy )
192             or warn "Couldn't make $copy writeable: $!";
193 0 0         open $fh, ">$copy" or die $!;
194 0           print $fh $content;
195 0 0         close $fh or die $!;
196 0 0         chmod( $orig_mode, $copy )
197             or warn "Couldn't restore permissions on $copy: $!";
198              
199 0           return 1;
200             }
201              
202             1;