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*$/ 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