#!/usr/bin/perl -w

###
# Project:     pflogstats
# Module:      pflogstats-common-support.pm
# Description: Support functions
# Copyright:   Dr. Peter Bieringer <pbieringer at aerasec dot de>
#               AERAsec GmbH <http://www.aerasec.de/> 
# License:     GNU GPL v2
# CVS:         $Id: pflogstats-common-support.pm,v 1.43 2005/05/02 12:51:25 peter Exp $
###

###
# ChangeLog:
#	0.01
#	 - initial creation
#	0.02
#	 - add option "numberformat"
#	0.03
#	 - minor code movement
#	0.04
#	 - add statistics
#	0.05
#	 - move statistics to separate module
#	0.06
#	 - move networking code to separate module
#	0.07
#	 - check debug value string for numeric value
#	0.08
#	 - hash reference cosmetics
#	0.09
#	 - replace all hash references with proper code
#       0.10
#        - make Perl 5.0 compatible
#	0.11
#	 - add new switch "verbose"
#	0.12
#	 - add new function print_treeview2 with parameter maxdepth
#	 - print sum numbers on tree entries
#	0.13
#	 - add option "--skip_subtree_pattern"
#	0.14
#	 - set debug value to 0 on early begin to avoid problems on checkoption calls on other modules
#	0.15
#	 - add support for optional subkey list in treeview
#	 - accept format "none"
#	0.16
#	 - add print-max_width option
#	 - migrate show_domain_list and show_user_list
#	0.17
#	 - add a missing print-max-width match
#	0.18
#	 - add caching for domain extraction
#	 - add function 'modify_address' with cache
#	0.19
#	 - add new option "fixednumberformat"
#	 - add new number format function
#	 - add new option "printstatistics"
#	0.20
#	 - take care of .(co|ac).tld on extract 2nd level domains
###

## Todo:
# - correct module function export
##

use strict;

use Sys::Hostname;
use Number::Format;
use Time::Local;
use POSIX qw(strftime);
use locale;


#package pflogstats::common::support;
#package pflogstats_common_support;


## Local constants
my $module_type = "common";
my $module_name = $module_type . "-support";
my $module_version = "0.20";

## Export module info
$main::moduleinfo{$module_name}->{'version'} = $module_version;
$main::moduleinfo{$module_name}->{'type'} = $module_type;
$main::moduleinfo{$module_name}->{'name'} = $module_name;

## Global prototyping


## Global variables


## Local prototyping


## Local variables
my @opt_skip_subtree_pattern;

my %cache_extract_domain;
my %cache_extract_2ndleveldomain;
my %cache_modify_address;


# Number format
my $numberformat_de_DE = new Number::Format(-thousands_sep   => '.', -decimal_point   => ',', -int_curr_symbol => 'EUR', -KILO_SUFFIX => 'KiB', -MEGA_SUFFIX => 'MiB', -GIGA_SUFFIX => 'GiB');
my $numberformat_en_US = new Number::Format(-thousands_sep   => ',', -decimal_point   => '.', -int_curr_symbol => '$', , -KILO_SUFFIX => 'KiB', -MEGA_SUFFIX => 'MiB', -GIGA_SUFFIX => 'GiB');

$main::numberformat{'de_DE'} = $numberformat_de_DE;
$main::numberformat{'en_US'} = $numberformat_en_US;

$main::fixednumberformat{'GiB'} = 1024 * 1024 * 1024;
$main::fixednumberformat{'MiB'} = 1024 * 1024;
$main::fixednumberformat{'KiB'} = 1024;
$main::fixednumberformat{'GB'} = 1000 * 1000 * 1000;
$main::fixednumberformat{'MB'} = 1000 * 1000;
$main::fixednumberformat{'KB'} = 1000;

