view release on metacpan or  search on metacpan

mergecreateinstance  view on Meta::CPAN

my @data;


if ($win32) 
{
	$user = $default;
	$uid = 100;
}
else 
{
  	$user = &getone("Enter the user id for your web server" , 
			'WWW_U', 
			$default,
			sub {
				@data = getpwnam($_);
				die "No user $_" unless (@data);
			});

	$uid = $data[2];
	user_msg("\n",'None');
}

$default = $nextdef;

unless ($default) 
{
	$default = $user;
	@data = getgrnam($default)  unless $win32;;
	$default = '' unless (@data);
}

$default ||= 'nobody';

$group = &getone("Enter the group id for your web server",
		'WWW_G', 
		$default, 
		sub {
			@data = getgrnam($_);
			die "No group $_" unless (@data);
		}) unless $win32;

$gid = $data[2] unless $win32;

user_msg("\n",'None');

($param{'SUFFIX'}) = (split(/\./, $param{'SCRIPT'}))[-1] if $param{'SCRIPT'};
	
user_msg("\n",'None');

my $ext = getone("Enter suffix to use for CGI script", undef, 'pl');

delete $param{'SUFFIX'};

my $script = $ext ? "merge.$ext" : 'merge';
$param{'SCRIPT'} = $script;

foreach (qw(template cache logs pl)) 
{
	mkdir "$cgi_bin/$_", 0755;
	chown $uid, $gid, "$cgi_bin/$_";
}

my ($choice, $def, $cd, $c2);

if (-f "$cgi_bin/$script") 
{
	$def = "/.No change.";
	$c2 = "\n\r";
} else {
	$def = '';
	}

