package Gm_Utils;

###############################################################################
# Greymatter 1.7.2                            
# Copyright (c)2000-2007, The Greymatter team 
# http://greymatterforum.proboards82.com/     
# By possessing this software, you agree not to hold the author responsible for 
# any problems that may arise from your installation or usage of Greymatter 
# itself, or from any content generated by yourself or others through the use of 
# this program.  You <I>may</I> freely modify and redistribute this program, so 
# long as every copyright notice (including in this manual and in the Greymatter 
# code) remains fully intact.  Finally, you may <I>not</I> sell or in any way 
# make a financial profit from this program, either in original or modified form.
# Your possession of this software signifies that you agree to these terms; 
# please delete your copy of this software if you don't agree to these terms.
# Original Creators Noah Grey
###############################################################################

require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw( println ); ## export on request, no pollution

## Gm Storage
# This package groups functions that deal with miscelaneous and various functionality.
# Not all functions have to be exported, but some very very very common ones.
# 
# CONVENTIONS
# 1. Return a string rather than printing, this is just more elegant.  Leave prints
#   to the calling subroutine
# 2. Private subroutines should start with the '_' character.  By private I mean
#   it will never be called outside of this package.
# 3. If you have more than 1 or 2 parameters, especially if they are not required,
#   use named parameters such as in createRadioButton.  By putting stuff in a 
#   hash we gain the flexibility to add more optional parameters without having
#   to pass in '' placeholders or modify existing code.
# 6. Use ' and " where appropriate.  If you don't have any variables or newlines
# then use ', its quicker and cleaner.  
# 7. Don't put all text on one huge long line.  It messes with some programs
# that don't do line wraps. 

use strict;
use warnings;

use Gm_Constants;

use Gm_Trace;

## TODO, make this stuff POD, at least its a standard ...

## Print Line
#  Will print a given line with a newline character at the end.  Handly for 
# changing newline if ever needed.
# ARG1: The line to print 
sub println {
	my (@lines) = @_;  ## this should: || (), but not sure if works?
	my $line = join( "\n", @lines );
	print( $line."\n" );
}


