allow all newvalue<digits> fields on product option edit
[bse.git] / 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 }