package FUNC::STD;
use strict;
#+-----------------------------------------------------------------+
#| Ikonboard v3 by Jarvis Entertainment Group, Inc.
#|
#| No parts of this script can be used outside Ikonboard without prior consent.
#|
#| More information available from <ib-license@jarvisgroup.net>
#| (c)2001 Jarvis Entertainment Group, Inc.
#| 
#| http://www.ikonboard.com
#|
#| Please Read the license for more information
#+-----------------------------------------------------------------+
#
# Standard Ikonboard Routines.
#
#+-----------------------------------------------------------------+


BEGIN {
    require 'Boardinfo.pm' or die "Cannot load Module: $!";
    require 'Default/Universal.pm' or die $!;
}

use Time::localtime;
my $INFO = Boardinfo->new();


sub new {
    my $pkg = shift;
    my $obj = {};
    bless $obj, $pkg;
    $Universal::lang = $obj->LoadLanguage('UniversalWords');
    return $obj;
}

############################################################
# build_pagelinks:
# Simply returns a string containing the HTML code for the
# page links
############################################################
sub build_pagelinks {
    my $obj = shift;
    my %IN  = ( TOTAL_POSS  => "",
                PER_PAGE    => "",
                CUR_ST_VAL  => "",
                L_SINGLE    => "",
                L_MULTI     => "",
                BASE_URL    => "",
                @_,
              );

    my $work = {};

    $work->{pages}        = $obj->ib_int( $IN{TOTAL_POSS}, $IN{PER_PAGE});
    $work->{total_page}   = $work->{pages};
    $work->{current_page} = $IN{CUR_ST_VAL} > 0 ? ($IN{CUR_ST_VAL} / $IN{PER_PAGE}) + 1 : 1;

    if ($work->{pages} > 1) {
        $work->{first_page} = qq[$IN{L_MULTI} ($work->{pages}) <a href='$IN{BASE_URL};st=0'>&lt;</a>];
        my $i = 0;
        for(0 .. $work->{pages}-1) {
            my $RealNo = $i * $IN{PER_PAGE};
            my $PageNo = $i+1;
            if ($RealNo == $IN{CUR_ST_VAL}) {
                $work->{page_span} .= qq!&nbsp;<b>[$PageNo]</b>!;
            } else {
                if ($PageNo < ($work->{current_page} - 5) and ($work->{current_page} >= 6))  {
                    $work->{st_dots} = '&nbsp;...';
                    ++$i;
                    next;
                }
                $work->{page_span} .= qq[&nbsp;<a href='$IN{BASE_URL};st=$RealNo'>$PageNo</a>];
                if ($PageNo == ($work->{current_page} + 5)) {
                    $work->{end_dots} = '...&nbsp;';
                    last;
                }
            }
            ++$i;
        }
        $work->{last_page} = qq[<a href='$IN{BASE_URL};st=].($work->{pages}-1) * $IN{PER_PAGE}.qq['>&gt;</a>];
        $work->{return}    = $work->{first_page}.$work->{st_dots}.$work->{page_span}.'&nbsp;'.$work->{end_dots}.$work->{last_page};
    } else {
        $work->{return}    = $IN{L_SINGLE};
    }

    return $work->{return};

}

############################################################
# LoadSkin:
# Returns a hash ref based on the users chosen skin
# This info is taken from either an "sid" value in the URL
# or a set cookie. Maps the "sid" to the specified real directory
#Êname stored in boardinfo.pm
############################################################
sub LoadSkin {
    my $obj = shift;

    my $sid = $iB::IN{'sid'} || $iB::COOKIES->{$iB::INFO->{'COOKIE_ID'}.'skin'};
    # Make sure it only contains a number
    $sid =~ s/^(\d+)$/$1/;

    # Make sure we have a default skin set

    my $Skin = $INFO->{'DEFAULT_SKIN'} || 'Default';

    # Rule #1: Are we accessing the admin CP?
    #          Load the default skin, and proceed

    if ($iB::IN{AD}) {
        $Skin = $INFO->{'DEFAULT_SKIN'};
        goto 'LOADSKIN';
    }

    # Rule #2: Are we in a forum, and does that forum have
    #          a skin set?

    if ( ($iB::IN{act} ne 'UserCP') and ($iB::IN{'f'}) ) {
        # Do we have any forum skins set?
        if ($INFO->{'FORUM_SKINS'}) {
            # Do we have a skin?
            $INFO->{'FORUM_SKINS'} =~ m/(^|\|\&\|)$iB::IN{f}\:(\S+?)\|\&\|/;
            if ($2) {
                $Skin = $2;
                goto 'LOADSKIN';
            }
        }
    }

    # Rule #3: Have we enabled skins?
    #          If so, is it different from the default?
    #            If so, grab it!


    if ( ($sid) and ($INFO->{ALLOW_SKINS}) ) {
        for ( split( /\|\&\|/, $INFO->{'SKINS'} ) ) {
            my ($id, $dir, $name) = split/\:/, $_;
            if ($id == $sid) {
                $Skin = $dir;
                last;
            }
        }
    }

LOADSKIN:

    # Fail safe
    unless ($Skin) {
        $Skin = 'Default';
    }

    # Check the skin to make sure it exists
    # If all else fails, use the Default skin iB ships with

    unless (-e $INFO->{IKON_DIR}."Skin/$Skin/Styles.pm") {
        $Skin = 'Default';
    }

    # Load the colours:
    {
        local $@, $SIG{__DIE__};
        eval 'do "$INFO->{IKON_DIR}'.'Skin/$Skin/Styles.pm";';
        if ($@) {
            iB::catch_die("Cannot find skin '$Skin' - contact the board admin for further help ($@)");
        }
    }
    my $Return = Styles::new("Styles");
    # Do a little set up
    $Return->{'DIR'} = $Skin;
    $Return->{'FULL_DIR'}   = 'Skin/' . $Return->{'DIR'};
    $Return->{'IMAGES_URL'} = $INFO->{'IMAGES_URL'} .'/'.$Return->{'FULL_DIR'};
    return $Return;
 
}

############################################################
# LoadLanguage:
# Simply loads the required language file from disk, based on
# the users language choice
############################################################
sub LoadLanguage {
    my ($obj, $area) = @_;
    my ($lang, $default);
    local $@;

    # Make sure the cookie data is legal
    if ($iB::COOKIES->{$iB::INFO->{'COOKIE_ID'}.'lang'}) {
        $iB::COOKIES->{$iB::INFO->{'COOKIE_ID'}.'lang'} =~ s/^([\d\w]+)$/$1/;
    }

    $default = $iB::COOKIES->{$iB::INFO->{'COOKIE_ID'}.'lang'}
            || $iB::INFO->{'DEFAULT_LANGUAGE'}
            || 'en';

    # Quick check to make sure the directory exists

    unless (-d $iB::INFO->{IKON_DIR}."Languages/$default") {
        $default = 'en';
    }

    my $code = 'require '. "\"$default/" .$area. '.pm"; $lang ='. $area. '->new();';
    eval $code;
    
    $obj->cgi_error("Could not access the language file: $@") if $@;
    return $lang;
}


