# *-* Perl *-*

# Core Functions Include File for Web Logs Software
# WJL V0.26, Version 0.3
# Carl Ritson - 2002

# Define This Package
package WJLCore;

# Library Includes
require Digest::MD5;
require MIME::Base64;
require Time::Local;
require CGI;
require strict;

use vars qw($VERSION);
$VERSION = '0.3';

# Export Functions for pages to use.
require Exporter;
@ISA = qw(Exporter);
@EXPORT = (
	'organisation',
	'md5sum',
	'meta_redirect',
	'get_user_info',
	'user_valid',
	'user_level',
	'start_page',
	'db_error',
	'db_login',
	'form_button',
	'six_page',
	'frame6_page',
	'has_right',
	'set_right',
	'hidden_fields',
	'text_field',
	'n2month',
	'gen_date',
	'date2timestamp',
	'gen_elapsed',
	'select_field',
	'text_area',
	'submit_button',
	'hash2get',
	'status',
	'statusl',
	'priol',
	'priof',
	'filter',
	'radio_fields',
	'fmt',
	'popup_redirect',
	'job_valid',
	'event_type',
	'auth_fail_page',
	'dhtml_header',
	'dhtml_main',
	'dhtml_wrap',
	'isie',
	'mime',
	'carrier_encode',
	'carrier_decode',
	'cut',
	'alert',
	'set_sectoken'	
);

# Start of Subs

sub organisation {
	my $organisation = 'your_organisation';
	return $organisation;
}

# md5sum, takes string, returns Hex Digest of it, uses Digest::MD5.
sub md5sum($) {
	my $string = $_[0];
	my $md5 = Digest::MD5->new;
	$md5->add($string);
	return($md5->hexdigest);
}

# meta_redirect, takes URL , returns Generates Meta Redirect.
# 		Use instead of using meta_redirect header.
sub meta_redirect($) {
	my $url = $_[0];
	return ('<meta http-equiv="refresh" content="0;URL='.$url.'">');
}

# center, returns html with in center tags.
sub center {
	my ($html) = join('',@_);
	return '<center>'.$html.'</center>';
}

# gets_user_info, requires a CGI object, returns a Hash.  Sends Page Header.
sub get_user_info {
	my ($page,$header_type) = @_;
	my %userinfo;
	if(!$header_type) {
		$header_type = 'text/html';
	}
	if ($page->param('security') =~ /high/) {
		$userinfo{username} = $page->param('username');
		$userinfo{sectoken} = $page->param('sectoken');
		$userinfo{security} = 'high';
		print CGI::header($header_type);
	} else {
		%userinfo = $page->cookie('wjl');
		#print header(-cookie=>$cookie);
		#print STDERR "raw: ".$page->raw_cookie()."\n";
		#print STDERR "cookie: $cookie\n";
		#%userinfo = split(/:/,$cookie);
		print CGI::header($header_type);
	}
	return %userinfo;
}

# user_valid, requires DBH, Username, Sectoken. Returns 1 If The User is Valid.
sub user_valid($$$) {
	my ($dbh, $username, $sectoken) = @_;
	my $query = "SELECT username FROM user WHERE username=\'$username\' AND sectoken=\'$sectoken\'";
	my $result = $dbh->query($query);
	if ($result->fetchrow()) {
		return 1;
	} else {
		return 0;
	}
}

# user_level, requires DBH, Username. Returns Users Level.
sub user_level($$) {
	my ($dbh, $username) = @_;
	my $query = "SELECT level FROM user WHERE username='$username'";
	my $result = $dbh->query($query);
	my @row = $result->fetchrow();
	return $row[0];
}	

# start_page, require CGI object and DBH, returns $result and %userinfo.
#		$result is 1 if the user was authenticated, etc.
sub start_page($$) {
	my ($page, $dbh) = @_;	
	my $result = 0;
	my %userinfo = get_user_info($page);
	if (user_valid($dbh,$userinfo{username},$userinfo{sectoken})) {
		$result = 1;
	}
	return ($result, %userinfo);
}