## Register options
$main::options{'mydomainname=s'}         = \$main::opts{'mydomainname'};
$main::options{"numberformat=s"}         = \$main::opts{'numberformat'};
$main::options{"debug|d=s"}              = \$main::opts{'debug'};
$main::options{'format=s'}               = \@main::opt_format;
$main::options{'print-max-width=i'}      = \$main::opts{'print-max-width'};
$main::options{'verbose'}                = \$main::opts{'verbose'};
$main::options{'show_user_list=s'}       = \$main::opts{'show_user_list'};
$main::options{'show_domain_list=s'}     = \$main::opts{'show_domain_list'},
$main::options{'skip_subtree_pattern=s'} = \@opt_skip_subtree_pattern;
$main::options{'fixednumberformat=s'}    = \$main::opts{'fixednumberformat'};
$main::options{'printstatistics'}        = \$main::opts{'printstatistics'};


## Register calling hooks
$main::hooks{'beforemainloopstarts'}->{$module_name} = \&beforemainloopstarts1;
$main::hooks{'help'}->{$module_name} = \&help1;
$main::hooks{'checkoptions'}->{$module_name} = \&checkoptions;
$main::hooks{'early_begin'}->{$module_name} = \&setearlybegin;


## Global callable functions
sub help1() {
	my $temp;
	my $helpstring = "
    General:
    [--mydomainname <domain>]    My domain (default: domain of hostname)
";

	# Number format
	$temp = "    [--numberformat <format>]  Number format\n                               Default: 'de_DE'\n                               Available support:";
	foreach my $format (keys %main::numberformat ) {
	        $temp .= " '" . $format . "'";
	};
	$helpstring .= $temp . "\n";

	# Fixed Number format
	$temp = "    [--fixednumberformat <fixedformat>]  Fixed number format\n                               Default: none'\n                               Available support:";
	foreach my $format (keys %main::fixednumberformat ) {
	        $temp .= " '" . $format . "'";
	};
	$helpstring .= $temp . "\n";

	# Debug value
	$temp = "    [--debug|-d <debugvalue>]  Display some debug information";
	$helpstring .= $temp . "\n";

	# Verbose option
	$temp = "    [--verbose]  Be more verbose";
	$helpstring .= $temp . "\n";

	# statistics
	$temp = "    [--printstatistics]  Print some statistical data";
	$helpstring .= $temp . "\n";

	# Format options
	$temp = "    [--format <formatvalue>]  Format option for displaying information (can be used more than once)\n             Default: 'txttable'\n                         Available formats: 'txttable' 'computer' 'treeview' 'indented' 'none'\n               (not all formats are supported on each type)";
	$helpstring .= $temp . "\n";

	# Skip subtree entries
	$temp = "    [--skip_subtree_pattern <pattern>]  Regexp pattern on which subtree displaying is skipped in format 'treeview'\
           Can be used more than once\n";
	$helpstring .= $temp . "\n";

	# max width printing
	$temp = "    [--print-max-width <value>]  Maximum width of output (currently not always supported)\
        (default: 75)\n";
	$helpstring .= $temp . "\n";


	# User/domain lists
	$temp = "    [--show_domain_list <domain-list>] Show statistics only for domain in list\
     <domain-list> is a comma separated list of e-mail domains\ 
    [--show_user_list <user-list>]     Show statistics only for user in list\
     <user-list> is a comma separated list of e-mail addresses\
      currently supported by format: treeview";
	$helpstring .= $temp . "\n";

	return $helpstring;
};

# Set some values on early begin
sub setearlybegin() {
	$main::opts{'debug'} = 0;
};