## to Web Safe
#  Will filter a given line and make websafe, for editing in textarea 
# ARG1: The line to filter
# DEPRECATES: delouse
sub toWebSafe {
	my $l = shift(@_);
	# |*| to newline character
	$l =~ s/\|\*\|/\n/g;
	# changing &lg; to |AMP|lg;, why?  Who knows...
	$l =~ s/&([A-Za-z0-9\#]+);/\|AMP\|$1;/g;
	# making < and > websafe
	$l =~ s/</\&lt;/g;
	$l =~ s/>/\&gt;/g;
	# making quote websafe
	$l =~ s/"/\&quot;/g;
	return($l);
}


## to Store Safe
#  Will filter a given line and make storesafe, for editing in textarea 
# ARG1: The line to filter
# DEPRECATES: relouse
sub toStoreSafe {
	my $l = shift(@_);
	# newline character to |*|
	$l =~ s/\n/\|\*\|/g;
	# removeing newline character?
	$l =~ s/\r//g;
	# making websafe < and > to normal
	$l =~ s/\&lt;/</g;
	$l =~ s/\&gt;/>/g;
	# make websafe quote to normal
	$l =~ s/\&quot;/"/g;
	# ???
	$l =~ s/\|AMP\|([A-Za-z0-9\#]+);/&$1;/g;
	return($l);
}


## to Config Safe
#  Will filter a given line and make configsave, for storeing
# ARG1: The line to filter
# TODO: CAN THIS ENHANCE STORE ? AND JUST USE STORESAFE
# DEPRECATES: configdelouse 
sub toConfigSafe {
	my $l = shift(@_);
	# remove pipe?
	$l =~ s/\|//g;
	# remove newline?
	$l =~ s/\n//g;
	# remove carriage return
	$l =~ s/\r//g;
	# remove leading spaces
	$l =~ s/^\s+//;
	# remove trailing spaces
	$l =~ s/\s+$//;
	return($l);
}


## hack Web Test
#  Will test for a hack attempts against web data,
# these are hack attempts against the user
# ARG1: The text to test for iframes and other hackish stuff
# RETURNS: 1 if a hack is detected, 0 otherwise
sub hackWebTest {
	my $text = shift(@_) || '';
	my $ret_val = 0;
	
	# Testing for someone trying to insert <? ...
	if( $text =~ m/<\s*?\?/gi ){
		$ret_val = 1;
	}

	# Testing for someone trying to insert <script
	if( $text =~ m/<\s*?script/gi ){
		$ret_val = 1;
	}

	# Testing for someone trying to insert <%
	if( $text =~ m/<\s*?%/gi ){
		$ret_val = 1;
	}
	
	# Testing for someone trying to insert <iframe
	if( $text =~ m/<\s*?iframe/gi ){
		$ret_val = 1;
	}
	
	return( $ret_val );
}


## hack Command Line test Test
#  Will test for a hack attempts against processes that interact with host machine,
# this are hack attempts to compromise the host box
# ARG1: The text to test for iframes and other hackish stuff
# RETURNS: 1 if a hack is detected, 0 otherwise
sub hackClTest {
	my $text = shift(@_) || '';
	my $ret_val = 0;
	
  ## Null bit test
	if( $text =~ m/\0/gi ){
		$ret_val = 1;
	}
	
  ## tree traversal test
	if( $text =~ m/\.\.\//gi ){
		$ret_val = 1;
	}
	
  ## pipe test
	if( $text =~ m/\|/gi ){
		$ret_val = 1;
	}
	
	return( $ret_val );
}


## get Standard Date
#  Will return a several date values usefull for marking time.
# ARGS 1: server offset ## TODO MAKE SMART AND GET SERVER OFFSET FROM CONFIGS
# $basedate, $wday, $mon, $mday, $JSYear, $hour, $min, $sec, $AMPM
# (08/30/06 09:51 PM, 3, 8, 30, 2006, 9, 51, 28, PM )
# RETURN 1: a standard date string in format mm/dd/yy hh:mm AM|PM
# RETURN 2: the numerical day of the week, Monday = 1, etc.
# RETURN 3: the numerical month, January = 1, etc.
# RETURN 4: the numerical day of the month
# RETURN 5: the full 4 digit year
# RETURN 6: the numerical hour
# RETURN 7: the numerical minute
# RETURN 8: the numerical second
# RETURN 9: the string AM or PM depending on whether its after 12 noon
# TODO MAKE AM and PM	 GM_CONSTANTS
# DEPRECATES: date 
sub getStdDate {
	my $serveroffset = shift();
	my $AMPM = "";
	my $AMPMDOT = "";

	my $adjustTime = time() + ($serveroffset * 3600);
	
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($adjustTime);	
	
	my $fullmonth = (Gm_Constants::MONTHS)[$mon];
	$mon++; # so that its looks right to people
	my $fullweekday = (Gm_Constants::DAYS)[$wday];
	
	my $JSYear = $year + 1900;
	my $shortyear = substr($JSYear, -2, 2);
	
	my $mintwo = toTwoDigit( $min);
	my $sectwo = toTwoDigit( $sec);
	
	my $militaryhour = $hour;
	
	
	if ($hour < 12) {
		$AMPM = "AM";
		$AMPMDOT = "A.M.";
	}
	
	if ($hour > 12) {
		$hour = $hour - 12;
		$AMPM = "PM";
		$AMPMDOT = "P.M.";
		$militaryhour = $militaryhour + 12;
	}
	
	if ($hour == 12) {
		$AMPM = "PM";
		$AMPMDOT = "P.M.";
	}
	
	if ($hour == 0) {
		$hour = "12";
	}
	
	## I think these two variables will take a 1 digit and make it 01
	my $hourtwo = toTwoDigit( $hour);
	my $montwo = toTwoDigit( $mon);
	my $mdaytwo = toTwoDigit( $mday);

	
	if (($hour eq "12") && ($AMPM eq "AM")) { $militaryhour = "0"; }
	
	my $militaryhourtwo = sprintf ("%2d", $hour);
	$militaryhourtwo =~ tr/ /0/;
	
	my $basedate = "$montwo\/$mdaytwo\/$shortyear $hourtwo\:$mintwo $AMPM";

	return( $basedate, $wday, $mon, $mday, $JSYear, $hour, $min, $sec, $AMPM );
}


## Get Days
#  Will return the number of days in a month
# ARG1: a numerical month (1-12)
# ARG2: a 4 digit year
# RETURN1: the max number of days in a month, accounting for leap years
sub getDays {
  my ($mon, $yr) = @_;
	my @days = qw(31 xx 31 30 31 30 31 31 30 31 30 31);

	## TODO: REFACTOR SO THIS RETURNS A 0 IF GIVEN A BAD MONTH
  return $days[$mon - 1] unless $mon == 2;
  return isLeapYear($yr) ? 29 : 28;
}


## Is Leap Year
#  Will return 1 if its a leap year, 0 otherwise
# ARG1: a 4 digit year
# RETURN1: a 1 or 0
sub isLeapYear {
	my $year = shift(@_);
	## TODO: REFACTOR THIS INTO IF ... ELSIF LOGIC
  return 1 unless $year % 400;
  return 0 unless $year % 100;
  return 1 unless $year % 4;
  return 0;
}


## to Two Digit
#  Will turn a 1 digit number into a 2 digit
# ARG1: a number (e.g. 1)
# TODO: make this function not use sprintf
# RETURN1: a number (e.g. 01)
sub toTwoDigit {
	my $digit = shift(@_);
	my $digitTwo = _padDigits( '2d', $digit); ## pading
	
	return( $digitTwo );
}

## to No Decimal
#  Will chop off decimal place
# ARG1: a number (e.g. 17.8)
# TODO: make this function not use sprintf, needs to round then
# RETURN1: a number (e.g. 18)
sub toNoDec {
	my $digit = shift(@_);
	my $digitTwo = _padDigits( '.0f', $digit); ## pading
	
	return( $digitTwo );
}

## to First Dec
#  Will make a first decimal character
# ARG1: a number (e.g. 1)
# TODO: make this function not use sprintf
# RETURN1: a number (e.g. 1.0)
sub toFirstDec {
	my $digit = shift(@_);
warn "$digit";
	my $digitTwo = _padDigits( '.1f', $digit); ## pading
warn "$digitTwo";	
	return( $digitTwo );
}

## to Entry Padded
#  Will turn an entry number into the 8 digit number padded by 0s
# ARG1: a number (e.g. 1)
# TODO: make this function not use sprintf
# RETURN1: a number (e.g. 01)
sub toEntryPadded {
	my $digit = shift(@_);
	my $digitTwo = _padDigits( '8d', $digit); ## pading

	return( $digitTwo );
}

## to Entry Padded
#  Will turn the given number into a string with number padded by 0's
# ARG1: number of places total string should have, including 'd' for digits, 'f' for floats (e.g. '8d')
# ARG1: a number to pad ( e.g. 1)
# TODO: make this function not use sprintf if just padding front with 0's
# RETURN1: a number padded with zeros (e.g. 00000001)
sub _padDigits {
	my $place = shift(@_) || '0';
	my $digit = shift(@_);
	
	my $digitTwo = '0';
	# must not squeel on decimals
	my $onlynumbers = $digit;
	$onlynumbers =~ s/\.//;
	if( $onlynumbers =~ m/\D/gi || !defined( $onlynumbers )){
		## this ain't a digit ...
		### TODO, ERROR OUT BETTER HERE, SOMEONE BEING NAUGHTY?
		# possibly, this could actually be an oversight by the GM code,
		# however, it could also be someone trying to bust sprintf, should
		# make a log entry.
		gmWarn("An internal error has occured \n and the administrators have ".
		"been notified.\n");
		## TODO MAKE UTIL HACKNOTIFY FUNCTION
	} else {
		$digitTwo = sprintf ('%'.$place, $digit); ## pading
		$digitTwo =~ tr/ /0/; ## pad to 0
	}	

	return( $digitTwo );
}


## summarize Message
#  Will truncate a message to the acceptable length for summarizing in cp log
# ARG1: a string to truncate
# RETURN1: a shorter string, note that by using this central method, we can change
#  the length of the summary string in one place.
sub sumMsg {
	my $message = shift(@_);
	$message = substr( $message, 0, 50 );

	return( $message );
}


## to Ordinal
#  Will filter a given line and make 1 to 1st, 2 to 2nd, etc. 
# NOTE doesn't work over 99...
# TODO comment what the hell the regexes are doing
# ARG1: The line to filter
# DEPRECATES: gm_toordinal
sub toOrdinal {
	my $l = shift(@_);
	
	$l =~ s/^([23]?1)$/$1st/;
	$l =~ s/^11$/11th/;      
	$l =~ s/^(2?2)$/$1nd/;   
	$l =~ s/^12$/12th/;      
	$l =~ s/^(2?3)$/$1rd/;   
	$l =~ s/^13$/13th/;      
	$l =~ s/([04-9])$/$1th/; 
	return($l);
} 

## stupidest subroutine ever.  This was created so that gm could use
# die as a default error handler.  This requires being able to make the sub 
# a scalar reference, which perl wouldn't let happen with die, hence a wrapper
## ARG1: Message to give to die
## no returns, just will 'die' the first argument passed...
## TODO: RENAME THIS TO GMDIE, SINCE IT DIES, DOESN'T WARN
sub gmWarn {
	my $err = shift(@_);
	Gm_Trace::Trace(level => 1, msg => "fatal error:$err");
	die $err;
}

1;