source: trunk/lib/OpenGuides/Build.pm @ 1462

Last change on this file since 1462 was 1462, checked in by bob, 9 years ago

merge in stuff from 0.71 release branch

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.4 KB
Line 
1package OpenGuides::Build;
2
3use strict;
4
5use vars qw( $VERSION );
6$VERSION = '0.03';
7
8use Module::Build;
9use OpenGuides::Config;
10use File::Path;
11use base 'Module::Build';
12
13sub ACTION_install {
14    my $self = shift;
15    $self->SUPER::ACTION_install;
16    $self->ACTION_install_extras;
17
18    eval "use Config::Tiny";
19    die "Config::Tiny is required to set up this application.\n" if $@;
20
21    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    my $dbname = ( $config->dbtype eq 'sqlite' && defined $self->destdir ) ?
29        File::Spec->catdir($self->destdir, $config->dbname) :
30        $config->dbname;
31    my $dbuser = $config->dbuser;
32    my $dbpass = $config->dbpass;
33    my $dbhost = $config->dbhost;
34    my $dbtype = $config->dbtype;
35
36    my %cgi_wiki_exts = ( postgres => "Pg",
37                          mysql    => "MySQL",
38                          sqlite   => "SQLite" );
39
40    my $cgi_wiki_module = "Wiki::Toolkit::Setup::" . $cgi_wiki_exts{$dbtype};
41    eval "require $cgi_wiki_module";
42    die "There was a problem: $@" if $@;
43
44    print "Checking database schema...\n";
45    {
46        no strict 'refs';
47        &{$cgi_wiki_module . "::setup"}( $dbname, $dbuser, $dbpass, $dbhost );
48    }
49}
50
51sub ACTION_fakeinstall {
52    my $self = shift;
53    $self->SUPER::ACTION_fakeinstall;
54    $self->ACTION_install_extras( fake => 1 );
55    print "Checking database schema...\n";
56}
57
58sub ACTION_install_extras {
59    my ($self, %args) = @_;
60    my $FAKE = $args{fake} || 0;
61
62    eval "use Config::Tiny";
63    die "Config::Tiny is required to set up this application.\n" if $@;
64
65    my $config = OpenGuides::Config->new( file => "wiki.conf" );
66
67    # Install the scripts where we were told to.
68    my $install_directory    = defined $self->destdir ? File::Spec->catdir( $self->destdir, $config->install_directory ) : $config->install_directory;
69    my $script_name          = $config->script_name;
70    my $template_path        = defined $self->destdir ? File::Spec->catdir( $self->destdir, $config->template_path ) : $config->template_path;
71    my $custom_template_path = defined $self->destdir ? File::Spec->catdir( $self->destdir, $config->custom_template_path ) : $config->custom_template_path;
72    my $custom_lib_path      = $config->custom_lib_path;
73    my $static_path          = defined $self->destdir ? File::Spec->catdir( $self->destdir, $config->static_path ) : $config->static_path;
74    my @extra_scripts        = @{ $self->config_data( "__extra_scripts" ) };
75    my @templates            = @{ $self->config_data( "__templates" ) };
76    my @static_files         = @{ $self->config_data( "__static_files" ) };
77
78    print "Installing scripts to $install_directory:\n";
79    # Allow for blank script_name - assume "index.cgi".
80        my $script_filename = $script_name || "index.cgi";
81    if ( $FAKE ) {
82        print "wiki.cgi -> $install_directory/$script_filename (FAKE)\n";
83    } else {
84        if ( $script_filename ne "wiki.cgi" ) {
85            File::Copy::copy("wiki.cgi", $script_filename)
86                or die "Can't copy('wiki.cgi', '$script_filename'): $!";
87        }
88        my $copy = $self->copy_if_modified(
89                                            $script_filename,
90                                            $install_directory
91                                          );
92        if ( $copy ) {
93            $self->fix_shebang_line($copy);
94            $self->make_executable($copy);
95            $self->add_custom_lib_path( $copy, $custom_lib_path )
96              if $custom_lib_path;
97        } else {
98            print "Skipping $install_directory/$script_filename (unchanged)\n";
99        }
100        print "(Really: wiki.cgi -> $install_directory/$script_filename)\n"
101            unless $script_filename eq "wiki.cgi";
102    }
103
104    if ( $FAKE ) {
105        print "Trying to ensure that wiki.conf is protected.\n";
106    } else {
107        my $mentionswikidotconf = 0;
108        print "Trying to ensure that wiki.conf is protected by .htaccess.. ";
109        if (-f "$install_directory/.htaccess") {
110            if (open HTACCESS, "$install_directory/.htaccess") {
111                while (<HTACCESS>) {
112                    if (/wiki\.conf/) {
113                        $mentionswikidotconf = 1;
114                    }
115                }
116                close HTACCESS;
117            } else {
118                warn "Could not open $install_directory/.htaccess for reading: $!";
119            }
120        }
121        if ($mentionswikidotconf == 0) {
122            if (open HTACCESS, ">>$install_directory/.htaccess") {
123                print HTACCESS "# Added by OpenGuides installer\n";
124                print HTACCESS "<Files wiki.conf>\ndeny from all\n</Files>";
125                close HTACCESS;
126                print "apparent success. You should check that this is working!\n";
127            } else {
128                warn "Could not open $install_directory/.htaccess for writing: $!";
129            }
130        } else {
131            print ".htaccess appears to already mention wiki.conf.\n";
132        }
133    }
134
135    foreach my $script ( @extra_scripts ) {
136        if ( $FAKE ) {
137            print "$script -> $install_directory/$script (FAKE)\n";
138        } else {
139            my $copy = $self->copy_if_modified( $script, $install_directory );
140            if ( $copy ) {
141                $self->fix_shebang_line($copy);
142                $self->make_executable($copy) unless $script eq "wiki.conf";
143                $self->add_custom_lib_path( $copy, $custom_lib_path )
144                  if $custom_lib_path;
145            } else {
146                print "Skipping $install_directory/$script (unchanged)\n";
147            }
148        }
149    }
150
151    print "Installing templates to $template_path:\n";
152    foreach my $template ( @templates ) {
153        if ( $FAKE ) {
154            print "templates/$template -> $template_path/$template (FAKE)\n";
155            } else {
156                $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    if ( $FAKE ) {
161        print "Making $custom_template_path.\n";
162    } else {
163        unless (-d $custom_template_path) {
164            print "Creating directory $custom_template_path.\n";
165            File::Path::mkpath $custom_template_path or warn "Could not make $custom_template_path";
166        }
167    }
168
169    print "Installing static files to $static_path:\n";
170    foreach my $static_file ( @static_files ) {
171        if ( $FAKE ) {
172            print "static/$static_file -> $static_path/$static_file (FAKE)\n";
173        } else {
174            $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
180sub add_custom_lib_path {
181    my ($self, $copy, $lib_path) = @_;
182    local $/ = undef;
183    open my $fh, $copy or die $!;
184    my $content = <$fh>;
185    close $fh or die $!;
186    $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    my @file_info = stat( $copy );
190    my $orig_mode = $file_info[2] & 07777;
191    chmod( $orig_mode | 0222, $copy )
192        or warn "Couldn't make $copy writeable: $!";
193    open $fh, ">$copy" or die $!;
194    print $fh $content;
195    close $fh or die $!;
196    chmod( $orig_mode, $copy )
197        or warn "Couldn't restore permissions on $copy: $!";
198
199    return 1;
200}
201
2021;
Note: See TracBrowser for help on using the repository browser.