view release on metacpan or  search on metacpan

rlsmgr/process_content  view on Meta::CPAN

#                            All Rights Reserved
#
##############################################################################
#
#   @(#)$Id: process_content,v 1.5 2000/03/10 22:32:12 idsweb Exp $
#
#   Description:    Process the [Ww]eblist in the current directory, doing the
#                   file juggling as required by the file type specification.
#
#   Functions:      setPermissions
#                   SetPermissions
#                   SetxPermissions
#
#   Libraries:      Carp                    Core, For improved messages
#                   Getopt::Long            Core, Cmd-line parsing
#                   File::Basename          Core, For file name utils
#                   File::Copy              Core, Portable file copy method
#                   File::Path              Core, Portable directory creation
#                   Cwd                     Core, Portable cwd function
#                   Net::Domain             Core, Portable hostname function
#                   IO::File                Core, Class-based file I/O
#                   IMS::ReleaseMgr::Utils  Local, utility functions for rlsmgr
#
#   Global Consts:  $cmd                    This tool's name
#                   $USAGE                  What you see if you type it wrong
#
#   Environment:    Axes $PATH entirely.
#
##############################################################################
use vars qw($cmd);
($cmd = $0) =~ s|.*/||;

use 5.004;

use strict;
use vars qw($USAGE $date $userid $cwd $owner $group $trace $tfile $WL
            %opts $options $logdir $server_root $stage_dir $config $cgi_dir
            $htdocs_dir $fcgi_dir $webmaster $file_cnt $file_size $mirror_group
            $basedir $basename $hostname $in_type $in_file $in_target
            $in_description $target_dir $target $weblist $found_makefile
            $scripts_dir $start_scr_dir $VERSION $revision);
use subs qw(setPermissions SetPermissions SetxPermissions);

use Carp                   qw(croak carp);
use Getopt::Long           'GetOptions';
use File::Basename         qw(basename dirname);
use File::Copy             'copy';
use File::Path             'mkpath';
use Cwd                    'cwd';
use Net::Domain            'hostfqdn';
require IO::File;

use IMS::ReleaseMgr::Utils qw(write_log_line eval_make_target
                              file_mirror_specification
                              DBI_mirror_specification);

umask 0;
$ENV{PATH} = '/bin:/usr/bin:/usr/sbin'; # Yes, I really mean this (security)

$date = scalar localtime time;
$userid = getlogin || (getpwuid($>))[0];
$cwd = cwd;
$VERSION = do {my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};
$revision = q{$Id: process_content,v 1.5 2000/03/10 22:32:12 idsweb Exp $ };

$USAGE = "Usage: $cmd mirror_group [ -H host ] [ -t level ] [ -T file ]
\t[ -c file ]

Where:
-H host\t\tUse 'host' for identification (instead of system value)
-t num\t\tEnable tracing (num sets level)
-T file\t\tSend trace information to 'file' instead of tty
-c file\t\tRead configuration from 'file' instead of DBMS

``mirror_group'' is the name of the host-pool grouping that this process is
running as a part of. It is used as a search key in the DBMS.
";
if (grep($_ eq '-h', @ARGV))
{
    print "$USAGE\n$revision\n";
    exit 0;
}
$SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /bad free/oi; };
Getopt::Long::config 'no_ignore_case';
GetOptions(\%opts, 'H=s', 't=i', 'T=s', 'c=s') or croak "$USAGE\nStopped";
$mirror_group = shift || croak "$USAGE\nStopped";
$basedir = dirname($0);

if (defined $opts{c} and $opts{c})
{
    $config = file_mirror_specification(-file => $opts{c});
    croak "$cmd was unable to get data for $mirror_group from file $opts{c}," .
        " stopped" unless (defined $config);
}
else
{
    $config = DBI_mirror_specification(-mirror => $mirror_group);
    croak "$cmd was unable to get data for $mirror_group from Oracle, stopped"
        unless (defined $config);
}

$hostname = $opts{H} || hostfqdn;
$basedir = dirname $0;

$trace         = $opts{t}                 || 0;
$tfile         = $opts{T}                 || '-';
$server_root   = $config->{SERVER_ROOT}   || '/opt/ims';
$stage_dir     = $config->{STAGING_DIR}   || "$server_root/staging";
$htdocs_dir    = $config->{DOCUMENT_ROOT} || "$server_root/htdocs";
$logdir        = $config->{LOGGING_DIR}   || "$server_root/logs";
$webmaster     = $config->{WEBMASTER}     || '';  # webmaster@host.com
$weblist       = $config->{WEBLIST_FILE}  || 'weblist';
$cgi_dir       = $config->{CGI_ROOT}      || "$server_root/cgi-bin";
$fcgi_dir      = $config->{FCGI_ROOT}     || "$server_root/fcgi-bin";
$scripts_dir   = $config->{SCRIPTS_ROOT}  || "$server_root/scripts";
$start_scr_dir = $config->{START_SCRIPTS_ROOT}
                                          || "$server_root/startup_scripts";
$servlets_dir = $config->{SERVLETS_ROOT} || "$server_root/servlets";

$owner = $config->{OWNER_UID}
    or croak "Specification for $mirror_group MUST include a user name or ID" .