0.14_10 commit0.14_10 commit0.14_10 commit0.14_10 commit0.14_10 commit0.14_10 commit0...
[bse.git] / localinst.perl
1 #!/usr/bin/perl -w
2 use strict;
3 #use File::Tree;
4 use File::Copy;
5 use lib 't';
6 use BSE::Test ();
7 require ExtUtils::Manifest;
8
9 my $dist = shift or die "Usage: $0 distdir [leavedb]";
10 my $leavedb = shift or 0;
11 my $instbase = shift || BSE::Test::base_dir() || die "No base_dir";
12
13 my $mysql = BSE::Test::mysql_name;
14
15 #  if (-e "$instbase/cgi-bin/modules/Constants.pm"
16 #      && !-e "$instbase/Constants.pm") {
17 #    system "cp $instbase/cgi-bin/modules/Constants.pm $instbase/Constants.pm"
18 #  }
19
20 system("rm -rf $instbase/cgi-bin")
21   and die "Cannot remove cgi-bin";
22 system "rm -rf $instbase/data"
23   and die "Cannot remove data";
24 system "rm -f $instbase/htdocs/{*.html,a/*.html,shop/*.html,images/*.jpg}"
25   and die "Cannot remove htdocs";
26
27 system "cp -rf $dist/site/cgi-bin $instbase"
28   and die "Cannot copy cgi-bin";
29
30 my $perl = BSE::Test::test_perl();
31 if ($perl ne '/usr/bin/perl') {
32   my $manifest = ExtUtils::Manifest::maniread();
33
34   for my $file (grep /\.pl$/, keys %$manifest) {
35     (my $work = $file) =~ s!^site!!;
36     next unless $work =~ /cgi-bin/;
37     my $full = $instbase . $work;
38     open SCRIPT, "< $full" or die "Cannot open $full: $!";
39     binmode SCRIPT;
40     my @all = <SCRIPT>;
41     close SCRIPT;
42     $all[0] =~ s/^#!\S*perl\S*/#!$perl/;
43     open SCRIPT, "> $full" or die "Cannot create $full: $!";
44     binmode SCRIPT;
45     print SCRIPT @all;
46     close SCRIPT;
47   }
48 }
49
50 system "cp -rf $dist/site/htdocs $instbase"
51   and die "Cannot copy htdocs";
52 system "cp -rf $dist/site/templates $instbase"
53   and die "Cannot copy templates";
54 system "cp -rf $dist/site/data $instbase"
55   and die "Cannot copy data";
56 system "cp -rf $dist/site/util $instbase";
57
58 print "Updating conf\n";
59 # try to update Constants.pm
60 open CON, "< $instbase/cgi-bin/modules/Constants.pm"
61   or die "Cannot open Constants.pm";
62 my $con = do { local $/; <CON> };
63 close CON;
64
65 my $dbuser = BSE::Test::test_dbuser();
66 my $dbpass = BSE::Test::test_dbpass();
67
68 $con =~ s/(^\$DSN = ')[^']*/$1 . BSE::Test::test_dsn()/me;
69 $con =~ s/(^\$DBCLASS = ')[^']*/$1 . BSE::Test::test_dbclass()/me;
70 $con =~ s/(^\$UN = ')[^']*/$1$dbuser/m;
71 $con =~ s/(^\$PW = ')[^']*/$1$dbpass/m;
72 $con =~ s/(^\$BASEDIR = ')[^']+/$1 . BSE::Test::base_dir/me;
73 #$con =~ s/(^\$URLBASE = ["'])[^'"]+/$1 . BSE::Test::base_url/me;
74 #$con =~ s/(^\$SECURLBASE = ["'])[^'"]+/$1 . BSE::Test::test_securl/me;
75 $con =~ s/(^\$SESSION_CLASS = [\"\'])[^\'\"]+/$1 . BSE::Test::test_sessionclass()/me;
76 open CON, "> $instbase/cgi-bin/modules/Constants.pm"
77   or die "Cannot open Constants.pm for write: $!";
78 print CON $con;
79 close CON;
80
81 # rebuild the config file
82 # first load values from the test.cfg file
83 my $conffile = BSE::Test::test_conffile();
84 my %conf;
85 $conf{site}{name} = "Test Server";
86 $conf{site}{url} = BSE::Test::base_url();
87 $conf{site}{secureurl} = BSE::Test::base_securl();
88 my $uploads = "$instbase/uploads";
89 $conf{paths}{downloads} = $uploads;
90 my $templates = "$instbase/templates";
91 $conf{paths}{templates} = $templates;
92 open TESTCONF, "< $conffile"
93   or die "Could not open config file $conffile: $!";
94 while (<TESTCONF>) {
95   chomp;
96   /^\s*(\w[^=]*\w)\.(\w+)\s*=\s*(.*\S)\s*$/ or next;
97   $conf{lc $1}{lc $2} = $3;
98 }
99
100 $uploads = $conf{paths}{downloads};
101 # fix bse.cfg
102 open CFG, "< $instbase/cgi-bin/bse.cfg"
103   or die "Cannot open $instbase/cgi-bin/bse.cfg: $!";
104 my $section = "";
105 my @cfg;
106 while (<CFG>) {
107   chomp;
108   if (/^\[(.*)\]\s*$/) {
109     my $newsect = lc $1;
110     if ($conf{$section} && keys %{$conf{$section}}) {
111       for my $key (sort keys %{$conf{$section}}) {
112         push @cfg, "$key=$conf{$section}{$key}";
113       }
114       delete $conf{$section};
115     }
116     $section = $newsect;
117   }
118   elsif (/^\s*(\w+)\s*=\s*.*$/ && exists $conf{$section}{lc $1}) {
119     my $key = lc $1;
120     print "found $section.$key\n";
121     $_ = "$key=$conf{$section}{$key}";
122     delete $conf{$section}{$key};
123   }
124   push @cfg, $_;
125 }
126 if ($conf{$section} && keys %{$conf{$section}}) {
127   for my $key (sort keys %{$conf{$section}}) {
128     push @cfg, "$key=$conf{$section}{$key}";
129   }
130   delete $conf{$section};
131 }
132 for my $sect (keys %conf) {
133   if ($conf{$sect} && keys %{$conf{$sect}}) {
134     push @cfg, "[$sect]";
135     for my $key (sort keys %{$conf{$sect}}) {
136       push @cfg, "$key=$conf{$sect}{$key}";
137     }
138     push @cfg, "";
139   }
140 }
141 close CFG;
142
143 open CFG, "> $instbase/cgi-bin/bse.cfg"
144   or die "Cannot create $instbase/cgi-bin/bse.cfg: $!";
145 for my $line (@cfg) {
146   print CFG $line, "\n";
147 }
148 close CFG;
149
150 -d $uploads 
151   or mkdir $uploads, 0777 
152   or die "Cannot find or create upload directory: $!";
153
154
155 # build the database
156 unless ($leavedb) {
157   my $dsn = BSE::Test::test_dsn();
158   if ($dsn =~ /:mysql:(?:database=)?(\w+)/) {
159     my $db = $1;
160     system "$mysql -u$dbuser -p$dbpass $db <$dist/schema/bse.sql"
161       and die "Cannot initialize database";
162     system "cd $instbase/util ; perl initial.pl"
163       and die "Cannot load database";
164   }
165   else {
166     print "WARNING: cannot install to $dsn database\n";
167   }
168 }
169
170