# Check options
sub checkoptions() {
	##  Check debug value
	if (! defined $main::opts{'debug'}) {
		$main::opts{'debug'} = 0;
	};

	# hex to dec
	if ( $main::opts{'debug'} =~ /^0x[0-9A-Fa-f]+$/i ) {
		$main::opts{'debug'} = hex ($main::opts{'debug'});
	};

	# check dec
	if ( ! ( $main::opts{'debug'} =~ /^[0-9]+$/i ) ) {
		print STDERR "ERROR: Debug value not decimal: " . $main::opts{'debug'} . "\n";
		exit 1;
	};

	if ( $main::opts{'debug'} != 0 ) {
		printf STDERR "DEBUG: Debug mode: %x\n", $main::opts{'debug'};
	};


	## Set domainname
	if (! defined $main::opts{'mydomainname'} ) {
		# Set default
		my $myhostname = hostname;
		if ( $myhostname =~ /^[^\.]+\.(\S+)/ ) {
			$main::opts{'mydomainname'} = $1;
		};
	};
	print STDERR "INFO : Domainname: " . $main::opts{'mydomainname'} .  "\n" if ($main::opts{'debug'} & 0x0040);


	## Set hostname
	if (! defined $main::opts{'myhostname'} ) {
		# Set default
		$main::opts{'myhostname'} = hostname;
	};
	print STDERR "INFO : Hostname: " . $main::opts{'myhostname'} .  "\n" if ($main::opts{'debug'} & 0x0040);


	##  Check number format
	if (! defined $main::opts{'numberformat'}) {
		# Default
		$main::opts{'numberformat'} = "de_DE";
	};
	if (! defined $main::numberformat{$main::opts{'numberformat'}}) {
		print "ERROR: Unsupported number format: " . $main::opts{'numberformat'} . "\n";
		exit 1;
	};

	##  Check fixed format
	if (defined $main::opts{'fixednumberformat'}) {
		if (! defined $main::fixednumberformat{$main::opts{'fixednumberformat'}}) {
			print "ERROR: Unsupported fixed format: " . $main::opts{'fixednumberformat'} . "\n";
			exit 1;
		};
	};


	## Check format options
	if (scalar (@main::opt_format) == 0) {
		# Default
		push @main::opt_format, 'txttable';
	};
	for my $key (@main::opt_format) {
		# check key
		if ($key ne "computer" && $key ne "treeview" && $key ne "indented" && $key ne "txttable" && $key ne "none") {
			print STDERR "ERROR: Unsupported format: " . $key . "\n";
			exit 1;
		} else {
			$main::format{$key} = 1;
		};
	};


	# Adjust skip_subtree_pattern
	if (scalar(@opt_skip_subtree_pattern) > 0) {
		# Print for debugging
		foreach my $pattern (@opt_skip_subtree_pattern) {
			print STDERR "INFO : skip subtree pattern: " . $pattern . "\n" if ($main::opts{'debug'} & 0x0040);
		};
	};

	
	# max_width
	if (defined $main::opts{'print-max-width'}) {
		# 0 is currently not supported
		#if ($main::opts{'print-max-width'} == 0) {
		#	# ok
		#} elsif ($main::opts{'print-max-width'} < 60) {
		#	print STDERR "ERROR: value of option 'print-max-width' is too low, use '60' or up\n";
		#	exit 1;
		#};
		if ($main::opts{'print-max-width'} < 60) {
			print STDERR "ERROR: value of option 'print-max-width' is too low, use '60' or up\n";
			exit 1;
		};
	} else {
	# Default
		$main::opts{'print-max-width'} = 75;
	};
};

sub beforemainloopstarts1() {
};


# Unixtime2string
sub unixtime2string($) {
	return POSIX::strftime "%a %b %e %H:%M:%S %Y", localtime($_[0]);
};

# Print time range
sub print_timerange_normal() {
	my $timeminstr = POSIX::strftime "%a %b %e %H:%M:%S %Y", localtime($main::timemin);
	my $timemaxstr = POSIX::strftime "%a %b %e %H:%M:%S %Y", localtime($main::timemax);
	printf " Begin: %s (localtime)\n", $timeminstr;
	printf " End  : %s (localtime)\n", $timemaxstr;
};


