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