view release on metacpan or  search on metacpan

lib/Apache/Mailtrack.pm  view on Meta::CPAN

package Apache::Mailtrack;

#
# $Id: Mailtrack.pm,v 1.3 2003/02/03 12:14:57 florian Exp $
#

use 5.006;
use strict;
use warnings;

use Apache::Constants qw/OK REDIRECT/;
use Apache::Request;
use Data::Serializer;
use DBI qw/:sql_types/;

our $VERSION = '0.03';
our %config;

my $serializer;

sub handler
	{
	my $r		= Apache::Request->new(shift);
	my $userdata	= $r->param('userdata');
	my $target	= $r->param('target');
	my $internal;
	my $data;

	our %config;

	#
	# If we didn't get set up correctly, warn about this and throw a really ugly error.
	#
	foreach(qw/db_dsn db_user db_pass db_table/)
		{
		error($r, 'Apache::Mailtrack> Please configure me correctly (check my manpage).')
			unless $config{$_} = $r->dir_config($_);
		}

	#
	# Read out optional configuration settings or set defaults.
	#
	$config{'serializer'} = $r->dir_config('serializer') || 'Storable';
	$config{'secret'} = $r->dir_config('secret') if defined $r->dir_config('secret');
	$config{'path'} = $r->dir_config('path') || '/images';
	$config{'defaultfile'} = $r->dir_config('defaultfile') || 'mailtrack_default.jpg';
	$config{'db_target'} = $r->dir_config('db_target') if defined $r->dir_config('db_target');

	$serializer ||= Data::Serializer->new(
		serializer	=> $config{'serializer'},
		secret		=> $config{'secret'} || undef,
		);
	
	#
	# Redirect to the defaultfile if we didn't get the required parameters.
	#
	error($r, "Apache::Mailtrack> I didn't get the parameters I want - check your rewrite rule.")
		unless defined $userdata and defined $target;

	#
	# Deserialze userdata.
	#
	eval
		{
		$data = $serializer->deserialize($userdata);
		};
	
	#
	# If we couldn't deserialize the userdata, redirect to the defaultfile.
	#
	error($r, "Apache::Mailtrack> Couldn't deserialize the userdata - maybe you should check your secret?")
		if $@;

	#
	# Let's look, whether we got a URL as target...
	#
	if($target =~ m/^url\|(.*)/)
		{
		$data->{'target'} = $1 unless exists $data->{'target'};
		$target = 'http://' . $1;
		}
	#
	# or some file.
	#
	else
		{
		$target = $config{'path'} . '/' . $target;
		$internal = 1;
		}
	
	#
	# Log into DB.