# Print statistics
sub print_stat($$) {
	my $title = shift;
	my $p_stat = shift;
	my %stat = %$p_stat;
	my $sum = 0;

	print '=' x $main::opts{'print-max-width'} . "\n";
	print "$title\n";
	print_timerange_normal();
	print '-' x $main::opts{'print-max-width'} . "\n";
	if ($main::opts{'sort_type'} eq "alpha") {
		for my $key (sort keys %stat) {
			printf "%-*s : %5d\n", $main::opts{'print-max-width'} - 13, $key, $stat{$key};
			$sum += $stat{$key};
		};
	} elsif ($main::opts{'sort_type'} eq "maxmin") {
		for my $key (sort { $stat{$b} <=> $stat{$a} } keys %stat) {
			printf "%-*s : %5d\n", $main::opts{'print-max-width'} - 13, $key, $stat{$key};
			$sum += $stat{$key};
		};
	} elsif ($main::opts{'sort_type'} eq "minmax") {
		for my $key (sort { $stat{$a} <=> $stat{$b} } keys %stat) {
			printf "%-*s : %5d\n", $main::opts{'print-max-width'} - 13, $key, $stat{$key};
			$sum += $stat{$key};
		};
	} else {
		die "ERROR(missing-code): Unsupported sort type";
	};
	print '-' x $main::opts{'print-max-width'} . "\n";
	printf "%-*s : %5d\n", $main::opts{'print-max-width'} - 13, "Total", $sum;
	print '=' x $main::opts{'print-max-width'} . "\n\n";
};


# Print time range
sub print_timerange($) {
	my $format = shift || die "Missing format (arg1)";

	if (! defined $main::timemin || ! defined $main::timemax) {
		warn "No timerange data!\n";
		return;
	};

	if ( $format eq "computer" ) {
		printf "__timemin=%d\n", $main::timemin;
		printf "__timemax=%d\n", $main::timemax;
	} else {
		print '+' x $main::opts{'print-max-width'} . "\n";
		if (defined $main::timemin && defined $main::timemax) {
			my $timeminstr = POSIX::strftime "%a %b %e %H:%M:%S %Y", localtime($main::timemin); 
			my $timemaxstr = POSIX::strftime "%a %b %e %H:%M:%S %Y", localtime($main::timemax); 
			printf "Timerange:  %s  -  %s\n", $timeminstr, $timemaxstr;
		} else {
			printf "Timerange:  NO DATA!\n";
		};
		print '+' x $main::opts{'print-max-width'} . "\n";
		printf "\n";
	};
};


# Print headline
sub print_headline($$) {
	my $text = shift || die "Missing text (arg1)";
	my $format = shift || die "Missing format (arg2)";

	if ( $format eq "computer" ) {
		printf "\n";
		printf "__headline=\"%s\"\n", $text;
	} else {
		printf "\n\n";
		print '#' x $main::opts{'print-max-width'} . "\n";
		printf "%s\n", $text;
		print '#' x $main::opts{'print-max-width'} . "\n";
		printf "\n";
	};
};