############################################################
# htmlcut:
# This routine written by "Infection"
# Returns a string, chopped to size as specified
# by the script. Will not chop through HTML
# characters, such as &quote;, etc
############################################################
sub htmlcut {
    my $obj = shift; # Shift off the package

    my @chars = split(//,$_[0]); # all chars
    my $c_tokens = $_[1];        # counter of tokens
    my $c_result = $_[2];        # counter of result
    my $len = scalar(@chars);
    my $i = 0;                   # array counter
    my $result;                  # result string
  
    OUTERLOOP:
    while( ($i < $len) && $c_tokens && ($c_result > 0) ){ 
          if ($chars[$i] eq '&'){  # parse token &...;  
              my $esc_str;
              while($chars[$i] ne ';'){
                  last OUTERLOOP unless($c_result && ($i<$len));  # token rejected
                  $esc_str .= $chars[$i];
                  $i++;
                  $c_result--;
            }
            last OUTERLOOP unless($c_result && ($i < $len));   # token rejected 
            $result .= $esc_str;	
          }
          $result .= $chars[$i];
          $i++;
          $c_result--;
          $c_tokens--;
      }
  $_[0] = $result;        
  return $_[0]; #($i < $len);  
}

############################################################
# build_forumjump:
# Does what it says on the tin :D
# Creates /Data/forumjump.pm based on the forum/cat data in the DB
############################################################
sub build_forumjump {
    my $obj = shift;
    my %IN  = ( DB     => "",
                CATS   => "",
                FORUMS => "",
                @_,
              );

    return unless $IN{'DB'} and $IN{'CATS'} and $IN{'FORUMS'};

    require 'Lib/ADMIN.pm';
    my $admin = FUNC::ADMIN->new();

    my $data = {};
    my $i = 0;    

    #Key Name: number
    #Key Data: [ 'CAT || F',  'ID', 'NAME', 'VIEW' ];

    for my $this_cat (@{ $IN{'CATS'} }) {
        $this_cat->{CAT_NAME} =~ s/\@/&#064;/g;
        $this_cat->{CAT_NAME} =~ s/\"/&quot;/g;
        $data->{ $i } = [ 'c', $this_cat->{'CAT_ID'}, $this_cat->{'CAT_NAME'}, $this_cat->{'VIEW'} ];
        $i++;
        #Get the forums for this category
        my @these_cat_forums = grep { $_->{'CATEGORY'} == $this_cat->{'CAT_ID'} } @{ $IN{'FORUMS'} };

        for my $f (@these_cat_forums) {
            $f->{FORUM_NAME} =~ s/\@/&#064;/g;
            $f->{FORUM_NAME} =~ s/\"/&quot;/g;
            $data->{ $i } = [ 'f', $f->{'FORUM_ID'}, $f->{'FORUM_NAME'}, $f->{'FORUM_VIEW_THREADS'} ];
            $i++;
        }
    }

    $admin->make_module( FILE     => 'ForumJump.pm',
                         PKG_NAME => 'ForumJump',
                         VALUES   => $data
                       );

    return 1;
}

##########################################
# Stat file routines
##########################################
sub ib_stats {
    my ($obj, $values) = @_;
    return $values ? $obj->_update_stats($values) : $obj->_load_stats;
    
}

sub _update_stats {
    my ($obj, $values) = @_;
    # If we are resetting, there is no need to reload.
    $obj->_save_stats($values) if $values->{'RESET'};

    my $s = $obj->_load_stats;
    
    # Figure out what we're doing
    for my $w (qw!TOTAL_REPLIES TOTAL_TOPICS TOTAL_MEMBERS!) {
        next unless $values->{$w};
        # An arg of '+3' is passed to one of
        # MEMBERS, POSTS, TOPICS (example!)
        $values->{$w} =~ m!^(\+|-)(\S+)$!;
        # Add, or subtract the value of $2
		$s->{$w} = $1 eq '+' ? $s->{$w} + $2 : $s->{$w} - $2;
        # Ensure they go no lower than 0
        $s->{$w} = 0 if $s->{$w} < 0;
    }
    
    $s->{'LAST_REG_MEMBER_ID'} = $values->{'LAST_REG_MEMBER_ID'} if $values->{'LAST_REG_MEMBER_ID'};
    $s->{'LAST_REG_MEMBER_N'}  = $values->{'LAST_REG_MEMBER_N'}  if $values->{'LAST_REG_MEMBER_N'};
    $s->{'M_ONLINE_COUNT'}     = $values->{'M_ONLINE_COUNT'}     if $values->{'M_ONLINE_COUNT'};
    $s->{'M_ONLINE_DATE'}      = $values->{'M_ONLINE_DATE'}      if $values->{'M_ONLINE_DATE'};

    $obj->_save_stats($s);
    return '0 but true';
}


sub _save_stats {
    my ($obj, $values) = @_;

    open STATS, ">".$iB::INFO->{'IKON_DIR'}.'Data/Stats.pm' or die "cannot open stats file ($!)";
    print STATS "package Stats;\n".
                "sub new {\n".
                "  my \$pkg = shift;\n".
                "  my \$obj = {\n".
                "    TOTAL_REPLIES      => '$values->{'TOTAL_REPLIES'}',     \n".
                "    TOTAL_TOPICS       => '$values->{'TOTAL_TOPICS'}',      \n".
                "    TOTAL_MEMBERS      => '$values->{'TOTAL_MEMBERS'}',     \n".
                "    LAST_REG_MEMBER_ID => '$values->{'LAST_REG_MEMBER_ID'}',\n".
                "    LAST_REG_MEMBER_N  => '$values->{'LAST_REG_MEMBER_N'}', \n".
                "    M_ONLINE_COUNT     => '$values->{'M_ONLINE_COUNT'}', \n".
                "    M_ONLINE_DATE      => '$values->{'M_ONLINE_DATE'}', \n".
                "  };".
                "  bless \$obj, \$pkg;\n".
                "  return \$obj;\n".
                "}\n".
                "1;\n";
    close STATS;
}


sub _load_stats {
    my $obj = shift;
    return {} unless (-e $iB::INFO->{'IKON_DIR'}.'Data/Stats.pm');
    return {} unless (-s $iB::INFO->{'IKON_DIR'}.'Data/Stats.pm' > 0);
    do $iB::INFO->{'IKON_DIR'}.'Data/Stats.pm';
    my $s = Stats->new();
    return $s;
}


############################################################
# cgi_error:
# DEPRECIATED - simply calls iB::catch_die()
############################################################
sub cgi_error {
    my ($obj, $error) = @_;
    # Left for backwards compatibility
    return unless $error;
    &iB::catch_die($error);
    
}

############################################################
# ValidateEntry
# Checks for a valid HTTP_REFERER if the header contains post
# data, also checks the server load
############################################################
sub ValidateEntry {
    my ($obj, $db) = @_;

    # Check for a valid referrer

    if (lc($ENV{'REQUEST_METHOD'}) eq 'post' and $ENV{'HTTP_REFERER'} and $iB::IN{act} eq 'Post') {
        my $b_url = $INFO->{'BOARD_URL'};
        $b_url =~ s!http://!!i;
        $obj->Error(DB => $db, STD => $obj, LEVEL=>'5',MESSAGE=>'referrer_fail') unless $ENV{'HTTP_REFERER'} =~ m!$b_url!i;
    }

    #Are we checking load averages?
    return if $^O =~ /Win/i;
    open LOAD, '/proc/loadavg' or return;
    $iB::CONTENT->{'LOAD'} = substr(<LOAD>, 0, 5);
    close LOAD;

    #Remove whitespace

    $iB::CONTENT->{'LOAD'} = $obj->_trim($iB::CONTENT->{'LOAD'});
    
    if ($iB::INFO->{'LOAD_LIMIT'}) {
        if ($iB::CONTENT->{'LOAD'} > $iB::INFO->{'LOAD_LIMIT'}) {
            $iB::SKIN   = $obj->LoadSkin();
            $iB::INFO->{'IMAGES_URL'} .= '/' . $iB::SKIN->{'FULL_DIR'};
            $obj->Error( DB => $db, STD => $obj, LEVEL => 1, MESSAGE => 'server_too_busy');
        }
    }
}

############################################################
# unHTML:
# DEPRECIATED: Simply calls CleanValue
############################################################
sub unHTML {
    my ($obj, $Tmp) = @_;
    return $obj->CleanValue($Tmp);
}

############################################################
# doHTML:
# Converts unHTML'd elements in a string to proper HTML code
############################################################
sub doHTML {
    my $obj = shift;
    my $Tmp = $_[0];
    $Tmp =~ s/&#39;/'/g;    $Tmp =~ s/\&lt;/</g;     $Tmp =~ s/\&gt;/>/g;
    $Tmp =~ s!&#36!\$!g;    $Tmp =~ s/&#124;/\|/g;   $Tmp =~ s/&#43;/\+/g;
    $Tmp =~ s/&#42;/\*/g;   $Tmp =~ s/&#41;/\)/g;    $Tmp =~ s/&#40;/\(/g;
    $Tmp =~ s/&#44;/,/g;    $Tmp =~ s/&#125;/\}/g;   $Tmp =~ s/&#123;/\{/g;
    $Tmp =~ s/&#92;/\\/g;   $Tmp =~ s/&quot;/"/g;    $Tmp =~ s/&amp;/&/g;
    return $Tmp;
}

############################################################
# TextTidy
# Takes a string and formats it nicely
############################################################
sub TextTidy {
    my $obj = shift;
    my $Tmp = $_[0];
    $Tmp =~ s!  ! &nbsp;!g;  $Tmp =~ s!\t!&nbsp;&nbsp;!g; $Tmp =~ s!\\n!&#92;n!g;
    $Tmp =~ s!\r!\n!g;       $Tmp =~ s!\n\n!\n!g;
    return $obj->doHTML($Tmp);
}

############################################################
# CleanKey
# DEPRECIATED
############################################################
sub CleanKey {
    my ($obj, $key) = @_;
    return unless defined $key;
    $key =~ s!\0!!g;
    $key =~ s!\.\.!!g;
    $key =~ s!\_\_(.+?)\_\_!!g;
    $obj->_trim($key);
    $key =~ m!^([\w\.-]+)$!;
    return $1;
}

############################################################
# CleanValue:
# DEPRECIATED
############################################################
sub CleanValue {
    my ($obj, $Tmp) = @_;
    $Tmp =~ s!\0!!g;
    $Tmp =~ s|&|&amp;|g;
    $Tmp =~ s|<!--|&#60;&#33;--|g; $Tmp =~ s|-->|--&#62;|g;
    $Tmp =~ s|<script|&#60;script|ig;
    $Tmp =~ s|>|&gt;|g;
    $Tmp =~ s|<|&lt;|g;
    $Tmp =~ s|"|&quot;|g;
    $Tmp =~ s|  | &nbsp;|g;
    $Tmp =~ s!\|!&#124;!g;
    $Tmp =~ s|\n|<br>|g;
    $Tmp =~ s|\$|&#36;|g;
    $Tmp =~ s|\r||g;
    $Tmp =~ s|\_\_(.+?)\_\_||g;
    $Tmp =~ s|\\|&#92;|g;
    $Tmp =~ s|\'|&#39;|g;
    $Tmp =~ s|!|&#33;|g;
    return $Tmp;
}

############################################################
# IsNumber
# duuh!
############################################################
sub IsNumber {
    my ($obj, $num) = @_;
    return unless defined $num;
    $num =~ s!\.\.!!g;
    $num =~ m!^(\d+)$!;    
    return $1;
}

############################################################
# IsWord
# Duuuh....
############################################################
sub IsWord {
    my ($obj, $word) = @_;
    return unless defined $word;
    $word =~ s!\0!!g;
    $word =~ s!\.\.!!g;
    $word =~ m!^(\w+)$!;
    return $1;   
}

############################################################
# CheckCodeNo:
# Makes sure the GET_DATA element "CODE" is a two digit numerical
# value, if not - get's annoyed
############################################################
sub CheckCodeNo {
    my $obj = shift;
    return unless defined $_[0];
    my $Return = $obj->IsNumber($_[0]);
    $obj->Error(LEVEL=>'5',MESSAGE=>'Incorrect Ikonboard action code number') if length($Return) != 2;
    return $Return;
}

############################################################
# CheckEmail:
# Basic check to ensure an email address is in a recognised
# format
############################################################
sub CheckEmail {
    my ($obj, $Email) = @_;
    $Email =~ s![\n\r\*\'\"<>&\%\!\(\)\{\}\[\]\?\\/]!!isg;
    $Email = $obj->unHTML($Email);
    return $Email =~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,4}|[0-9]{1,4})(\]?)$/ ?  1 :  0;
}