# db_error, take no arguments, returns void. Print DB Error Page.
sub db_error {
	print 	CGI::header(),
		CGI::start_html("Database Error :("),
		CGI::h2("Sorry a Database Error has occured, please try again later"),
		CGI::end_html();
}

# db_login, take no arguments, returns an array for use with the Mysql->connect.
sub db_login {
	my @login_info;
	my $db_name 	= "joblogs";
	my $db_host 	= "localhost";
	my $db_user 	= "your_user";
	my $db_password	= "your_password";	
	push(@login_info,$db_host,$db_name,$db_user,$db_password);
	return(@login_info);
}

# form_button, takes name, target, %parm, returns form based html button
sub form_button($$%) {
	my ($name, $target, %parm) = @_;
	my $html = "";
	$html .= "<form action=\"$target\" METHOD=\"POST\">\n";
	foreach(keys(%parm)) {
		my $key = $_;
		$html .= "\t".'<input type="hidden" name="'.$key.'" value="'.$parm{$key}.'">'."\n";
	}
	$html .= submit_button($name);
	$html .= "</form>";
	return $html;
}

# six_page, takes 6 strings, returns them as tabled html 3x2.
sub six_page($$$$$$) {
	my ($tl,$tm,$tr,$bl,$bm,$br) = @_;
	my $table = '<table BORDER="0" CELLPADDING="0" CELLSPACING="0" WIDTH="100%">';
	$table .= CGI::Tr(
			'<td WIDTH="5%"></td>',
			'<td WIDTH="90%"></td>',
			'<td WIDTH="5%"></td>'
	);
	
	return CGI::start_html(
			-title => "Web Job Logs - ".organisation(),
			-style => {'src' => '/wjl-style.css'},
			-head  => dhtml_header()
			),
		$table,
			CGI::Tr(CGI::td(center($tl)),CGI::td(center($tm)),CGI::td(center($tr))),
			CGI::Tr(CGI::td($bl),CGI::td(center($bm)),CGI::td($br)),
		'</table>',
		CGI::end_html();
}

# frame6_page, takes page, returns it framed using a mostly blank six_page.
sub frame6_page($) {
	my $page = $_[0];
	return six_page('','','','',$page,'');
}

# Two functions has_right and set_right, edit of level tokens.
# This is done to keep all the magic in one place.

# has_right, takes level, rights question.  returns 1 if user has that right.
sub has_right($$) {
	my ($level, $right) = @_;
	# The magic..
	my $new_job 	= 0x01;
	my $edit_jobs 	= 0x02;
	my $alloc_and_prio = 0x04;
	my $setup	= 0x08;
	my $password 	= 0x10;
	my $delete	= 0x20;
	my $stats	= 0x40;
	my $knowledge	= 0x80;
	# Use RegExps, so queries can be more fluid.
	if($right =~ /job/) {
		if($right =~ /new/) {
			if($level & $new_job) {
				return 1;
			}	
		} elsif($right =~ /edit/) {
			if($level & $edit_jobs) {
				return 1;
			}
		}
	} elsif($right =~ /password/) {
		if($level & $password) {
			return 1;
		}
	} elsif($right =~ /setup/) {
		if($level & $setup) {
			return 1;
		}
	} elsif($right =~ /allocate/ || $right =~ /set.*priority/) {
		if($level & $alloc_and_prio) {
			return 1;
		}
	} elsif($right =~ /delete/) {
		if($level & $delete) {
			return 1;
		}
	} elsif($right =~ /stat/) {
		if($level & $stats) {
			return 1;
		}
	} elsif($right =~ /know/) {
		if($level & $knowledge) {
			return 1;
		}
	}
	return 0;
}