## Print a subtreeview
# $1: pointer to subtreehash
# $2 (optional): max depth
# $3 (optional): list of subkeys
sub print_subtreeview($;$$) {
	my $p0 = $_[0] || die "Missing hash pointer";

	my $maxdepth = $_[1];
	if (! defined $maxdepth) { $maxdepth = -1; };
	#print "Maxdepth: $maxdepth\n";

	# if (! defined $p) { die "hash pointer is undefined"; };
	# if (! defined %$p) { die "hash of pointer is undefined"; };

	my $sublist = $_[2]; # optional list of subkeys
	if (! defined $sublist) { $sublist = "" };

	# count only
	if ($maxdepth == -2) {
		# Count level 2
		my $counter2 = 0;
		if ($sublist eq "" ) {
			foreach my $k0 ( sort keys %$p0 ) { 
				my $p1 = $$p0{$k0};
				foreach my $k1 ( sort keys %$p1 ) {
					my $p2 = $$p1{$k1};
					foreach my $k2 ( sort keys %$p2 ) {
						$counter2 += $$p2{$k2};
					};
				};
			};
		} else {
			foreach my $k0 (split " ", $sublist) {
				if (defined $$p0{$k0} ) {
					my $p1 = $$p0{$k0};
					foreach my $k1 ( sort keys %$p1 ) {
						my $p2 = $$p1{$k1};
						foreach my $k2 ( sort keys %$p2 ) {
							$counter2 += $$p2{$k2};
						};
					};
				};
			};
		};
		return ($counter2)
	};

	my $c0;
	my %subkeyfilter;
	my $string;
	if ($sublist eq "" ) {
		$c0 = scalar( keys %$p0 );
	} else {
		# split array into hash
		foreach my $k0 (split " ", $sublist) {
			if (defined $$p0{$k0} ) {
				$subkeyfilter{$k0} = 1;
			};
		};
		$c0 = scalar( keys %subkeyfilter );
	};

	if ($c0 == 0) {
		return 0;
	};

	foreach my $k0 ( sort keys %$p0 ) { 
		if ($sublist ne "" ) {
			# check filter
			if (! defined  $subkeyfilter{$k0}) {
				next;
			};
		};

		$c0--;
		if ( $c0 > 0 ) {
			print "+- ";
		} else {
			print "`- ";
		};
		my $p1 = $$p0{$k0};
		my $c1 = scalar( keys %$p1 );
		#print $k0 . " [" . $c1 . "]\n";

		# Count level 3
		my $counter3 = 0;
		foreach my $k1 ( sort keys %$p1 ) {
			my $p2 = $$p1{$k1};
			foreach my $k2 ( sort keys %$p2 ) {
				if (! defined  $$p2{$k2} ) {
					warn "key has no value: $k2\n";
				} else {
					$counter3 += $$p2{$k2};
				};
			};
		};
		print $k0 . " [" . $counter3 . "]\n";

		foreach my $k1 ( sort keys %$p1 ) {
			$c1--;
			if ( $c0 > 0 ) {
				print "|";
			} else {
				print " ";
			};
			my $p2 = $$p1{$k1};
			if ( $c1 > 0 ) {
				print "  +- ";
			} else {
				print "  `- ";
			};
			my $c2 = scalar( keys %$p2 );
			#print $k1 . " [" . $c2 . "]\n";

			# Count level 4
			my $counter4 = 0;
			foreach my $k2 ( sort keys %$p2 ) {
				$counter4 += $$p2{$k2};
			};
			$string = $k1;

			if (defined $main::opts{'print-max-width'} && $main::opts{'print-max-width'} > 0) {
				# max_width - 2 
				my $delta = (length($k1) + length($counter4) + 3 + 6) - $main::opts{'print-max-width'} + 2;
				if ( $delta > 0 ) {
					if (length($string) > ($delta + 3)) {
						$string = substr($string, 0, length($string) - $delta - 3) . "...";
					};
				} else {
					# Append some spaces for right alignment
					$string .= ' ' x (- $delta);
				};
			}
			print $string . " [" . $counter4 . "]\n";

			my $skip = 0;
			if (scalar(@opt_skip_subtree_pattern) > 0) {
				# Check for skip_subtree_pattern
				foreach my $pattern (@opt_skip_subtree_pattern) {
					if ($k1 =~ /$pattern/) {
						$skip = 1;
						last;
					};
				};
			};

			if ((($maxdepth >= 4) || ($maxdepth == -1)) && ($skip == 0)) {
				foreach my $k2 ( sort keys %$p2 ) {
					$c2--;
					if ( $c0 > 0 ) {
						print "|";
					} else {
						print " ";
					};
					if ( $c1 > 0 ) {
						print "  |";
					} else {
						print "   ";
					};
					if ( $c2 > 0 ) {
						print "  +- ";
					} else {
						print "  `- ";
					};
					$string = $k2;

					if (defined $main::opts{'print-max-width'} && $main::opts{'print-max-width'} > 0) {					
						my $delta = (length($k2) + length($$p2{$k2}) + 3 + 9) - $main::opts{'print-max-width'};
						if ( $delta > 0 ) {
							# longer than max width, have to shorten now
							# try to be intelligent
							my ($t1, $t2, $t3, $t4);
							my ($l1, $l2, $l3, $l4);
							if (($t1, $t2, $t3, $t4) = $string =~ /^([^@]*)@(.*)\s\((.+)\[(.+)\]\)$/o ) {
								# yrddfucambd@yahoo.com (66-123-123-123.lb-cres.charterpipeline.net[123.123.123.123])
								# svq@[filename /home/admin/domains.txt] (d66-123-123-123.bchsia.telus.net[66.123.123.123])   <-  more funny one
								$l1 = length($t1);
								$l2 = length($t2);
								$l3 = length($t3);
								$l4 = length($t4);

								# Short first t3
								if (($delta > 0) && ($l3 > 6)) {
									if ($l3 - 6 > $delta) {
										$t3 = substr($t3, 0, $l3 - 3 - $delta) . "...";
										$delta = 0;
									} else {
										$t3 = substr($t3, 0, 3) . "...";
										$delta -= $l3 - 6;
									};
								};

								# Short now t2 if required
								if (($delta > 0) && ($l2 > 6)) {
									if ($l2 - 6 > $delta) {
										$t2 = substr($t2, 0, $l2 - 3 - $delta) . "...";
										$delta = 0;
									} else {
										$t2 = substr($t2, 0, 3) . "...";
										$delta -= $l2 - 6;
									}
								};

								# Short now t1 if required
								if (($delta > 0) && ($l1 > 6)) {
									if ($l1 - 6 > $delta) {
										$t1 = substr($t1, 0, $l1 - 3 - $delta) . "...";
										$delta = 0;
									} else {
										$t1 = substr($t1, 0, 3) . "...";
										$delta -= $l1 - 6;
									}
								};
								# Short now t4 if required
								if (($delta > 0) && ($l4 > 6)) {
									if ($l4 - 6 > $delta) {
										$t4 = substr($t4, 0, $l1 - $delta - 3) . "...";
										$delta = 0;
									} else {
										$t4= substr($t4, 0, 3) . "...";
										$delta -= $l4 - 6;
									};
								};

								if ($delta > 0) {
									#warn "Problem with print-max-width: " . $string . "\n";
								};

								$string = $t1 . "@" . $t2 . " (" . $t3 . "[" . $t4 . "])";

							 } elsif (($t1, $t3, $t4) = $string =~ /^([^@]+)\s\((.+)\[(.+)\]\)$/o ) {
								# from=<> (server.domain.example[1.2.3.4])

								$l1 = length($t1);
								$l3 = length($t3);
								$l4 = length($t4);

								# Short first t3
								if (($delta > 0) && ($l3 > 6)) {
									if ($l3 - 6 > $delta) {
										$t3 = substr($t3, 0, $l3 - 3 - $delta) . "...";
										$delta = 0;
									} else {
										$t3 = substr($t3, 0, 3) . "...";
										$delta -= $l3 - 6;
									};
								};

								# Short now t1 if required
								if (($delta > 0) && ($l1 > 6)) {
									if ($l1 - 6 > $delta) {
										$t1 = substr($t1, 0, $l1 - 3 - $delta) . "...";
										$delta = 0;
									} else {
										$t1 = substr($t1, 0, 3) . "...";
										$delta -= $l1 - 6;
									}
								};
								# Short now t4 if required
								if (($delta > 0) && ($l4 > 6)) {
									if ($l4 - 6 > $delta) {
										$t4 = substr($t4, 0, $l1 - $delta - 3) . "...";
										$delta = 0;
									} else {
										$t4= substr($t4, 0, 3) . "...";
										$delta -= $l4 - 6;
									};
								};

								if ($delta > 0) {
									#warn "Problem with print-max-width: " . $string . "\n";
								};

								$string = $t1 . " (" . $t3 . "[" . $t4 . "])";

							} elsif (($t1, $t2) = $string =~ /^([^@]*)@([^\s]*)$/o ) {
								# great_camera@srv04189.e-bizinformationcenter.com
								$l1 = length($t1);
								$l2 = length($t2);

								# Short first t2
								if (($delta > 0) && ($l2 > 6)) {
									if ($l2 - 6 > $delta) {
										$t2 = substr($t2, 0, $l2 - 3 - $delta) . "...";
										$delta = 0;
									} else {
										$t2 = substr($t2, 0, 3) . "...";
										$delta -= $l2 - 6;
									};
								};

								# Short now t1 if required
								if (($delta > 0) && ($l1 > 6)) {
									if ($l1 - 6 > $delta) {
										$t1 = substr($t1, 0, $l1 - 3 - $delta) . "...";
										$delta = 0;
									} else {
										$t1 = substr($t1, 0, 3) . "...";
										$delta -= $l2 - 6;
									}
								};

								if ($delta > 0) {
									#warn "Problem with print-max-width: " . $string . "\n";
								};

								$string = $t1 . "@" . $t2;
							} else {
								warn "No match for print-max-width: " . $string . "\n";
							}
						} else {
							# Append some spaces for right alignment
							$string .= ' ' x (- $delta);
						};
					};
					print $string . " [" . $$p2{$k2} . "]\n";
				};
			} else {
				if (! (($maxdepth >= 4) || ($maxdepth == -1))) {
					print "   `- #### Subtree entries skipped by maxdepth mechanism\n" if ($main::opts{'debug'} & 0x0040);
				} elsif ($skip == 1) {
					print "   `- #### Subtree entries skipped by option '--skip_subtree_pattern'\n" if ($main::opts{'debug'} & 0x0040);
				};
			};
		};
	};
};