############################################################
# _trim
# Removes leading and trailing whitespace from a string
# or array passed to it
############################################################
sub _trim {
  my $obj = shift;
  my @tr = @_;
  return unless @_;
  for (@tr) { s!^\s+!!; s!\s+$!!; }
  return wantarray ? @tr : $tr[0];
}

############################################################
# GetDate:
# DEPRECIATED
############################################################
sub GetDate {}

############################################################
# get_date:
# Takes a UNIX timestamp and converts it into a human readable
# date string, based on the admins date format
# also takes into account server and user time offsets
############################################################
sub get_date {
    my $obj = shift;

    my %IN = ( TIME => "", METHOD => "", @_,);

    return '--' unless $IN{'TIME'} > 0;

    $IN{'TIME'}= $IN{'TIME'} + ($INFO->{'TIME_ZONE'} * 3600) + ($iB::MEMBER->{'TIME_ADJUST'} * 3600);
    my $tm = localtime($IN{'TIME'});
    my $r_time;

    my %Return;
    $Return{'YEAR'}          = $tm->year+1900;
    $Return{'MONTH_NUMBER'}  = $tm->mon+1;
    $Return{'MONTH_NAME'}    = $Universal::lang->{'M_'.$Return{'MONTH_NUMBER'}};
    $Return{'DATE_NUMBER'}   = $tm->mday;
    $Return{'DAY_NAME'}      = $Universal::lang->{'D_'.$tm->wday};
    $Return{'HOUR'}          = $tm->hour;
    $Return{'MIN'}           = $tm->min;
    $Return{'MIN'}           = "0$Return{'MIN'}"          if length($Return{'MIN'})   == 1;
    $Return{'HOUR'}          = "0$Return{'HOUR'}"         if length($Return{'HOUR'})  == 1;
    $Return{'DATE_NUMBER'}   = "0$Return{'DATE_NUMBER'}" if length($Return{'DATE_NUMBER'}) == 1;

    #AM/PM SUFFIX bug fix by Freakboy

    if ($iB::INFO->{'CLOCK_TYPE'} eq '12h') { 
        if ($Return{'HOUR'} > 11) { 
            $Return{'SUFFIX'} = 'pm'; 
            if ($Return{'HOUR'} > 12) { 
                $Return{'HOUR'} -= 12; 
            } else { 
                $Return{'HOUR'} = 12; 
            } 
        } else { 
            $Return{'SUFFIX'} = 'am'; 
            if ($Return{'HOUR'} == 0) { 
                $Return{'HOUR'} = 12; 
            } 
        } 
    }

    my ($joined, $short, $long) = split /\|&\|/, $iB::INFO->{'CLOCK_STYLE'};

    $r_time = $joined if $IN{'METHOD'} eq 'JOINED';
    $r_time = $short  if $IN{'METHOD'} eq 'SHORT';
    $r_time = $long   if $IN{'METHOD'} eq 'LONG';

    for (keys %Return) {
        $r_time =~ s!$_!$Return{$_}!;
    }

    return $r_time;
}
        

