view release on metacpan or  search on metacpan

private/perl/HTML/Merge/Engine.pm  view on Meta::CPAN

		}
	}

	# last add a default path
	$cookies{$name} .= "; path=$HTML::Merge::Ini::MERGE_PATH;";

	$ENV{'HTTP_COOKIE'} .= ';' if $ENV{'HTTP_COOKIE'};
	$ENV{'HTTP_COOKIE'} .= "$name=$value";
}
###########################################
sub ReadConfig 
{
	my $self = $0;
	$self =~ s/\.\w+$/.conf/;
	my @conf = ($self, "/etc/merge.conf", &GetHome . "/.merge");

	foreach my $f (@conf) 
	{
        	if (open(CFG, $f))
	 	{
			no strict;
			my $code = join("", <CFG>);
			close(CFG);
			eval $code;
			if ($@) 
			{
				print "Status: 501 Server error\n";
				print "Content-type: text/plain\n\n";
				print "$f caused error: $@";
				exit;
			}

			$HTML::Merge::config = $f;
        	        last;
	        }
	}

	$self =~ s/\.\w+$/.ext/;
	foreach my $ext (($self, "/etc/merge.ext")) 
	{
		if (-f $self) 
		{
			package HTML::Merge::Ext;
			eval 'require $self;';
			if ($@) 
			{
				print "Status: 501 Server error\n";
				print "Content-type: text/plain\n\n";
				print "$self caused error: $@";
				exit;
			}
		}
	}
}
###############################################################################
sub GetHome 
{
	return if ($^O =~ /Win/);

	my ($name,$passwd,$uid,$gid,
        $quota,$comment,$gcos,$dir,$shell,$expire) = getpwuid($>);

	return $dir;
}
###############################################################################
sub import 
{
	my (@param) = @_;

	$param[1] |= '';
	return if ($param[1] eq ':unconfig');

	&ReadConfig;
}
###########################################
sub Convert 
{
	my ($db_pass, $rev) = @_;

        my $from = pack("C*", map {hex($_)} ($HTML::Merge::Ini::S_FROM =~ /(..)/g));
        my $to = pack("C*", map {hex($_)} ($HTML::Merge::Ini::S_TO =~ /(..)/g));        $from =~ s/-/\\-/;
        $to =~ s/-/\\-/;
	($from, $to) = ($to, $from) if $rev;
        eval "\$db_pass =~ tr/$to/$from/;";
	$db_pass;
}
###########################################
sub DBH 
{
	my $self = shift;

	$self->DoConnect;

	return $self->{'dbh'};
}
###########################################
sub SYS_DBH
{
	my $self = shift;
	return $self->{'sys_dbh'} if $self->{'sys_dbh'} ;
	return $self->DBH() if $HTML::Merge::Ini::SESSION_DB;

	require DBI;

	$INTERNAL_DSN="dbi:SQLite:dbname=$HTML::Merge::Ini::MERGE_ABSOLUTE_PATH/$INTERNAL_DB";
	my $sys_dbh = DBI->connect($INTERNAL_DSN,"","")
 		|| HTML::Merge::Error::HandleError('ERROR', $DBI::errstr);

	$self->{'sys_dbh'} = $sys_dbh;
	$self->{'sth'} = undef;

	return $self->{'sys_dbh'};
}	
###########################################
sub AddUser 
{
	my ($self, $user, $password, $realname, $tag) = @_;
	croak "Invalid username: $user" unless ($user =~ /^\S{3,15}$/);
	croak "Invalid password length: $password" unless ($password =~ /^\S{3,15}$/);
	unless ($HTML::Merge::Ini::ALLOW_EASY_PASSWORDS) 
	{