## Print a treeview
# $1: pointer to treehash
# $2 (optional): list of keys
# $3 (optional): list of subkeys
sub print_treeview($;$$) {
	my $p = $_[0] || die "Missing hash pointer";
	my $list = $_[1]; # optional list of keys
	my $sublist = $_[2]; # optional list of subkeys
	my $p0;

	#print "List: " . $list . "\n";
	# print "DEBUG/main/print_treeview: called\n";
	
	if (! defined $p) { die "hash pointer is undefined"; };
	if (! defined %$p) {
		print "\n";
		print " !  no data !\n";
		return 1;
	};
	if (! defined $list) { $list = "" };
	if (! defined $sublist) { $sublist = "" };

	if ($list eq "" ) {
		# print "DEBUG/main/print_treeview: without list\n";
		for my $k ( sort keys %$p ) {
			# print "DEBUG/main/print_treeview: " . $k . "\n";
			$p0 = $$p{$k};
			#print "\n" . $k . " [" . scalar(keys %$p0)  . "]\n";
			print "\n" . $k . "\n";
			print_subtreeview(\%$p0, -1, $sublist);
		};
	} else {
		foreach my $k (split " ", $list) {
			print "\n" . $k . "\n";
			if (! defined $$p{$k} ) {
				print " !  no data !\n";
				next;
			};
			#print "\n" . $k . " [" . scalar(keys %$p0)  . "]\n";
			print "\n" . $k . "\n";
			$p0 = $$p{$k};
			print_subtreeview(\%$p0, -1, $sublist);
		};
	};
};