if ($win32 || $local_install) 
{
	$cd = 'C';
}
else 
{
	$cd = 'L';
	user_msg("

Symbolic <L>inks are recommended , but will work only 
on UNIX systems and Apache servers that have the FollowSymLinks 
directive applied. 
If they are not applicable, choose <C>opy.
If you choose <N>one or <C>opy, $cgi_bin/$script
will be created as a copy of $merge 
if you choose Link it will be a symbolic link.
Do you wish to <C>opy HTML::Merge files into $cgi_bin 
or create a symbolic <L>ink?

(C/L/None$def) [$cd]: ",'None');

	$choice = nChoice("CLN", $cd);
}

$choice = $cd if $win32 || $local_install;


if ($choice eq 'C') 
{
	user_msg('Copied instance selected','Info');   
	$allow_symlink = '';
	&scrape($cgi_bin);

	require ExtUtils::Install;
	require File::Copy;

	ExtUtils::Install::install({"$private/private" => "$cgi_bin/private"}, 1, 0);
	ExtUtils::Install::install({"$private/public" => "$cgi_bin/public"}, 1, 0);
	unlink "$cgi_bin/$script";
	File::Copy::copy($merge, "$cgi_bin/$script");
	chmod 0755, "$cgi_bin/$script";
	chown $uid, $gid, "$cgi_bin/$script";
} 
elsif ($choice eq 'L') 
{
	user_msg("Link\n",'None');
	$allow_symlink = 'FollowSymLinks';
	user_msg('Link based instance selected','Info');   
	&scrape($cgi_bin);

	symlink	"$private/private", "$cgi_bin/private" ||
		die "Could not link $private/private to $cgi_bin/private: $!";
	chmod 0755, "$cgi_bin/private";
	chown $uid, $gid, "$cgi_bin/private";

	symlink	"$private/public", "$cgi_bin/public" ||
		die "Could not link $private/public to $cgi_bin/public: $!";
	chmod 0755, "$cgi_bin/public";
	chown $uid, $gid, "$cgi_bin/public";

	unlink "$cgi_bin/$script";
	symlink $merge, "$cgi_bin/$script" || 
		die "Could not link $merge to $cgi_bin/$script: $!";
	chmod 0755, "$cgi_bin/$script";
	chown $uid, $gid, "$cgi_bin/$script";
} 
elsif ($choice eq 'N') 
{
	user_msg("None\n",'None');
	$allow_symlink = '';
	unless (-x "$cgi_bin/$script") 
	{
		require File::Copy;
		File::Copy::copy($merge, "$cgi_bin/$script");
		chmod 0755, "$cgi_bin/$script";
	}
} 
elsif ($choice ne "\r") 
{
	die "Unknown choice $choice";
}

if (-w "$cgi_bin/template" && !$param{'DEF_TEMPLATE'}) {
	user_msg("\n\nWould you like to install the samples? (Y/N) [Y]: ",'None');
	$choice = nChoice("YN",'Y');
	} else {
	$choice = 'N';
	}

$param{'DEF_TEMPLATE'} = '' unless $param{'DEF_TEMPLATE'};

if ($choice eq 'Y') 
{
	user_msg("Yes\n",'None');
	Log('DEBUG','Samples install');

	system('perl createsamples.pl') if($local_install);
		
	foreach (glob("$private/docs/samples/*.html")) 
	{
		my $dest = $_;
		$dest =~ s|^$private/docs/samples|$cgi_bin/template|;
		File::Copy::copy($_, $dest);
	}

	$param{'DEF_TEMPLATE'} = 'samples.html';
} 
else 
{
	user_msg("No\n",'None');
}

my $has_dbi = 0;

eval {
	require DBI;
	$has_dbi = 1;
     };

	for (;;) 
	{
	last unless $has_dbi;

		@drivers = DBI->available_drivers;
		$i = 0;

mergecreateinstance  view on Meta::CPAN

	s/\s+$//;
	my $this = $params[$line_index];

	if ($this) 
	{
		my ($pos, $extra) = @$this;

		$_ = sprintf("%-${pos}s", $_);

		$_ .= $extra;
	}

	$line_index++;
}

$cfg = join("\n", @lines);

user_msg("Creating $cgi_bin/merge.conf",'Info');

unless (open(O, ">$cgi_bin/merge.conf")) {
	if ($is_root) {	
		Log('FATAL','Open merge.conf: ' . $!);
	} else {
		Log('TRACE',
			"As $cgi_bin/merge.conf not writable merge.conf.inc created");
		open(O, '>merge.conf.inc') 
			||  Log('FATAL','Open merge.conf.inc: ' . $!);
	}
}
print O "$cfg\n";
print O "# FACTORY settings: $me \[$$\]",scalar(localtime),"\n";
print O '$FACTORY = ' . Dumper(\%param) . ";\n1;\n";
close(O);

if ($unix) {
	chmod 0644, "$cgi_bin/merge.conf" if $is_root;
	chmod 0666, "merge.conf.inc" unless $is_root;
	}

Log('DEBUG',"Loading $cgi_bin/merge.conf");
do "$cgi_bin/merge.conf";
require HTML::Merge::Engine;

# *** Clear();

if($param{'DB'}) 
{
	user_msg("Your $param{'MERGE_DB'} database will be created now.",'Info');
	user_msg("Please ignore error messages.\n",'None');
	eval { HTML::Merge::Engine::InitDatabase();
               HTML::Merge::App::Repository::InitDatabase(); };
  	user_msg("\n\n\n\n\n\n\n\n\n",'None');
}

@files = qw(template cache logs merge.conf);

push(@files,'merge.db') if $is_internal;

foreach (@files) 
{
	chown $uid, $gid, "$cgi_bin/$_" || Log('FATAL',
		 "Could not change ownership on $cgi_bin/$_ to $user.$group: $!");
}

user_msg("

* READ THIS FIRST * READ THIS FIRST * READ THIS FIRST * READ THIS FIRST *

*** You advised to edit $cgi_bin/merge.conf !!! ***
It is recommended that templates are stored in a directory where they cannot be
retrieved by simple HTTP requests. The simplest way is if the installation
directory is a CGI enabled (or mod perl enabled) directory.
If the script is enabled per directory or per location, it is recommended to
change it in the configuration.

If you installed the development environment, you may now access 
http://<server>$url/$script to view and edit your
configuration.
It is essential that you protect the directory $cgi_bin/private to
be password protected. If you linked your instance (and not copied it)
it is better to modify the central configuration, as creating an .htaccess
file will share it between all instances.

If you let HTML::Merge edit your httpd.conf you will need to restart 
your web server. If $me can't edit httpd.conf you will have to
set it manually (find out what we wanted to do in merge-httpd.inc).

You my find information in $log_file useful.

* READ THIS FIRST * READ THIS FIRST * READ THIS FIRST * READ THIS FIRST *

",'None');

pause();

suggest_edit($conf) if $conf && $is_root;
suggest_edit("$cgi_bin/merge.conf");

BoldPrint("Please check :\n\t" . join("\n\t",glob('*.inc'))) if glob("*.inc");

user_msg("\n\n",'None');
user_msg("*** Configuration ended ***",'Info');
user_msg("\n\n",'None');

# Functions ##################################
sub scrape 
{
	my ($path) = @_;

	require File::Path;

	# unlink any old installation
	File::Path::rmtree(["$path/private","$path/public"]);
}
#############################################
sub getone 
{
	my ($msg, $key, $default, $code, $dont) = @_;
no warnings;
	$default = $param{$key} if (exists $param{$key} && defined($key));
	$default = 'NONE' unless ($default || $default =~ /0/);