############################################################
# Error:
# You need an explanation?
############################################################      
sub Error {
    my $obj = shift;
    my %IN  = ( DB       => "",
                LEVEL    => "",
                MESSAGE  => "",
                EXTRA    => "",
                @_,
              );

    $iBoard::lang = $obj->LoadLanguage('ErrorWords');

    $iBoard::lang->{'log_in_msg'} = $iB::MEMBER->{'MEMBER_ID'} ? $iBoard::lang->{'log_in_yes'} . $iB::MEMBER->{'MEMBER_NAME'}
                                                               : $iBoard::lang->{'log_in_no'};

    if ($IN{'EXTRA'}) {
        $iBoard::lang->{ $IN{'MESSAGE'} } =~ s!<#VAR#>!$IN{'EXTRA'}!g;
    }

    my $print = Universal::Error( $iBoard::lang->{ $IN{'MESSAGE'} } );

    my $output = FUNC::Output->new()->print_ikonboard( DB         => $IN{'DB'},
                                                       STD        => $obj,
                                                       TITLE      => $iBoard::lang->{'error_title'},
                                                       JAVASCRIPT => 1,
                                                       OUTPUT     => $print,
                                                       OVERRIDE   => 1
                                                     );
    iB::exit();

}

  
############################################################
# MaintenanceMode:
# DEPRECIATED:
############################################################
sub MaintenanceMode { }


############################################################
# ForumJump:
#ÊLoads /Data/ForumJump.pm and assembles the HTML for the 
# forum jump form element
############################################################
sub ForumJump ($) {
    my $obj = shift;
    my $html = qq[ <form action='$INFO->{'BOARD_URL'}/ikonboard.$INFO->{'CGI_EXT'}' method='post' name='jump'>
                   <select name='jump' onchange="jumpMenu('self',this,0)" class='forminput'>
                   <option value="$INFO->{'BOARD_URL'}/ikonboard.$INFO->{'CGI_EXT'}">#Forum Jump#
                   <option value="$INFO->{'BOARD_URL'}/ikonboard.$INFO->{'CGI_EXT'}">-----------
                 ];

    return unless (-e $iB::INFO->{'IKON_DIR'}.'Data/ForumJump.pm');
    
    require $iB::INFO->{'IKON_DIR'}.'Data/ForumJump.pm';
    my $Forums = ForumJump->new();

    for (sort { $a <=> $b } keys %{$Forums}) {
        if ($Forums->{$_}[0] eq 'c') {
            if ($Forums->{$_}[3] ne '*') {
                next unless grep { $_ == $iB::MEMBER->{'MEMBER_GROUP'} } (split (/,/, $Forums->{$_}[3]) );
            }
            my $dash = '-' x length($Forums->{$_}[2]);
            $html .= qq[<option value="$INFO->{'BOARD_URL'}/ikonboard.$INFO->{'CGI_EXT'}?s=$iB::SESSION">&nbsp;\n
                        <option value="$INFO->{'BOARD_URL'}/ikonboard.$INFO->{'CGI_EXT'}?s=$iB::SESSION&act=SC;c=$Forums->{$_}[1]">&gt;$Forums->{$_}[2]\n
                        <option value="$INFO->{'BOARD_URL'}/ikonboard.$INFO->{'CGI_EXT'}?s=$iB::SESSION">&nbsp;&nbsp;$dash\n
                       ];
        } elsif ($Forums->{$_}[0] eq 'f') {
            if ($Forums->{$_}[3] ne '*') {
                next unless grep { $_ == $iB::MEMBER->{'MEMBER_GROUP'} } (split (/,/, $Forums->{$_}[3]) );
            }
            $html .= qq[<option value="$INFO->{'BOARD_URL'}/ikonboard.$INFO->{'CGI_EXT'}?s=$iB::SESSION&act=SF;f=$Forums->{$_}[1]">&nbsp;&nbsp;&nbsp;+- $Forums->{$_}[2]\n];
        }
    }
    return $html .= qq[</select></form>\n];
}

############################################################
# ib_int
# Shortcut to convert a decimal placed number into an integer
############################################################
sub ib_int {
  my ($obj, $x, $y) = @_;

  return unless ($x and $y);

  if (($x % $y) == 0) {
    return $x / $y;
  } else {
    return int (($x / $y) + 1);
  }
}


#+---------------------------------------------------------------------------------------------------------------------
#+---------------------------------------------------------------------------------------------------------------------
# OUTPUT MODULE

package FUNC::Output;
use strict;


sub new {
    my $pkg = shift;
    my $obj = {};
    bless $obj, $pkg;
    return $obj;
}


sub print_popup {
    my $obj = shift;
    my $IN = {  
                "STD"           => "",
                "OUTPUT"        => "",
                "TITLE"         => "",
                @_
              };

    $obj->_print_http_header;

    print qq~
    <html>
    <head>
        <title>$IN->{'TITLE'}</title>
        <link type="text/css" href="$iB::INFO->{'IMAGES_URL'}/ikonboard.css" rel="stylesheet">
        <!-- Output Generated by Ikonboard &copy; 2001 Jarvis Entertainment Group -->
    </head>
    <body topmargin='0' leftmargin='0' rightmargin='0' marginwidth='0' marginheight='0'  alink='#000000' vlink='#000000'>

    <!-- Begin Pooled Output -->

    $IN->{'OUTPUT'}

    <!-- End Pooled Ouput -->
    </body>
    </html>
    ~;

    return 1;
}


sub board_offline {
    my $obj = shift;
    my $IN = {  
                "DB"            => "",
                "STD"           => "",
                @_,
             };

    $obj->_print_http_header;
    print Universal::Offline($iB::INFO->{'OFFLINE_MESSAGE'});
}



