dcdb-www-create.perl

#!/usr/bin/perl -w

use lib qw(. lib blib/lib lib/lib lib/blib/lib);
use DiaColloDB::WWW;
use DiaColloDB::WWW::CGI;
use Getopt::Long qw(:config no_ignore_case);
use Cwd qw(abs_path);
use File::Basename qw(basename);
use File::ShareDir qw(:ALL);
use File::Copy qw(copy);
use File::Copy::Recursive qw(dircopy);
use File::chmod::Recursive;
use File::Path qw(make_path remove_tree);
use Pod::Usage;
use strict;

##----------------------------------------------------------------------
## Globals
##----------------------------------------------------------------------

##-- program vars
our $prog  = basename($0);
our ($help,$version);

our %log = (level=>'TRACE', rootLevel=>'FATAL');
our $force = 0;
our $wwwdir = undef;

my %rcfiles = (
	       'dstar.rc' => dist_file("DiaColloDB-WWW",'rc/dstar.rc'),
	       'local.rc' => dist_file("DiaColloDB-WWW",'rc/local.rc'),
	       'dstar/corpus.ttk' => dist_file("DiaColloDB-WWW",'rc/corpus.ttk'),
	       'dstar/custom.ttk' => dist_file("DiaColloDB-WWW",'rc/custom.ttk'),
	      );
my $want_siterc = 1;
my %site = (
	    'alias' => undef,
	   );

##----------------------------------------------------------------------
## Command-line processing
##----------------------------------------------------------------------
GetOptions(##-- general
	   'help|h' => \$help,
	   'version|V' => \$version,
	   #'verbose|v=i' => \$verbose,

	   ##-- generation
	   'dstar-rc|dstar|drc|rc|d=s' => \$rcfiles{'dstar.rc'},
	   'local-rc|local|lrc|l=s' => \$rcfiles{'local.rc'},
	   'corpus-ttk|corpus|c=s' => \$rcfiles{'dstar/corpus.ttk'},
	   'custom-ttk|custom|C=s'  => \$rcfiles{'dstar/custom.ttk'},
	   'site-rc|siterc|site!' => \$want_siterc,
	   'site-alias|alias|a=s' => \$site{alias},

	   ##-- logging
	   'log-level|level|ll=s' => sub { $log{level} = uc($_[1]); },
	   'log-option|logopt|lo=s' => \%log,

	   ##-- I/O
	   'force|f!' => \$force,
	   'output|out|o=s' => \$wwwdir,
	  );

pod2usage({-exitval=>0,-verbose=>0}) if ($help);
if ($version) {
  print STDERR "$prog version $DiaColloDB::WWW::VERSION by Bryan Jurish\n";
  exit 0 if ($version);
}
pod2usage({-exitval=>0,-verbose=>0,-msg=>"no DBURL specified!"}) if (@ARGV < 1);


##----------------------------------------------------------------------
## MAIN
##----------------------------------------------------------------------

##-- setup logger
DiaColloDB::Logger->ensureLog(%log);
my $logger = 'DiaColloDB::WWW';

##-- command-line arguments
my $dburl = shift;
$dburl    =~ s{/$}{};
$wwwdir //= "$dburl.www";
$wwwdir   =~ s{/$}{};
$wwwdir   =~ s/[^\w\.\-\+]/_/g if (!-d $dburl);

##-- get source directory via File::ShareDir
my $srcdir = File::ShareDir::dist_dir('DiaColloDB-WWW');
$srcdir   =~ s{/$}{};
my $docdir = "$srcdir/htdocs";
-d $docdir
  or $logger->logdie("no source directory '$docdir' found");

##-- ensure output directory exists
$logger->logdie("output directory '$wwwdir' exists, use --force option to overwrite") if (-e $wwwdir && !$force);
-d $wwwdir
  or make_path($wwwdir)
  or $logger->logdie("failed to create output directory '$wwwdir': $!");