# set_right, takes level, right, boolean.  returns the altered level token.
sub set_right($$$) {
	my ($level, $right, $boolean) = @_;
	my $mask = 0;
	# The magic..
	my $new_job 	= 0x01;
	my $edit_jobs 	= 0x02;
	my $alloc_and_prio = 0x04;
	my $setup	= 0x08;
	my $password 	= 0x10;
	my $delete	= 0x20;
	my $stats	= 0x40;
	my $knowledge	= 0x80;
	# Use RegExps, so queries can be more fluid.
	if($right =~ /job/) {
		if($right =~ /new/) {
			$mask = $new_job;
		} elsif($right =~ /edit/) {
			$mask = $edit_jobs;
		}
	} elsif($right =~ /password/) {
		$mask = $password;
	} elsif($right =~ /setup/) {
		$mask = $setup;
	} elsif($right =~ /allocate/ || $right =~ /set.*priority/) {
		$mask = $alloc_and_prio;
	} elsif($right =~ /delete/) {
		$mask = $delete;
	} elsif($right =~ /stat/) {
		$mask = $stats;
	} elsif($right =~ /know/) {
		$mask = $knowledge;
	}
	if($boolean) {
		$level |= $mask;
	} else {
		$level &= ~$mask;
	}
	return $level;
}

# hidden_fields, takes %data, returns a set of html hidden fields.
sub hidden_fields {
	my %data = @_;
	my $html = '';
	foreach(keys(%data)) {
		my $key = $_;
		$html .= '<input type="hidden" name="'.$key.'" value="'.$data{$key}.'">'."\n";
	}
	return $html;
}

# text_field, takes name, value. returns html text input field.
sub text_field($$) {
	my ($name, $value) = @_;
	my $size = length($value) > 20 ? length($value) : 20;
	my $html = "<input type=\"text\" name=\"$name\" size=\"$size\" value=\"$value\">\n";
	return $html;
}

# n2month, takes unix month number, returns 3 letter month name.
sub n2month($) {
	return (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$_[0]];
}

# gen_date, takes unix timestamp, returns date+time in form "11-Oct-2002 10:20"
sub gen_date($) {
	my $time = int($_[0]);
	my @temp = gmtime($time);
	my $month = n2month($temp[4]);
	my $day = $temp[3];
	my $year = $temp[5] + 1900;
	my $time = $temp[2].':'.($temp[1] < 10?'0'.$temp[1]:$temp[1]);
	my $text = "$day-$month-$year $time";
	return $text;
}

# date2timestamp, takes a text string something like "11-Oct-2002 10:20".
# returns unix timestamp. (intelligent e.g. "20:10 12/02/2000" is also valid)
sub date2timestamp($) {
	my $text = $_[0];
	my @months = qw(ja fe mar ap may jun jul au se oc no de);
	my ($a,$b,undef) = split(/ /,$text,3);
	my ($date,$time);
	# Which part is time and which is date?
	if($a =~ /:/) {
		$time = $a;
		$date = $b;
	} else {
		$time = $b;
		$date = $a;
	}
	# Clean rubbish out of time
	$time =~ s/([^0-9:])//g;
	# Split Time
	my ($hour,$minute,undef) = split(/:/,$time);
	
	# Split Date
	$date =~ s/([^0-9A-Za-z])/ /g;
	my ($day,$month,$year,undef) = split(/ /,$date);
	# See if month is tex tof number.
	if ($month =~ /([A-Za-z])/) {
		my $count = 0;
		foreach(@months) {
			my $m = $_;
			if($month =~ /^$m/i) {
				$month = $count;
			}
			++$count;
		}
	} else {
		--$month;
	}
	if($year >= 100) {$year -= 1900;}
	#print STDERR "timelocal(0,$minute,$hour,$day,$month,$year)\n";
	return Time::Local::timelocal(0,$minute,$hour,$day,$month,$year);
}

