view release on metacpan or  search on metacpan

papp-install  view on Meta::CPAN

#!/usr/bin/perl

use File::Copy;
use File::Compare;
use File::Glob ':glob';
use DBI;

use Compress::LZF qw(:compress :freeze);

my $ETCDIR = "/etc/papp";

@ARGV or die "this program shouldn't be called directly\n";

for (@ARGV) {
   /^--(\w+)$/ or die "really, don't call this program directly\n";
   ${"mode_$1"}++;
}

BEGIN {
   $ENV{PAPP_ETCDIR} = ".";
   $PApp::Config::DBH = 1; # prevent database connections
   local @INC = (".", @INC);
   require PApp::Config;
}

use blib;
use lib '.';

use PApp;
use PApp::Admin;
use PApp::SQL;
use PApp::I18n;
use PApp::Storable ();

$|=1;

*CFG = \%PApp::Config;

my $lib = $CFG{LIBDIR};

my $create_options = $ENV{PAPP_CREATE_TBALE_OPTIONS} || "ENGINE=MyISAM";

sub crdir {
   local $_ = shift;
   print "Creating directory $_... ";
   if (-d $_) {
      print "[skipped] ";
   } else {
      mkdir $_, 0777 or die "$!\n";
   }
   chown $CFG{PAPP_UID}, $CFG{PAPP_GID}, $_;
   print "ok\n";
}

sub install($$) {
   my ($s, $d) = @_;
   if (compare($s, $d)) {
      copy($s, "$d~") or die "copy($s,$d~): $!\n";
      chown $CFG{PAPP_UID}, $CFG{PAPP_GID}, "$d~";
      chmod ((stat $s)[2] & 07777, "$d~");
      rename "$d~", $d or die "rename($d~,$d): $!\n";
      0;
   } else {
      chown $CFG{PAPP_UID}, $CFG{PAPP_GID}, $d;
      chmod ((stat $s)[2] & 07777, $d);
      1;
   }
}

if ($mode_install) {
   crdir $lib;
   crdir $CFG{I18NDIR};

   for my $dir (qw(style etc)) {
      crdir "$lib/$dir";

      for my $app (bsd_glob "$dir/{*.xsl,mimedb}",
                                    GLOB_ERR|GLOB_NOSORT|GLOB_BRACE) {
         $app =~ s/.*?([^\/]+)$/$1/;
         print "Installing $dir/$app $lib/$dir...";
         print "[skipped] " if install "$dir/$app", "$lib/$dir/$app";
         print "ok\n";
      }
   }

   my $umask = umask 022;
   mkdir $ETCDIR, 0777;
   umask 077;
   unless ($mode_skipconfig) {
      install ("config", "$ETCDIR/config"); chmod 0644, "$ETCDIR/config";
      install ("secure", "$ETCDIR/secure"); chmod 0600, "$ETCDIR/secure";
      umask $umask;
      print "\n$ETCDIR/secure is mode 600, better chown or chgrp it to the group your webserver or trusted user is running under.\n\n";
   }
}

if ($mode_init || $mode_update) {

print <<EOF;

This initializes the database and library directories used by PApp. It
assumes that the DBD driver understands the "func" method. MySQL currently
does this.

You should be able to re-run "make update" as often as you like, no harm
will be done.

EOF

if ($mode_update) {
   print "trying to open papp database... ";

   $DBH =
      DBI->connect($CFG{STATEDB}, $CFG{STATEDB_USER}, $CFG{STATEDB_PASS},
                   { RaiseError => 0, PrintError => 1 });

   $DBH
      or die "Unable to open database ($CFG{STATEDB}): $DBI::errstr\n";

   $installed_version = sql_fetch $DBH, "select value from env where name = ?", "PAPP_VERSION";

} elsif ($mode_init) {
   $CFG{STATEDB} =~ /DBI:([^:]+):([^:]+).*?(?:host=([^;]*))?/i or die "unable to parse database name ($CFG{STATEDB})\n";

   my ($driver, $db, $host) = ($1, $2, $3||"'localhost'");
   print "trying to create $driver-database '$db' on host $host\n";
   print "(might only work for mysql)... ";

   $drh = DBI->install_driver($driver) or die "unable to find DBI driver $driver\n";
   $drh->func("createdb", $db, "localhost", $CFG{STATEDB_USER}, $CFG{STATEDB_PASS}, "admin");

   $DBH = DBI->connect($CFG{STATEDB}, $CFG{STATEDB_USER}, $CFG{STATEDB_PASS}, { RaiseError => 0, PrintError => 1 });
   $DBH or die "unable to create database $CFG{STATEDB}, please create it manually and re-run papp-install\n";

   print "seems to have worked\n";
}

$PApp::SQL::DBH = $DBH;

print <<EOF;

Now creating tables (that do not already exist). Existing tables will
_not_ be dropped, so if you want to upgrade to a new (& incompatible)
version, or you want to downgrade again, you have to drop the database
manually. This is not normally required, as papp will automatically
upgrade tables from older releases transparently.

EOF

sql_exec <<SQL;
   create table /*! if not exists */ env (
     name varchar(255) binary not null,
     value longblob not null,