##-- copy wrappers
$logger->info("copying wrappers from $docdir to $wwwdir");
{
  no warnings 'once';
  $File::Copy::Recursive::RmTrgFil = 2;
}
dircopy($docdir,$wwwdir)
  or $logger->logdie("failed to copy $docdir to $wwwdir: $!");

##-- copy configuration files
$logger->info("copying configuration file(s)");
foreach (sort keys %rcfiles) {
  !$rcfiles{$_}
    or copy($rcfiles{$_},"$wwwdir/$_")
    or $logger->logdie("failed to copy $rcfiles{$_} to $wwwdir/$_: $!");
}

##-- set permissions
$logger->info("setting permissions on $wwwdir");
chmod_recursive('u+w',$wwwdir)
  or $logger->logdie("failed to update permissions on $wwwdir: $!");

if (-e $dburl) {
  ##-- dburl: file or dbdir: link to 'data'
  my $dbdir_abs = abs_path($dburl);
  $logger->info("linking $wwwdir/data to $dbdir_abs");
  !-e "$wwwdir/data"
    or unlink("$wwwdir/data")
    or $logger->logdie("failed to unlink stale $wwwdir/data: $!");
  symlink($dbdir_abs,"$wwwdir/data")
    or $logger->logdie("failed to create symlink $wwwdir/data -> $dbdir_abs: $!");
} else {
  ##-- other url: create rcfile
  $logger->info("creating config file $wwwdir/data for URL '$dburl'");
  !-e "$wwwdir/data"
    or unlink("$wwwdir/data")
    or $logger->logdie("failed to unlink stale $wwwdir/data: $!");
  DiaColloDB::Utils::saveJsonFile({url=>$dburl},"$wwwdir/data")
      or $logger->logdie("failed to create config file $wwwdir/data: $!");
}

##-- create site.rc
if ($want_siterc) {
  $logger->info("creating $wwwdir/site.rc");
  $site{alias}  //= "/".basename($wwwdir);
  $site{wwwdir}   = abs_path($wwwdir)."/";
  my $dbcgi = DiaColloDB::WWW::CGI->new;
  my $data  = $dbcgi->ttk_process(dist_file("DiaColloDB-WWW", "rc/siterc.ttk"), {site=>\%site,prog=>$prog,version=>$DiaColloDB::WWW::VERSION});
  CORE::open(my $fh, ">:raw", "$wwwdir/site.rc")
    or $logger->logdie("$0: open failed for $wwwdir/site.rc: $!");
  $fh->print($data);
  CORE::close($fh);
  print STDERR "$prog: $_\n"
    foreach ("==================================================",
	     "created apache configuration file $wwwdir/site.rc",
	     "",
	     "remember to add $wwwdir/site.rc to your apache",
	     "site configuration and re-load the server config!",
	     "=================================================="
	    );
} else {
  $logger->info("NOT creating apache site configuration $wwwdir/site.rc (disabled by user request)");
}


__END__

###############################################################
## pods
###############################################################

=pod

=head1 NAME

dcdb-www-create.perl - instantiate apache www wrappers for a DiaColloDB index

=head1 SYNOPSIS

 dcdb-www-create.perl [OPTIONS] DBURL

 General Options:
   -help                 # this help message
   -version              # display program version and exit

 Customization Options:
   -dstar-rc RCFILE      # instantiates WWWDIR/dstar.rc (default:none)
   -local-rc RCFILE      # instantiates WWWDIR/local.rc (default:none)
   -corpus-ttk TTKFILE   # instantiates WWWDIR/dstar/corpus.ttk (default:none)
   -custom-ttk TTKFILE   # instantiates WWWDIR/dstar/custom.ttk (default:none)
   -[no]site-rc          # do/don't create apache configuration in WWWDIR/site.rc (default:do)
   -site-alias ALIAS     # server path alias for WWWDIR/site.rc (default=/WWWDIR)

 Output Options:
   -[no]force            # do/don't force-overwrite existing WWWDIR (default=don't)
   -output WWWDIR        # create wrapper directory WWWDIR (default=DBURL.www)

 Caveats:
   + you will need to update and reload your apache server configuration after
     adding or changing any site-wide aliases!