## Print a treeview
# $1: pointer to treehash
# $2 (optional): max depth
# $3 (optional): list of keys
sub print_treeview2($;$@) {
	my $p = $_[0] || die "Missing hash pointer";
	my $maxdepth = $_[1]; # optional max depth
	my $list = $_[2]; # optional list of keys
	my $p0;

	#print "Maxdepth: $maxdepth\n";
	#print "List: " . $list . "\n";
	# print "DEBUG/main/print_treeview: called\n";
	
	if (! defined $p) { die "hash pointer is undefined"; };
	if (! defined %$p) { die "hash of pointer is undefined"; };
	if (! defined $list) { $list = "" };

	if ($list eq "" ) {
		# print "DEBUG/main/print_treeview: without list\n";
		for my $k ( sort keys %$p ) {
			# print "DEBUG/main/print_treeview: " . $k . "\n";
			$p0 = $$p{$k};
			#print "\n" . $k . "\n";

			my $c = print_subtreeview( \%$p0, -2 );
			print "\n" . $k . " [" . $c  . "]\n";
			print_subtreeview( \%$p0, $maxdepth );
		};
	} else {
		foreach my $k (split " ", $list) {
			print "\n" . $k . "\n";
			if (! defined $$p{$k} ) {
				print " !  no data !\n";
				next;
			};
			#print "\n" . $k . " [" . scalar(keys %$p0)  . "]\n";
			#print "\n" . $k . "\n";
			$p0 = $$p{$k};
			my $c = print_subtreeview( \%$p0, -2 );
			print "\n" . $k . " [" . $c  . "]\n";
			print_subtreeview( \%$p0, $maxdepth );
		};
	};
};


