localinst.perl

   1 #!/usr/bin/perl -w
   2 use strict;
   3 #use File::Tree;
   4 use File::Copy;
   5 use lib 'lib';
   6 use BSE::Install qw(util_dir cgi_dir public_html_dir templates_dir data_dir mysql_name);
   7 #use BSE::Test ();
   8 use ExtUtils::Manifest qw(maniread);
   9 use File::Copy qw(copy);
  10 use File::Spec;
  11 use File::Path qw(make_path);
  12 use Getopt::Long;
  13
  14 my $verbose;
  15 GetOptions("v|verbose" => \$verbose);
  16
  17 my $dist = shift or die "Usage: $0 distdir [leavedb]";
  18 my $leavedb = shift or 0;
  19
  20 my $mysql = mysql_name();
  21
  22 my $cfg = BSE::Install::cfg();
  23
  24 my $manifest = maniread();
  25
  26 # fake BSE::Modules
  27 $manifest->{"site/cgi-bin/modules/BSE/Modules.pm"} = "";
  28
  29 install_files("site/htdocs/", public_html_dir());
  30 install_files("site/templates/", templates_dir());
  31 install_files("site/cgi-bin", cgi_dir());
  32 install_files("site/util/", util_dir());
  33 install_files("site/data/", data_dir());
  34
  35 my $perl = BSE::Install::perl();
  36 if ($perl ne '/usr/bin/perl') {
  37   my $manifest = ExtUtils::Manifest::maniread();
  38
  39   for my $file (keys %$manifest) {
  40     (my $work = $file) =~ s!^site/!!;
  41     $work =~ s(^(cgi-bin|util)/)()
  42       or next;
  43     my $base = $work eq "util" ? util_dir() : cgi_dir();
  44     my $full = File::Spec->catfile($base, $work);
  45     open my $script, "<", $full
  46       or next;
  47     binmode $script;
  48     my $first = <$script>;
  49     if ($first =~ s/^#!\S*perl\S*/#!$perl/) {
  50       my @all = <$script>;
  51       close $script;
  52       open my $out_script, ">", $full or die "Cannot create $full: $!";
  53       binmode $out_script;
  54       print $out_script $first, @all;
  55       close $out_script;
  56     }
  57   }
  58 }
  59
  60 print "Updating conf\n";
  61
  62 my $conf_src = BSE::Install::conffile();
  63 my $conf_dest = File::Spec->catfile(cgi_dir(), "bse-install.cfg");
  64 copy($conf_src, $conf_dest)
  65   or die "Cannot copy $conf_src to $conf_dest: $!\n";
  66
  67 #-d $uploads
  68 #  or mkdir $uploads, 0777
  69 #  or die "Cannot find or create upload directory: $!";
  70
  71 my $dbuser = BSE::Install::db_user();
  72 my $dbpass = BSE::Install::db_password();
  73
  74 # build the database
  75 my $dsn = BSE::Install::db_dsn();
  76 if ($dsn =~ /:mysql:(?:database=)?(\w+)/) {
  77   my $db = $1;
  78
  79   unless ($leavedb) {
  80     system "$mysql -u$dbuser -p$dbpass $db <$dist/schema/bse.sql"
  81       and die "Cannot initialize database";
  82     system "cd ".util_dir." ; $perl initial.pl"
  83       and die "Cannot load database";
  84   }
  85
  86   # always load stored procedures
  87   system qq($mysql "-u$dbuser" "-p$dbpass" "$db" <$dist/schema/bse_sp.sql)
  88     and die "Error loading stored procedures\n";
  89 }
  90 else {
  91   print "WARNING: cannot install to $dsn database\n";
  92 }
  93
  94 sub install_files {
  95   my ($prefix, $destbase) = @_;
  96
  97   print "Install $prefix to $destbase\n";
  98   for my $file (sort grep /^\Q$prefix/, keys %$manifest) {
  99     (my $rel = $file) =~ s/^\Q$prefix//;
 100     my $src = File::Spec->catfile($dist, $file);
 101     my $dest = File::Spec->catfile($destbase, $rel);
 102     my ($destvol, $destdir) = File::Spec->splitpath($dest);
 103     my $destpath = File::Spec->catdir($destvol, $destdir);
 104     unless (-e $destpath) {
 105       make_path($destpath); # croak on error
 106     }
 107     elsif (!-d $destpath) {
 108       die "$destpath isn't a directory!\n";
 109     }
 110     print "  Copy $rel to $dest\n" if $verbose;
 111     copy($src, $dest)
 112       or die "Cannot copy $src to $dest: $!\n";
 113   }
 114 }