=cut

###############################################################
## DESCRIPTION
###############################################################
=pod

=head1 DESCRIPTION

dcdb-www-create.perl
instantiates a CGI wrapper directory for the
L<DiaColloDB|DiaColloDB> index specified by the
L<DBURL|/DBURL> argument in the output directory
F<WWWDIR> specified by the L<-output|/-output WWWDIR>
option.  The directory created can be customized
by editing the configuration files and then served
by the http daemon of your choice (e.g. apache),
or used as a template for the standalone server
L<dcdb-www-server.perl(1)|dcdb-www-server.perl>.
In the latter case, note that you don't I<need> to
create a wrapper directory to use the standalone server
unless you want to override the default templates
included in the L<DiaColloDB::WWW|DiaColloDB::WWW> distribution.

=cut


###############################################################
## OPTIONS AND ARGUMENTS
###############################################################
=pod

=head1 OPTIONS AND ARGUMENTS

=cut

###############################################################
# Arguments
###############################################################
=pod

=head2 Arguments

=over 4

=item DBURL

L<DiaColloDB|DiaColloDB> database URL to be wrapped,
which must be supported by L<DiaColloDB::Client|DiaColloDB::Client>,
i.e. must use one of the supported schemes C<file://>, C<rcfile://>, C<http://>, and C<list://>.
If no scheme is specified, C<file://> is assumed.
Typically, I<DBURL> is simply the path to a localL<DiaColloDB|DiaColloDB> index directory
as created by
L<dcdb-create.perl(1)|dcdb-create.perl>.

=back

=cut


###############################################################
# General Options
###############################################################
=pod

=head2 General Options

=over 4

=item -help

Display a brief help message and exit.

=item -version

Display version information and exit.

=back

=cut


###############################################################
# Customization Options
###############################################################
=pod

=head2 Customization Options

=over 4

=item -dstar-rc RCFILE

Install a user-specified C<RCFILE> as F<WWWDIR/dstar.rc>
(perl format, base configuration).

=item -local-rc RCFILE

Install a user-specified C<RCFILE> as F<WWWDIR/local.rc>
(perl format, overrides).

=item -corpus-ttk TTKFILE

Install a user-specified C<TTKFILE> as F<WWWDIR/dstar/corpus.ttk>
(L<Template Toolkit|Template> format, base configuration).

=item -custom-ttk TTKFILE

Install a user-specified C<TTKFILE> as F<WWWDIR/dstar/custom.ttk>
(L<Template Toolkit|Template> format, overrides).

=item -site-rc , -nosite-rc

Do/don't create an apache site configuration stub in F<WWWDIR/site.rc>.
Default=do.

=item -site-alias ALIAS

Server path alias for F<WWWDIR/site.rc>,
Default=F</WWWDIR> (basename only).

=back

=cut

###############################################################
# I/O Options
###############################################################
=pod

=head2 I/O Options

=over 4

=item -[no]force

Do/don't force-overwrite an existing output directory (default=don't).

=item -output WWWDIR

Specify wrapper output directory F<WWWDIR>.
Default=F<DBURL.www>.

=back

=cut


###############################################################
# Bugs and Limitations
###############################################################
=pod

=head1 BUGS AND LIMITATIONS

Probably many.

=cut


###############################################################
# Footer
###############################################################
=pod

=head1 ACKNOWLEDGEMENTS

Perl by Larry Wall.

=head1 AUTHOR

Bryan Jurish E<lt>moocow@cpan.orgE<gt>

=head1 SEE ALSO

perl(1).

=cut