## Extract domain
sub extract_domain ($) {
	my $email = shift || return "";
	#die "Missing argument";
	my $domain;

	# Cache lookup
	if (defined $cache_extract_domain{$email}) {
		return ($cache_extract_domain{$email});
	};

	if ( $email eq "from=<>" || $email eq "from=<#@[]>" ) {
		# unspecified sender, nothing to strip
		$domain = $email;
	} elsif ( $email =~ /^.*@([^@]+)$/ ) {
		$domain = $1;

		if (! defined $domain ) {
			$domain = "ADDRESS_WITH_INVALID_DOMAIN";
		};
	} else {
		# email address contains no domain
		$domain = "ADDRESS_WITHOUT_DOMAIN";
	};

	$cache_extract_domain{$email} = $domain;
	return ($domain);
};


## Extract 2nd level domain
sub extract_2ndleveldomain ($) {
	my $email = shift || die "Missing argument";
	my $domain;

	# Cache lookup
	if (defined $cache_extract_2ndleveldomain{$email}) {
		return ($cache_extract_2ndleveldomain{$email});
	};

	if ( $email eq "from=<>" || $email eq "from=<#@[]>" ) {
		# unspecified sender, nothing to strip
		$domain = $email;
		goto("END_extract_2ndleveldomain");
	};

	# Check for e-mail address
	if ( $email =~ /@/o ) {
		# Is a e-mail address	
		if ( $email =~ /^.*@([^@]+)$/o ) {
			$domain = $1;
		} else {
			$domain = "ADDRESS_WITHOUT_DOMAIN";
			goto("END_extract_2ndleveldomain");
		};

		if (! defined $domain ) {
			$domain = "ADDRESS_WITH_INVALID_DOMAIN";
			goto("END_extract_2ndleveldomain");
		};
	} else {
		# domain only
		$domain = $email;
	};

	# Strip trailing "."
	$domain =~ s/\.+$//og;

	if ( $domain =~ /^[^.]+\.(co|ac)\.[^.]+$/o || $domain =~ /^[^.]+\.[^.]+$/o ) {
		# Nothing to do anymore
	} elsif ( $domain =~ /^.*\.([^.]+(\.(co|ac))\.[^.]+)$/o || $domain =~ /^.*\.([^.]+\.[^.]+)$/o ) {
		$domain = $1;
		if (! defined $domain ) {
			$domain = "ADDRESS_WITHOUT_SECONDLEVEL_DOMAIN";
		};
	} else {
		$domain = "ADDRESS_WITHOUT_SECONDLEVEL_DOMAIN";
	};

END_extract_2ndleveldomain:
	$cache_extract_2ndleveldomain{$email} = $domain;
	return ($domain);
};


## Modify address according to hooks
sub modify_address ($) {
	my $input = $_[0] || die "Missing argument";
	my $output;
	
	# Cache lookup
	if (defined $cache_modify_address{$input}) {
		return ($cache_modify_address{$input});
	};

	# Hook "modifyaddress"
	for my $p_hook (keys %{$main::hooks{'modifyaddress'}}) {
		$output= &{$main::hooks{'modifyaddress'}->{$p_hook}} ($input);
	};

	$cache_modify_address{$input} = $output;
	return ($output);
};


## Format number
sub format_number ($) {
	my $input = $_[0];

	if (! defined $input) {
		die "Missing argument";
	};

	my $output;

	if (! defined $opts{'fixednumberformat'}) {
		$output = $numberformat{$opts{'numberformat'}}->format_bytes($input);
	} else {
		$output = $numberformat{$opts{'numberformat'}}->format_bytes($input / $main::fixednumberformat{$opts{'fixednumberformat'}}, 3) . $opts{'fixednumberformat'};

	};

	return ($output);
};


## End of module
return 1;