# gen_elapsed, takes seconds and returns the time elapsed as a text string.
sub gen_elapsed($) {
	my $sec = int($_[0]);
	my $ret = '';
	my ($min,$hour,$day);
	#print STDERR "gen_elapsed; in:$sec\n";
	if($sec >= (60*60*24)) {
		$day = int($sec / (60*60*24));
		$sec -= 60*60*24*$day;
	}
	if($sec >= (60*60)) {
		$hour = int($sec / (60*60));
		$sec -= 60*60*$hour;
	}
	if($sec >= 60) {
		$min = int($sec / 60);
		$sec -= 60*$min;
	}
	if($day) {
		$ret .= "$day Days, ";
	}
	if($day || $hour) {
		if($hour == 0) {
			$hour = '0';
		}
		$ret .= "$hour Hours, ";
	}
	if($day || $hour || $min) {
		if($min == 0) {
			$min = '0';
		}
		$ret .= "$min Minutes, ";
	}
	if($sec == 0) {
		$sec = '0';
	}
	$ret .= "$sec Seconds";
	#print STDERR "gen_elapsed; out:$ret\n";
	return $ret;
}
	

# select_field, takes name, currently selected option, list of options.
# 	returns html select input type.
sub select_field($$@) {
	my ($name, $value, @options) = @_;
	my $html = '';
	$html .= "<SELECT name=\"$name\">\n";
	foreach(@options) {
		my $option = $_; 
		if($value && $option =~ /^$value/) {
			$html .= "\t<OPTION SELECTED>$option</OPTION>\n";
		} else {
			$html .= "\t<OPTION>$option</OPTION>\n";
		}
	}
	$html .= "</SELECT>\n";
	return $html;
}

# text_area, takes name, rows, cols and value. returns html textarea.
sub text_area($$$$) {
	my ($name, $rows, $cols, $value) = @_;
	my $html = '';
	$html .= "<TEXTAREA NAME=\"$name\"";
	if($rows) {
		$html .= " ROWS=$rows";
	}
	if($cols) {
		$html .= " COLS=$cols";
	}
	$html .= ">\n";
	$html .= $value;
	$html .= "</TEXTAREA>\n";
	return $html;
}

# submit_button, takes label for button, returns html submit button.
sub submit_button($) {
	my $label = $_[0];
	return "<input type=\"submit\" name=\"submit_type\" value=\"$label\">\n";
}

# hash2get, takes a hash of arguments, returns them in a get style url.
sub hash2get(%) {
	my %parm = @_;
	my @keys = keys(%parm);
	my $url = '';
	if(@keys > 0) {
		$url .= '?';
		foreach(@keys) {
			my $key = $_;
			$url .= $key.'='.$parm{$key}.'&';
		}
		chop($url);
	}
	return $url;
}

# status, convert status number to Text and vice versa.
sub status($) {
	my $status = $_[0];
	# print STDERR "status: in '$status'\n";
	my $out;
	# Text to int, or int to Text?
	if($status =~ /([A-Za-z])/) {
		# Text to int..
		if($status =~ /New/i) {
			$out = 1;
		} elsif($status =~ /Active/i) {
			$out = 2;
		} elsif($status =~ /Ready/i && $status =~ /User Test/i) {
			$out = 4;
		} elsif($status =~ /Suspend/i) {
			$out = 64;
		} elsif($status =~ /Closed/i) {
			$out = 128;
		}
	} else {
		# int to Text..
		if($status == 1) {
			$out = 'New';
		} elsif($status == 2) {
			$out = 'Active';
		} elsif($status == 4) {
			$out = 'Ready for user testing';
		} elsif($status == 64) {
			$out = 'Suspended';
		} elsif($status == 128) {
			$out = 'Closed';
		}
	}
	# print STDERR "status: return '$out'\n";
	return $out;
}

# statusl, returns a list of valid status texts.
sub statusl {
	my @list;
	# List of Status Codes.
	my @sti = (1,2,4,64,128);
	foreach(@sti) {
		push(@list,status($_));
	}
	return @list;
}

# priol, returns a list of valid priorities.
sub priol {
	return ('NA',1,2,3,4,5);
}

# priof, priority filter, converts 0 to NA, NA to 0.
sub priof($) {
	my $p = $_[0];
	if($p =~ /NA/) {
		return 0;
	} elsif($p == 0) {
		return 'NA';
	} else {
		return $p;
	}
}