sub print_ikonboard {
    my $obj = shift;
    my $IN = {  
                "DB"            => "",
                "STD"           => "",
                "OUTPUT"        => "",
                "SPELLCHECKER"  => "",
                "JAVASCRIPT"    => "",
                "TITLE"         => "",
                "NAV"           => undef,
                "NAV_ONE"       => "",
                "NAV_TWO"       => "",
                "OVERRIDE"      => "",
                @_
              };

    require Benchmark;
    $iB::TT1 = new Benchmark;
    my ($td, @b_time, $queries, $stats);

    #------------------------------------
    # Format the Javascript
    #------------------------------------
    my $ikonboard_js;
    if ($IN->{'JAVASCRIPT'}) {
        open JAVASCRIPT, $iB::INFO->{'HTML_DIR'}."Skin/$iB::SKIN->{'DIR'}/ikonboard.js";
        my @JS = <JAVASCRIPT>;
        close JAVASCRIPT;
        $ikonboard_js  = "<script language='javascript'>\n<!--\n";
        $ikonboard_js .= join "\t\t", @JS;
        $ikonboard_js .= "\n//-->\n</script>\n";
    }

    #------------------------------------
    # Format the CSS
    #------------------------------------
    my $css_info;
    {
        local $/ = undef;
        open CSSINFO, $iB::INFO->{'HTML_DIR'}."Skin/$iB::SKIN->{'DIR'}/ikonboard.css";
        $css_info = <CSSINFO>;
        close CSSINFO;
    }
    $css_info  =~ s!<#SKIN_DIR#>!$iB::INFO->{'IMAGES_URL'}!ig;
    $css_info  = "<style type='text/css'>\n<!--\n$css_info\n//-->\n</style>";

    #------------------------------------
    # Format the board copyright
    #------------------------------------
    my $BCopy = $iB::INFO->{'COPYRIGHT_INFO'} ? qq!&copy; $iB::INFO->{'COPYRIGHT_INFO'}! : "";
    #------------------------------------
    # Format the Board statistics
    #------------------------------------
    $iB::CONTENT->{'LOAD'} ||= '--';
    $td         = Benchmark::timediff($iB::TT1,  $iB::TT0);
    $td         = Benchmark::timestr($td);
    $td         =~ /(\d+)\s*wallclock secs \(\s*?(\d*?\.\d*?)\s*usr\s*\+\s*(\d*?\.\d*?)\s*sys/i;
    $b_time[0]  = $1;
    $b_time[1]  = $2;
    $b_time[2]  = $3;
    $b_time[5]  = time;
    $queries    = $IN->{'DB'}->query_count || '--';
    $stats      = $iB::MEMBER->{'MEMBER_GROUP'} == $iB::INFO->{'SUPAD_GROUP'} 
     ? qq~<br>
            <table width='300' align='center' cellspacing='0' cellpadding='0'>
               <tr>
                 <td colspan='2' align='center' bgcolor='$iB::SKIN->{MISCBACK_TITLE}'><b>Admin stats</b></td>
               </tr>
               <tr>
                <td width='60%' bgcolor='$iB::SKIN->{MISCBACK_ONE}'>Execution Time</td>
                <td bgcolor='$iB::SKIN->{MISCBACK_ONE}'>@{[$b_time[0] < 1 ? 'Less than 1 sec.' : $b_time[0].' second(s)' ]}</td>
               </tr>
               <tr>
                <td width='60%' bgcolor='$iB::SKIN->{MISCBACK_TWO}'>CPU Time:</td>
                <td bgcolor='$iB::SKIN->{MISCBACK_TWO}'>$b_time[1]</td>
               </tr>
               <tr>
                <td width='60%' bgcolor='$iB::SKIN->{MISCBACK_ONE}'>No. Queries</td>
                <td bgcolor='$iB::SKIN->{MISCBACK_ONE}'>$queries</td>
               </tr>
               <tr>
                <td width='60%' bgcolor='$iB::SKIN->{MISCBACK_TWO}'>Mod Perl?</td>
                <td bgcolor='$iB::SKIN->{MISCBACK_TWO}'>@{[ $ENV{MOD_PERL} ? 'Yes' : 'No' ]}</td>
               </tr>
               <tr>
                <td width='60%' bgcolor='$iB::SKIN->{MISCBACK_ONE}'>Server load</td>
                <td bgcolor='$iB::SKIN->{MISCBACK_ONE}'>@{[ $iB::CONTENT->{'LOAD'} ? $iB::CONTENT->{'LOAD'} : '--']}</td>
               </tr>
               <tr>
                <td width='60%' bgcolor='$iB::SKIN->{MISCBACK_ONE}'>Current UNIX time</td>
                <td bgcolor='$iB::SKIN->{MISCBACK_ONE}'>$b_time[5]</td>
               </tr>
            </table>~
     : '';

    my $ib_copy = qq~<!-- iB Copyright Information -->\n\n<p><table width='80%' align='center' cellpadding='3' cellspacing='0'><tr><td align='center' valign='middle' id='copyright'>$BCopy<br>Powered by <a href="http://www.ikonboard.com" class="copyright" target='_blank'>Ikonboard</a> $iB::VERSION &copy; 2001 <a href='http://www.ikonboard.com' target='_blank'>Ikonboard</a></td></tr></table><p>~;

    #------------------------------------
    # Get the template from the DB
    #------------------------------------
    my $name = 'global';
    if ($iB::INFO->{'SKIN_TEMPLATES'} =~ /$iB::SKIN->{'DIR'}\:(.+?)\|\&\|/) {
        $name = $1;
    }
    my $template = $IN->{'DB'}->select( TABLE => 'templates', KEY   => $name );
    # Fail safe (incase our assinged skin board template has been deleted..)
    unless ($template->{'TEMPLATE'}) {
        $template = $IN->{'DB'}->select( TABLE => 'templates',  KEY   => 'global' ); 
    }

    #------------------------------------
    # Start to output...
    #------------------------------------
    my $it = $iB::INFO->{'DOC_TYPE'} || qq~<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">\n~;

    $it .= $template->{'TEMPLATE'};

    $iB::APPEND_SEARCH = $iB::IN{'f'} ? "f=$iB::IN{'f'}" : '';

    $it =~ s!<% TITLE %>!$IN->{'TITLE'}!i;
    $it =~ s!<% GENERATOR %>!<meta name="GENERATOR" content="Ikonboard $iB::VERSION">\n\t\t<META HTTP-EQUIV="Pragma" CONTENT="no-cache">!i;
    $it =~ s!<% IB CSS %>!$css_info!i;
    $it =~ s!<% IB JAVASCRIPT %>!$ikonboard_js!is;

    #Template Tags
    
    if ($iB::INFO->{'TEMPLATE_TAGS'}) {
        # Addition by: Eduin Yesid Carrillo (yecarrillo@scoutsace.org)
        # Adapted by Matt
        # Supported styles:
        # <!--#include file="C:/winpath/mypath/myfile.html"-->
        # <!--#include virtual="/mypath/myfile.html" -->
        # <!--#include virtual="/mypath/perlcgi.pl" --> (For cgi files)
        # <? virtual ("/mypath/myfile.html"); ?>
        # <? virtual ("/mypath/perlcgi.pl"); ?> (For cgi files)
        # <% virtual ("/mypath/myfile.html"); %>
        # <% virtual ("/mypath/perlcgi.pl"); %> (For cgi files)
        # <!--#exec cgi="/mypath/perlcgi.pl"--> (For cgi files)

        $it =~ s!<\!--\#include\s*(file|virtual)\s*=\s*['"](\S+?)(\.pl|\.cgi|\.php|\.php3|\.asp)["']\s{0,}-->!$obj->_get_ssi( MTD => $1, FILE => $2, EXT => $3 )!eig;
        $it =~ s!<[\?%]\s*virtual\s*?\(\s*['"](\S+?)(\.pl|\.cgi|\.php|\.php3|\.asp)*["']\s*\);\s*[\?%]>!$obj->_get_ssi( MTD => 'virtual', FILE => $1, EXT => $2 )!eig;
        $it =~ s!<\!--\#exec\s*cgi\s*=\s*['"](\S+?)(\.pl|\.cgi|\.php|\.php3|\.asp)*["']\s*-->!$obj->_get_ssi( MTD => 'virtual', FILE => $1, EXT => $2 )!eig;
    }


    $it =~ s!<% IKONBOARD %>!$IN->{'OUTPUT'}!i;

    # This allows us to use global tags in the skin files
    # NOTE: A member cannot post these tags, they are made safe
    #       in posts, even if HTML is turned on in a forum

    my $time = {};
    $time->{last}    = FUNC::STD::get_date( {}, TIME => $iB::last_visit   , METHOD => "LONG" );
    $time->{current} = FUNC::STD::get_date( {}, TIME => $iB::last_activity, METHOD => "LONG" );       
    $it =~ s!<% NAVIGATION %>!$obj->navigation($IN)!ieg;
    $it =~ s!<% BOARD HEADER %>!Universal::BoardHeader($time)!ieg;
    $it =~ s!<% COPYRIGHT %>!$ib_copy!ig;
    $it =~ s!<% STATS %>!$stats!ig;

    unless ($IN->{'OVERRIDE'}) {
        $it =~ s!<% MEMBER BAR %>!$obj->member_bar($IN->{'DB'})!ieg;
    } else {
        $it =~ s!<% MEMBER BAR %>!!ig;
    }

    $obj->_print_http_header;

    # So, after many modules, routines, checks, regex's and other magic,
    # all it takes is two words to make ikonboard appear....

    print $it;
    undef $it;



    # ... talk about an anti-climax.
    iB::exit();
}


sub _get_ssi {
    my $obj = shift;
    local $SIG{__DIE__} = undef;
    my %IN = (
               MTD  => "",
               FILE => "",
               EXT  => "",
               @_,
             );

    my $return;

    my $file = $IN{'FILE'}.$IN{'EXT'};
    my $wroot;
    if (lc($IN{'MTD'}) eq 'virtual') { $wroot = $ENV{'DOCUMENT_ROOT'}; }
    if ($IN{'EXT'}) {
        my $host = $ENV{'HTTP_HOST'} || $ENV{'SERVER_ADDR'};
        require LWP::Simple or return "[an error occurred while processing this directive]";
        unless ($@) {
            $return = head("http://".$host.$file) ? get("http://".$host.$file) : '[an error occurred while processing this directive]';
        } else {
            return "[an error occurred while processing this directive]";
        }
     } else {
        if (-e $wroot.$file) {
            open FILE, $wroot.$file;
            my @slurp = <FILE>;
            close FILE;
            $return = join '',@slurp;
        } else {
          $return = '[an error occurred while processing this directive]';
        }
     }
    return $return;
}

    
sub redirect_screen {
    my $obj = shift;
    my $IN = {  
                "TEXT"          => "",
                "URL"           => "",
                @_
              };
    
    $IN->{'URL'} = "?s=$iB::SESSION;".$IN->{'URL'};

    $obj->_print_http_header;
    print Universal::Redirect($IN->{'TEXT'}, $IN->{'URL'});
    iB::exit();
                          
}


sub pure_redirect {
    my $obj = shift;
    my $IN  = { URL => "", @_, };

    $IN->{'URL'} = "$iB::INFO->{'BOARD_URL'}/ikonboard.$iB::INFO->{'CGI_EXT'}?s=$iB::SESSION;".$IN->{'URL'};

    # If we're on NT, simply print the location to the screen
    # It seems that the status code "302" is largely ignored
    # by NT and it simply produces the header text and doesn't
    # pass it to the server

    if ($^O eq 'MSWin32' or $iB::NO_CGI_REDIRECT) {
        print "location: ".$IN->{'URL'}."\n\n";
    } else {
        print $iB::CGI->redirect( -uri => $IN->{'URL'}, -cookie => $iB::COOKIES_OUT );
    }

    $iB::CONTENT->{'HTTP'} = 1;
}



sub _print_http_header {
    my $obj = shift;
    unless ($iB::CONTENT->{'HTTP'} == 1) {
        my $charset = $iB::INFO->{'CHARSET'};
        unless ($charset) { $charset = 'ISO-8859-1'; }
        print $iB::CGI->header( -cookie => $iB::COOKIES_OUT, -expires => 'Mon, 26 Jul 1997 05:00:00 GMT', -charset => $charset );
        $iB::CONTENT->{'HTTP'} = 1;
    }
    return 1;
}




sub navigation {
    my ($obj, $IN) = @_;
    push @{ $IN->{'NAV'} }, $IN->{'NAV_ONE'} if $IN->{'NAV_ONE'};
    push @{ $IN->{'NAV'} }, $IN->{'NAV_TWO'} if $IN->{'NAV_TWO'};
    if ($IN->{'NAV'} or $IN->{'OVERRIDE'}) {
        my $return = qq|<a href="$iB::INFO->{'BOARD_URL'}/ikonboard.$iB::INFO->{'CGI_EXT'}?s=$iB::SESSION">$iB::INFO->{'BOARDNAME'}</a>|;
        my $nav = {};
        $nav->{'start'} = Universal::start_nav();
        $nav->{'end'}   = Universal::end_nav();
        unless ($IN->{'OVERRIDE'}) {
            for ( @{ $IN->{'NAV'} } ) {
                next unless $_;
                $return .= $iB::SKIN->{'F_NAV_SEP'} . $_;
            }
        }
        return $nav->{'start'} . $return . $nav->{'end'};
    }
}

sub member_bar {
    my ($obj, $db) = @_;
    my $pm_javascript = '';
    unless ($iB::MEMBER->{'MEMBER_ID'}) {
        return Universal::Guest_bar();
    } elsif (!$iB::MEMBER_GROUP->{USE_PM}) {
        # If the user is not allowed to use the messenger...
        return Universal::Member_no_usepm_bar();
    } else {
        my $msg_data = $db->select( TABLE   => 'message_stats',
                                    KEY     => $iB::MEMBER->{'MEMBER_ID'},
                                    ID      => $iB::MEMBER->{'MEMBER_ID'},
                                    COLUMNS => ['NEW_MESSAGES', 'SHOW_POPUP']
                                  );
        my $admin_link = $iB::MEMBER_GROUP->{'ACCESS_CP'} ?  Universal::admin_link() : '';
        $msg_data->{'ICON'} = $msg_data->{'NEW_MESSAGES'} ? $iB::SKIN->{'M_NEW_NAV'} : $iB::SKIN->{'M_NNEW_NAV'} ;
        $msg_data->{'NEW_MESSAGES'} ||= 0;
        $msg_data->{'TEXT'} = $Universal::lang->{'msg_new'};
        $msg_data->{'TEXT'} =~ s!<#NEW_MESSAGES#>!$msg_data->{'NEW_MESSAGES'}!;

        # Do we have to show a pop up window?
        if ($msg_data->{'SHOW_POPUP'}) {
            # First, lets reset the marker.
            $db->update( TABLE  => 'message_stats',
                         KEY    => $iB::MEMBER->{'MEMBER_ID'},
                         ID     => $iB::MEMBER->{'MEMBER_ID'},
                         VALUES => { SHOW_POPUP => 0 }
                       );
            # Get the javascript code...
            $pm_javascript = Universal::PM_popup();        
        }
        return $pm_javascript . Universal::Member_bar($msg_data, $admin_link);
    }
}


#+---------------------------------------------------------------------------------------------------------------------
#+---------------------------------------------------------------------------------------------------------------------
# MEMBER MODULE


package FUNC::Member;

use Lib::Crypt;
use strict;

sub new {
    my $pkg = shift;
    my $obj = {};
    bless $obj, $pkg;
    return $obj;
}


sub AddMember {
    my $obj = shift;

    my $IN  = { DB     => "",
                STD    => "",
                MEMBER => "",
                @_,
              };

    $IN->{'STD'}->cgi_error("No Name was selected!") unless $IN->{'MEMBER'};

    #Remove whitespace..

    $IN->{'MEMBER'}->{'MEMBER_NAME'} =~ s!^\s+!!g;
    $IN->{'MEMBER'}->{'MEMBER_NAME'} =~ s!\s+$!!g;

    my $Time = time;

    my $IdPart   = $obj->convert_to_num($IN->{'MEMBER'}->{'MEMBER_NAME'});
    my $Insert   = { MEMBER_NAME => $IN->{'MEMBER'}->{'MEMBER_NAME'},
                     MEMBER_ID   => "$IdPart".'-'."$Time",
                   };

    $IN->{'MEMBER'}->{'MEMBER_EMAIL'}    = lc($IN->{'MEMBER'}->{'MEMBER_EMAIL'});
    $IN->{'MEMBER'}->{'MEMBER_ID'}       = $Insert->{'MEMBER_ID'};
    $IN->{'MEMBER'}->{'MEMBER_PASSWORD'} = $obj->Crypt($IN->{'MEMBER'}->{'MEMBER_NAME'}, $IN->{'MEMBER'}->{'MEMBER_PASSWORD'});


    $IN->{'DB'}->insert( TABLE  => 'member_profiles',
                         ID     => $IN->{'MEMBER'}->{'MEMBER_ID'},
                         VALUES => $IN->{'MEMBER'}
                       ) || $IN->{'STD'}->cgi_error($IN->{'DB'}->{'error'});

    $IN->{'DB'}->update_index( TABLE     => 'member_profiles',
                               INDEX_KEY => 'MEMBER_EMAIL',
                               R_KEY     => $IN->{'MEMBER'}->{'MEMBER_EMAIL'},
                               R_VALUE   => $IN->{'MEMBER'}->{'MEMBER_ID'}
                     );

    $IN->{'DB'}->update_index( TABLE     => 'member_profiles',
                               INDEX_KEY => 'MEMBER_NAME',
                               R_KEY     => $IN->{'MEMBER'}->{'MEMBER_NAME'},
                               R_VALUE   => $IN->{'MEMBER'}->{'MEMBER_ID'}
                     );

    return $Insert->{'MEMBER_ID'};
}

#+------------------------------------------------------------------------------------------------------

sub convert_to_chr {
    my $obj = shift;
    return unless defined $_[0];
    return chr $_[0];
}

#+------------------------------------------------------------------------------------------------------

sub convert_to_num {
    my $obj = shift;
    return unless defined $_[0];
    my $Name = substr($_[0], 0, 1);
    return ord $Name;
} 

#+------------------------------------------------------------------------------------------------------

sub GetLetter {
    my $obj = shift;
    my $Name = $_[0];
    return unless defined $Name;
    my $N = substr($Name, 0, 1);
    my %RETURN;
    $RETURN{'LETTER'} = $N;
    if (uc($RETURN{'LETTER'})  =~ /^[A-Z0-9]+$/) {
        $RETURN{'CHR'} = uc($N);
    } else {
        $RETURN{'CHR'} = 'chr';
    }
    return \%RETURN;
}


#+------------------------------------------------------------------------------------------------------

sub CheckName  {
    my $obj = shift;
    my $IN  = { DB   => "",
                NAME => "",
                @_,
              };

        
    return  $IN->{'DB'}->query( TABLE    =>'member_profiles',
                                INDEX    => { KEY   => 'MEMBER_NAME',
                                              VALUE => $IN->{'NAME'},
                                              CASE  => 1
                                            },
                              );
}

sub Check_Mem_Email  {
    my $obj = shift;
    my $IN  = { DB    => "",
                EMAIL => "",
                @_,
              };

    $IN->{'EMAIL'} = lc($IN->{'EMAIL'});

    return $IN->{'DB'}->query(  TABLE    => 'member_profiles',
                                INDEX    => { KEY   => 'MEMBER_EMAIL',
                                              VALUE => $IN->{'EMAIL'}
                                           },
                             );

}


#+------------------------------------------------------------------------------------------------------

sub LoadMember {
    my $obj = shift;
    my $IN  = { DB     => "",
                KEY    => "",
                METHOD => "",
                @_,
              };
    return {} unless defined $IN->{'KEY'};

    my $db  = $IN->{'DB'};
    my $key = $IN->{'KEY'};
    my $Info = { MEMBER_ID => '' };
    
    if ($IN->{'METHOD'} eq 'by id') {
        $Info = $db->select(TABLE => 'member_profiles', ID => $key, KEY => $key);
    } elsif ($IN->{'METHOD'} eq 'by email') {
    	$Info = $db->query( TABLE => 'member_profiles',
    			    INDEX => { KEY => 'MEMBER_EMAIL', VALUE => $key },
    			  );
    } elsif ($IN->{'METHOD'} eq 'by ip') {
    	$Info = $db->query( TABLE => 'member_profiles',
    			    INDEX => { KEY => 'MEMBER_IP', VALUE => $key },
    			  );
    } else {
        $Info = $db->query(  TABLE    =>'member_profiles', 
                             INDEX    => { KEY => 'MEMBER_NAME', VALUE => $key },
                          );
    }
    return $Info->{'MEMBER_ID'} ne '' ? $Info : $obj->SetUpGuest();
}

#+------------------------------------------------------------------------------------------------------

sub UpdateMember  {
    my $obj = shift;
    my $IN = { DB      => "",
               MEMBER  => "",
               @_,
             };

    my $db = $IN->{'DB'};
    my $pkg = (caller(0))[0];

    if ($pkg eq 'Post') {          # and $IN->{'MEMBER'}->{'MEMBER_GROUP'} != $iB::INFO->{'SUPAD_GROUP'}) {
        unless (grep { $_ == $IN->{'MEMBER'}->{'MEMBER_GROUP'} } (split /:/, $iB::INFO->{'EXEMPT_GROUPS'})) {
            # Fix a bug in the early copies of the iB2 -> iB3 convertor. It doesn't do any harm here
            # for non bugged versions.
            $IN->{'MEMBER'}->{'MEMBER_LEVEL'} = 1 unless defined $IN->{'MEMBER'}->{'MEMBER_LEVEL'};
            my $titles = $db->query( TABLE    => 'member_titles',
                                     SORT_KEY => 'POSTS',
                                     SORT_BY  => 'Z-A'
                                   );
            for my $t (@{$titles}) {
                if ($IN->{'MEMBER'}->{'MEMBER_POSTS'} >= $t->{'POSTS'}) {
                    $IN->{'MEMBER'}->{'MEMBER_LEVEL'} = $t->{'ID'};
                    if ($t->{'ADVANCE_GROUP'}) {
                        unless ($IN->{'MEMBER'}->{'MEMBER_GROUP'} == $iB::INFO->{'SUPAD_GROUP'} or grep { $_ == $IN->{'MEMBER'}->{'MEMBER_GROUP'} } (split /:/, $iB::INFO->{'EXEMPT_GROUPS'}) ) {
                            $IN->{'MEMBER'}->{'MEMBER_GROUP'} = $t->{'ADVANCE_GROUP'};
                        }
                    }
                    last;
                }
            }
        }
    }
    # Little bug fix, does no harm here.
    $IN->{'MEMBER'}->{'WARN_LEVEL'} = 0 if length($IN->{'MEMBER'}->{'WARN_LEVEL'}) > 8;
  
    $db->update( TABLE   => 'member_profiles',
                 VALUES  => $IN->{'MEMBER'},
                 ID      => $IN->{'MEMBER'}->{'MEMBER_ID'},
                 KEY     => $IN->{'MEMBER'}->{'MEMBER_ID'}
               ); 
}

#+------------------------------------------------------------------------------------------------------

sub Crypt {
    my $obj = shift;
    my ($Name, $Pass) = @_;
    return unless ($Name or $Pass);
    return crypt ($Pass, lc (substr($Name, 0, 2 )));
} 

#+------------------------------------------------------------------------------------------------------

sub SetUpGuest ($$) {
   my ($obj, $g_name) = @_;
   $g_name ||=  'Guest';

   return {
            MEMBER_NAME      => $g_name,
            MEMBER_PASSWORD  => '',
            MEMBER_ID        => '',
            MEMBER_AVATAR    => '',
            MEMBER_TITLE     => 'UNREGISTERED',
            MEMBER_LEVEL     => -1,
            MEMBER_GROUP     => $iB::INFO->{'GUEST_GROUP'},
            MEMBER_POSTS     => 'N/A',
            MEMBER_EMAIL     => undef,
            MEMBER_WEB       => undef,
            GUEST            => 1,
            VIEW_AVS         => 1,
            VIEW_IMG         => 1,
            VIEW_SIGS        => 1,
            IP_ADDRESS       => $ENV{'REMOTE_ADDR'}
         };

}

#+------------------------------------------------------------------------------------------------------

sub RandomPassword {
  my $obj = shift;
  my @Chars = (
    "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
    "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z",
    "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M",
    "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z",
    "1", "2", "3", "4", "5", "6", "7", "8", "9", "0"
    );
  my $Password;
  srand (time);
  for (my $i = 0; $i < 8; $i++) {
    $Password .= $Chars[ int ( rand ( $#Chars + 1 ) ) ];
  }
  return $Password;
}




#+------------------------------------------------------------------------------------------------------
#+------------------------------------------------------------------------------------------------------
# MAILER MODULE

package FUNC::Mailer;
use strict;
BEGIN {
    require 'Boardinfo.pm' or die "Cannot load Module: $!";
    require 'iTextparser.pm';
}

$iB::INFO = Boardinfo->new();
my $std   = FUNC::STD->new();
my $txt   = iTextparser->new();


sub new {
  my $pkg = shift;
  my $obj = {};
  bless $obj, $pkg;
  return $obj;
}


sub parse_template  {
    my $obj = shift;
    my %IN  = ( DB     => "",
                ID     => "",
                VALUES => {},
                @_,
              );

    my $words   = $IN{'VALUES'};

    my $ext     = $iB::INFO->{'EMAIL_CONTENT'} eq 'html' ? '_h' : '';

    my $email   = $iB::INFO->{'EMAIL_HEADER'};

    my $content = $IN{'DB'}->select( TABLE   => 'email_templates',
                                     KEY     => $IN{'ID'}
                                   ) || die $IN{'DB'}->{'error'};

    $email .= $content->{'TEMPLATE'} ."\n" . $iB::INFO->{'EMAIL_FOOTER'};

    $words->{'BOARD_ADDRESS'}  = $iB::INFO->{'BOARD_URL'} . '/ikonboard.' . $iB::INFO->{'CGI_EXT'};
    $words->{'WEB_ADDRESS'}    = $iB::INFO->{'HOME_URL'};
    $words->{'BOARD_NAME'}     = $iB::INFO->{'BOARDNAME'};
    $words->{'SIGNATURE'}      = $iB::INFO->{'SIGNATURE'};
 
    for (keys %{$words}) { $email =~ s!<#(.+?)#>!$words->{$1}!sg }
 
    return $txt->Convert_for_email($email);
}
   
   

sub Send ($) {
    my $obj = shift;
    $obj->{'ARGS'} = { TO=>"",FROM=>"",BCC=>"",SUBJECT=>"",MESSAGE=>"",MSG_ID=>"",CC=>"",@_,};
    die  "Not Enough Parameters!" unless ($obj->{'ARGS'}->{'TO'} or $obj->{'ARGS'}->{'BCC'})
                                     and  $obj->{'ARGS'}->{'SUBJECT'}
                                     and  $obj->{'ARGS'}->{'MESSAGE'};
    $obj->{'ARGS'}->{'FROM'} = $iB::INFO->{'ADMIN_EMAIL_OUT'} unless $obj->{'ARGS'}->{'FROM'};

    # Fix up the subject line..

    $obj->{'ARGS'}->{'SUBJECT'} =~ s|&#33;|!|g;

    #Make sure we have all the newlines converted.

    $obj->{'ARGS'}->{'MESSAGE'} =~ s/\\n/\n/g;

    # Activestate recommend this procedure for sending mail on their port for NT, so
    # here we go...

    if ($iB::INFO->{'EMAIL_TYPE'} eq "smtp") {
        require Mail::Sendmail;

        my $charset = $iB::INFO->{'CHARSET'} || 'ISO-8859-1';

        unshift @{ $Mail::Sendmail::mailcfg{'Content-type'} }  ,  "text/plain; charset=\"".$charset."\"";
        unshift @{     $Mail::Sendmail::mailcfg{'smtp'}     }  , $iB::INFO->{'SMTP_SERVER'};
    
        $Mail::Sendmail::mailcfg{'from'} = $obj->{'ARGS'}->{'FROM'};
    
        my %mail = (
                      To      => $obj->{'ARGS'}->{'TO'},
                      From    => $obj->{'ARGS'}->{'FROM'},
                      Bcc     => $obj->{'ARGS'}->{'BCC'},
                      Cc      => $obj->{'ARGS'}->{'CC'},
                      Subject => $obj->{'ARGS'}->{'SUBJECT'},
                      Message => $obj->{'ARGS'}->{'MESSAGE'},
                
                      "X-Mailer"      => "ikonboard",
                      "X-Mailer-Info" => "http://www.ikonboard.com/",
                   );
    
        Mail::Sendmail::sendmail(%mail) || (die "$Mail::Sendmail::error");
  
    } elsif ($iB::INFO->{'EMAIL_TYPE'} eq 'send_mail') {

        # May as well handroll our own sendmail routine.
        # It's efficient and almost guaranteed to work
    
        # Perform some clean-up
        $obj->{'ARGS'}->{'TO'}   =~ s/[ \t]+/ /g;
        $obj->{'ARGS'}->{'CC'}   =~ s/[ \t]+/ /g;
        $obj->{'ARGS'}->{'BCC'}  =~ s/[ \t]+/ /g;
        # Remove double comma's.
        $obj->{'ARGS'}->{'TO'}   =~ s/,,/,/g;
        $obj->{'ARGS'}->{'CC'}   =~ s/,,/,/g;
        $obj->{'ARGS'}->{'BCC'}  =~ s/,,/,/g;
    
        # Remove pipe from sendmail path
        $iB::INFO->{'SEND_MAIL'} =~ s/\|//g;
    
        # You may want to change this if you are on NT.
        my $CRLF = "\n"; # "\015\012";
    
        # Open pipe to sendmail and squirt the message through...
        open (SENDMAIL, "|$iB::INFO->{'SEND_MAIL'} -t") || (die "Cannot pipe to sendmail $!");
          print SENDMAIL "To: "   . $obj->{'ARGS'}->{'TO'}         . $CRLF if $obj->{'ARGS'}->{'TO'};
          print SENDMAIL "From: " . $obj->{'ARGS'}->{'FROM'}       . $CRLF if $obj->{'ARGS'}->{'FROM'};
          print SENDMAIL "Bcc: "  . $obj->{'ARGS'}->{'BCC'}        . $CRLF if $obj->{'ARGS'}->{'BCC'};
          print SENDMAIL "Cc: "   . $obj->{'ARGS'}->{'CC'}         . $CRLF if $obj->{'ARGS'}->{'CC'};
          print SENDMAIL "X-Mailer: ikonboard"                     . $CRLF;
          print SENDMAIL "X-Mailer-Info: http://www.ikonboard.com/". $CRLF;
    
          print SENDMAIL "Subject: " . $obj->{'ARGS'}->{'SUBJECT'}  . $CRLF . $CRLF;
          print SENDMAIL               $obj->{'ARGS'}->{'MESSAGE'}  . $CRLF . $CRLF;
        close (SENDMAIL);
    }

    # Append the log...
    my $time = scalar(localtime);
	my $ip   = $ENV{'REMOTE_ADDR'};
	my $ref  = $ENV{'HTTP_REFERER'};
	my $app  = $0;
	my $logfile = $iB::INFO->{'DB_DIR'}.'Email-log.cgi';

	if ($iB::INFO->{'LOG_EMAILS'}) {
		open (LOG, ">>$logfile");
        print LOG qq~
+----------------------------------------
Message sent: $time
To: $obj->{'ARGS'}->{'TO'} :: From: $obj->{'ARGS'}->{'FROM'} :: Subject: $obj->{'ARGS'}->{'SUBJECT'}
=====
$obj->{'ARGS'}->{'MESSAGE'}
=====
Mode: $iB::INFO->{'EMAIL_TYPE'} :: SMTP: $iB::INFO->{'SMTP_SERVER'} :: Sendmail: $iB::INFO->{'SEND_MAIL'}
Remote Host: $ip :: Remote Ref: $ref :: Program: $app
+----------------------------------------
~;
        close LOG;
        return 1;
    }

}


sub my_gen_id {
    my $obj = shift;
    srand($$|time);
    my $session = int(rand(60000000));
    return unpack("H*", pack("Nnn", time, $$, $session));

}

#+------------------------------------------------------------------------------------------------------
#+------------------------------------------------------------------------------------------------------
# END OF MODULES
1;