# filter, takes string filters and dereferences stuff.
sub filter($) {
	my $text = shift;
	if($text) {
		$text =~ s/"/'/g;
		$text =~ s/`/'/g;
		$text =~ s/'/\\'/g;
		$text =~ s/([<>])/\\'/g;
	}
	return $text;
}

# radio_fields, takes name, currently checked and hash of value => option. 
#	returns html radio field.
sub radio_fields($$%) {
	my ($name, $checked, %parm) = @_;
	my $tab = '';
	my $html = '';
	foreach my $key (keys(%parm)) {
		if($key =~ /$checked/ && $checked) {
			$tab = ' CHECKED';
		} else {
			$tab = '';
		}
		$html .= '<br><input TYPE="radio" NAME="'.$name.'" VALUE="'.$key.'"'.$tab.'>'.$parm{$key}."\n";
	}
	return $html;
}

# fmt, takes columns, rows, string. 
#	returns the string html formated to those dimensions
sub fmt($$$) {
	my ($cols, $rows, $data) = @_;
	#my $chars = $cols * $rows;
	#my @data = split(//,$data,($chars+1));
	#my ($i,$j);
	#if(length($data) > $cols) {
	#	$data = '';
	#	for ($i = 0; $i < $rows; ++$i) {
	#		for ($j = 0; $j < $cols; ++$j) {
	#			$data .= $data[($i * $cols) + $j];
	#		}
	#		$data .= "<br>\n";
	#	}
	#}
	return $data;
}

# popup_redirect, takes url, returns javascript.
#	which spawns a new window and redirects it to url.
sub popup_redirect($) {
	my $url = $_[0];
	my $html = '';
	$html .= '<script language="JavaScript">'."\n";
	$html .= 'pop = window.open("","pop","");'."\n";
	$html .= "pop.document.write('<head>');\n";
	$html .= "pop.document.write('".meta_redirect($url)."'>);\n";
	$html .= "pop.document.write('<title> </title>');\n";
	$html .= "pop.document.write('</head>');\n";
	$html .= "</script>\n";
	return $html;
}

# job_valid, takes jobid and dbh. returns 1 if job exists.
sub job_valid($$) {
	my ($jobid, $dbh) = @_;
	$jobid =~ s/([^0-9])//g;
	# Quite simple, if either is blank fail..
	if($dbh && $jobid) {
		my $query = "SELECT jobid FROM job WHERE jobid='$jobid'";
		my $result = $dbh->query($query);
		my @row = $result->fetchrow();
		if($row[0] == $jobid) {
			return 1;
		} else {
			return 0;
		}
	} else {
		return 0;
	}
}

# event_type, takes text type and event code. returns 1 if that code is set.
sub event_type($$) {
	my ($text, $code) = @_;
	# Magic..
	my $comment 		= 0x01;
	my $status_change 	= 0x02;
	my $set_priority 	= 0x04;
	my $allocate 		= 0x08;
	# Vague Checking..
	if($text =~ /comment/i && ($code & $comment)) {
		return 1;
	} elsif($text =~ /status.change/i && ($code & $status_change)) {
		return 1;
	} elsif($text =~ /set.priority/i && ($code & $set_priority)) {
		return 1;
	} elsif($text =~/allocate/i && ($code & $allocate)) {
		return 1;
	}
	# Nope
	return 0;
}

# auth_fail_page, takes username, returns redirect to the index login page, with the username.
sub auth_fail_page($) {
        my $user = $_[0];
	my $html = '';
        $html .= meta_redirect('index.pl'.hash2get(username => $user, fail => 1));
	$html .= CGI::end_html();
	return $html;
}

# dhtml_header, css for dhtml, needs to be in html <head>
sub dhtml_header {
	return 
'
<STYLE TYPE="text/css">
<!--

.DEK {POSITION:absolute;VISIBILITY:hidden;Z-INDEX:200;}
//-->
</STYLE>
';
}

# dhtml_main, spits out the script to do DHTML message boxes.
sub dhtml_main {
	return
'
<DIV ID="dek" CLASS="dek"></DIV>
<SCRIPT TYPE="text/javascript">
<!--
Width=screen.availWidth/2;
Xoffset=-(Width/2);
Yoffset= 20;
var active=0;
var tick=0;

var nav,old,iex=(document.all);
if(navigator.appName=="Netscape"){(document.layers)?nav=true:old=true;}

if(!old){
var skn=(nav)?document.dek:dek.style;
if(nav)document.captureEvents(Event.MOUSEMOVE);
document.onmousemove=get_mouse;
}

function popup(msg,bak){
 active = 1;
 tick = 0;
var content="<TABLE WIDTH="+Width+" BORDER=1 BORDERCOLOR=black CELLPADDING=2 CELLSPACING=0 "+
"BGCOLOR="+bak+"><TD ALIGN=center><FONT COLOR=white face=verdana SIZE=1><b>"+msg+"</b></FONT></TD></TABLE>";
if(old){return;} 
else{
 if(nav){skn.document.write(content);skn.document.close();}
 if(iex){document.all("dek").innerHTML=content;}
 }
}

function get_mouse(e){
 if(active) {
  var x=(nav)?e.pageX:event.x+document.body.scrollLeft;skn.left=x+Xoffset;
  var y=(nav)?e.pageY:event.y+document.body.scrollTop;skn.top=y+Yoffset;
  if(skn.visibility != "visible") {
   tick = tick + 1;
   if(tick > 2) {
    skn.visibility="visible";
   }
  }
 }
}

function kill(){
if(!old){active=0;tick=0;skn.visibility="hidden";}
}

//-->
</SCRIPT>';
}

# dhtml_wrap, wraps $text in DHTML so that $other pops up on mouseover.
sub dhtml_wrap($$) {
	my ($text, $other) = @_;
	my $html;
	#$text =~ s/(["'\n\r])//g;
	$other =~ s/(["'])//g;
	$other =~ s/([\r\n])+/\n/g;
	$other =~ s/([\n])/<br>/g;
	$html .= "<a ONMOUSEOVER=\"popup('$other','#6699ff')\"; ONMOUSEOUT=\"kill()\">$text</a>\n";
	return $html;
}

# isie, returns 1 if client browser is Internet Exploiter.
sub isie {
	if(CGI::user_agent() =~ /MSIE/) {
		return 1;
	} else {
		return 0;
	}
}

# mime, takes a filename, returns a guess at its mime type.
sub mime($) {
	my $type = shift;
	my $mimetypes = '/etc/mime.types';
	open(MIME,$mimetypes);
	my @mime = readline *MIME;
	close(MIME);
	foreach my $line (@mime) {
		if ($line =~ /[#].*/) {
			$line='';
		}
		if ($line =~ /[\t\n ]$type[\t\n ]/i) {
			my @buffer = split(/[\t ]/,$line);
			return($buffer[0]);
		}
	}
	return('application/octet-steam');
}

sub carrier_encode {
	my @fields = @_;
	my $buffer;
	$buffer = join("\t",@fields);
	$buffer = MIME::Base64::encode($buffer);
	$buffer =~ s/\n//g;
	return $buffer;
}

sub carrier_decode {
	my $buffer = $_[0];
	my @temp = split(//,$buffer);
	my ($i,$j);
	$buffer = '';
	for($i = 0; $i*76 < @temp; ++$i) {
		for($j = 0; $j < 76; ++$j) {
			$buffer .= $temp[$i*80 + $j];
		}
		$buffer .= "\n";
	}
	return split(/\t/,MIME::Base64::decode($buffer));
}

# cut, returns $string to $len long
sub cut($$) {
	my ($len, $string) = @_;
	if(length($string) > $len) {
		my @temp = split(//,$string,($len+1));
		pop(@temp);
		return join('',@temp);
	} else {
		return $string;
	}
}

sub alert($) {
	my $msg = $_[0];
	return 
'
<SCRIPT TYPE="text/javascript">
<!--
alert('.filter($msg).'.);
//-->
</SCRIPT>';
}

sub set_sectoken($$$) {
	my ($dbh, $user, $token) = @_;
	my $query = "UPDATE user SET sectoken='$token' WHERE username='$user'";
	$dbh->query($query);
}

1;
