####################################################################################################
### ICRADIUS Interface Module
### Drew Wilder-Goodwin
### 2001-04-24
#
# There is a known bug in this program that I didnt have time to fix before this
# release.  I wrote some custom SQL functions in the module in order to make life
# easier.  There is one more step missing though, and that is the 'escaping' of
# values passed to these functions.  To make a long story short, if you have the
# special characters '&', '|' or '!' as the first letter of a attribute or value,
# those characters will not be inserted correctly, and the SQL may not behave as you
# would expect it to.  Anywhere that will be fixed soon.
#
####################################################################################################
package IC::Radius;

use strict;
use DBI;

####################################################################################################

=head1 NAME

IC::Radius - ICRADIUS Interface Module

=head1 SYNOPSIS

 use IC::Radius;
 my $radius = new IC::Radius;
 $radius->init('username', 'password');

=head1 DESCRIPTION

The B<IC::Radius> module provides functions for interfacing with ICRADIUS

=head1 FUNCTIONS

Z<>

=cut

####################################################################################################

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $OPT_DEBUG);
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw();
@EXPORT = qw($OPT_DEBUG);

$VERSION = '0.4';
$OPT_DEBUG = 1;

sub new {
	my $class = shift;
	my $self = {
		debug => 0,
		version => $VERSION,
		success => 1,
		failure => 0,
	};
	bless $self, $class;
	return $self;
}

sub DESTROY {
	my $self = shift;
	#$self->print_debug('database handle disconnected');
}

### init(); ########################################################################################

=pod

=head2 init($username, $password, [$hostname , $database, $option, $option...]);

=over 4

=item * arguments

 $username	- database username
 $password	- database password
 $hostname	- database hostname (default is localhost)
 $database	- radius database (default is radius)
 $option	- Init option(s)

=item * options

 $OPT_DEBUG	- Turn on debugging

=back

=cut

sub init {
	my $self = shift;
	my $username = shift;
	my $password = shift;
	my $hostname = shift || 'localhost';
	my $database = shift || 'radius';
	my $options = shift || 0;

	$self->{debug} = 1 if ($options & $OPT_DEBUG);
	$self->{dbh} = DBI->connect("DBI:mysql:$database:$hostname", $username, $password);
	$self->initialize_errors;

	return $self->{success};
}
####################################################################################################

### initialize_errors(); ###########################################################################

=pod

=head2 initialize_errors();

=over 4

=item * I<summary>

initializes the internal error hashes

=item * I<arguments>

none

=item * I<sample>

 $self->initialize_errors(); 

=item * I<return value>

$self->{success}

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub initialize_errors {
        my $self = shift;

	$self->{errors}->{-1}	= 'ITEM_NOT_FOUND';
	$self->{errors}->{-2}	= 'DATABASE';
	$self->{errors}->{-3}	= 'MISSING_REQUIRED';
	$self->{errors}->{-4}	= 'ITEM_EXISTS';

	$self->{errors}->{ITEM_NOT_FOUND}	= {number => '-1', string => 'Item not found'};
	$self->{errors}->{DATABASE}		= {number => '-2', string => 'Database Error'};
	$self->{errors}->{MISSING_REQUIRED}	= {number => '-3', string => 'Missing required field'};
	$self->{errors}->{ITEM_EXISTS}		= {number => '-3', string => 'Item Exists'};

	return $self->{success};
}
####################################################################################################

### (); ############################################################################################

=pod

=head2 ();

=over 4

=item * I<summary>



=item * I<arguments>

 $ - 

=item * I<sample>

 

=item * I<return value>



=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub x {
        my $self = shift;

}
####################################################################################################

sub user_exists {
	my $self = shift;
        my $username = shift;
        return 1 if (   $self->select_count('radreply', {UserName => $username}) or
                        $self->select_count('radcheck', {UserName => $username}) or
                        $self->select_count('usergroup', {UserName => $username}));
        return 0;
}

sub user_connected {
	my $self = shift;
	my $username = shift;
	return $self->select_count('radacct', {UserName => $username, AcctStopTime => 0});
}

sub enable_user {
	my $self = shift;
	return $self->delete_row('radcheck', {UserName => shift, Attribute => 'Auth-Type', Value => 'Reject'});
}

sub disable_user {
	my $self = shift;
	my $username = shift;
	$self->delete_row('radcheck', {UserName => $username, Attribute => 'Auth-Type', Value => 'Reject'});
	return $self->insert_row('radcheck', {UserName => $username, Attribute => 'Auth-Type', Value => 'Reject'})
}

### insert_user(); #################################################################################

=pod

=head2 insert_user($username, $password, $encrypted);

=over 4

=item * I<summary>

insert a new user

=item * I<arguments>

 $username	- username
 $password	- password
 $encrypted	- password will be encrypted if true

=item * I<sample>

 $radius->insert_user('barney', 'rubble'); 

=item * I<return value>

id of the newly created user

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub insert_user {
        my $self = shift;
	my $username = shift;
	my $password = shift;
	my $encrypted = shift;

	if ($encrypted) {
		my @chars = ('A'..'Z', 'a'..'z', '0'..'9');

		my $seed = $chars[rand(@chars)];
		$seed .= $chars[rand(@chars)];

		$password = crypt($password, '$seed');
		$self->insert_row('radcheck', {Username => $username, Attribute => 'Auth-Type', Value => 'Crypt-Local'});
	}

	return $self->insert_row('radcheck', {UserName => $username, Attribute => 'Password', Value => $password});
}
####################################################################################################

### insert_user_attribute(); #######################################################################

=pod

=head2 insert_user_attribute($username, $type, $attribute, $value);

=over 4

=item * I<summary>

Adds a new attribute to the specified username

=item * I<arguments>

 $username	- username to add attribute to 
 $type		- reply or check
 $attribute	- attribute to add to $username
 $value		- value of the added attribute

=item * I<sample>

 $radius->insert_user_attribute('barney', 'reply', 'Filter-Id', 'rubble'); 

=item * I<return value>

id of the newly added attribute.

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub insert_user_attribute {
        my $self = shift;
	my $username = shift;
	my $type = shift;
	my $attribute = shift;
	my $value = shift;

	$type = 'rad'.$type unless ($type =~ /^rad/);
	return $self->insert_row($type, {UserName => $username, Attribute => $attribute, Value => $value});
}
####################################################################################################

### insert_group_attribute(); ######################################################################

=pod

=head2 insert_group_attribute($groupname, $type, $attribute, $value);

=over 4

=item * I<summary>

Add a new attribute to the specified group

=item * I<arguments>

 $groupname	- groupname to add attribute to
 $type		- check or reply
 $attribute	- attribute to add to $groupname
 $value		- value of added attribute

=item * I<sample>

 $radius->insert_group_attribute('PPP', 'reply', 'Session-Timeout', '21600'); 

=item * I<return value>

id of the newly added attribute.

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub insert_group_attribute {
        my $self = shift;
	my $groupname = shift;
	my $type = shift;
	my $attribute = shift;
	my $value = shift;

	$type = 'radgroup'.$type unless ($type =~ /^radgroup/);
	return $self->insert_row($type, {GroupName => $groupname, Attribute => $attribute, Value => $value});
}
####################################################################################################

### insert_user_group(); ###########################################################################

=pod

=head2 insert_user_group($username, $groupname);

=over 4

=item * I<summary>

Add a user to the specified group

=item * I<arguments>

 $username	- user to be added to $groupname
 $groupname	- group to add $username to

=item * I<sample>

 $radius->insert_user_group('barney', 'PPP'); 

=item * I<return value>

id of the row containing the new group membership

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub insert_user_group {
        my $self = shift;
	return $self->insert_row('usergroup', {UserName => shift, GroupName => shift});
}
####################################################################################################

### insert_realm(); ################################################################################

=pod

=head2 insert_realm($realmname, $nas, $authport [, $option, $option...]);

=over 4

=item * I<summary>

Add a new realm

=item * I<arguments>

 $realmname	- realms realname
 $nas		- nas name
 $authport	- auth port
 $options	- reference to array of options for realm

=item * I<sample>

 $radius->insert_realm('flintstones.com', 'bedrock', '1812', 'nostrip');

=item * I<return value>

id of the newly created realm

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub insert_realm {
        my $self = shift;
	my $realmname = shift;
	my $nas = shift;
	my $authport = shift;
	my $options = shift;
	$options = join ',', @$options;

	return $self->insert_row('realms', {realmname => $realmname, nas => $nas, authport => $authport, options => $options});
}
####################################################################################################

### insert_nas(); ##################################################################################

=pod

=head2 insert_nas($nasname, $shortname, $ipaddr, $type, $ports, $secret, $community, $snmp);

=over 4

=item * I<summary>

Add a new nas

=item * I<arguments>

 $nasname	- name of nas to add
 $shortname	- shortname of nas
 $ipaddr	- ip address of nas
 $type		- type of nas
 $ports		- number of ports on nas
 $secret	- nas's secret
 $community	- snmp community name
 $snmp		- snmp status of 'on' or 'off'

=item * I<sample>

 $radius->insert_nas('pm1.flintstones.com', 'pm1', '123.199.199.199', 'livingston', '46', 'Dino', 'flintsnmp', 'on'); 

=item * I<return value>

id of the newly created nas

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub insert_nas {
        my $self = shift;
	return $self->insert_row('nas', {nasname	=> shift,
					shortname	=> shift,
					ipaddr		=> shift,
					type		=> shift,
					ports		=> shift,
					secret		=> shift,
					community	=> shift,
					snmp		=> shift});

}
####################################################################################################

### delete_user(); #################################################################################

=pod

=head2 delete_user($username);

=over 4

=item * I<summary>

deletes all entries in radgroup, radreply, and usergroup for the specified user

=item * I<arguments>

 $username - user to delete

=item * I<sample>

 $radius->delete_user('fred'); 

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub delete_user {
        my $self = shift;
	my $username = shift;

	$self->delete_row('radreply', {UserName => $username});
	$self->delete_row('radcheck', {UserName => $username});
	$self->delete_row('usergroup', {UserName => $username});

	return $self->{success};
}
####################################################################################################

### delete_user_attribute(); #######################################################################

=pod

=head2 delete_user_attribute($username, $type, $attribute[, $value]);

=over 4

=item * I<summary>

Deletes the specified attribute from the specified user

=item * I<arguments>

 $username	- user on which the attribute is to be deleted
 $type		- check or reply
 $attribute	- attribute to be deleted from $username
 $value		- value of attribute to be deleted

=item * I<sample>

 $radius->delete_user_attribute('barney', 'reply', 'Filter-Id', 'rubble');

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE	- Internal Database/SQL Syntax Error
 ITEM_NOT_FOUND	- the specified user/attribute/value was not found

=back

=cut

sub delete_user_attribute {
        my $self = shift;
	my $username = shift;
	my $type = shift;
	my $attribute = shift;
	my $value = shift;

	my $hash = {UserName => $username, Attribute => $attribute};
	$hash->{Value} = $value if defined $value;

	$type = 'rad'.$type unless ($type =~ /^rad/);
	return $self->{success} if $self->delete_row($type, $hash, ( defined $value ? {LIMIT => 1} : {} ));
}
####################################################################################################

### delete_group(); ################################################################################

=pod

=head2 delete_group($groupname);

=over 4

=item * I<summary>

delete a specified group

=item * I<arguments>

 $groupname - group to be deleted

=item * I<sample>

 $radius->delete_group('PPP'); 

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub delete_group {
        my $self = shift;
	my $groupname = shift;

	$self->delete_row('radgroupreply', {GroupName => $groupname});
	$self->delete_row('radgroupcheck', {GroupName => $groupname});
	$self->delete_row('usergroup', {GroupName => $groupname});
	$self->delete_row('realmgroup', {GroupName => $groupname});

	return $self->{success};
}
####################################################################################################

### delete_group_attribute(); ######################################################################

=pod

=head2 delete_group_attribute($groupname, $type, $attribute, $value);

=over 4

=item * I<summary>

Deletes the specified attribute from the specified group

=item * I<arguments>

 $groupname	- group on which the attribute is to be deleted
 $type		- reply or check
 $attribute	- attribute to be deleted from $groupname
 $value		- value of attribute to be deleted

=item * I<sample>

 $radius->delete_group_attribute('PPP', 'reply', 'Filter-Id', '21600');

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE	- Internal Database/SQL Syntax Error
 ITEM_NOT_FOUND	- the specified group/attribute/value was not found

=back

=cut

sub delete_group_attribute {
        my $self = shift;
	my $groupname = shift;
	my $type = shift;
	my $attribute = shift;
	my $value = shift;

	my $hash = {GroupName => $groupname, Attribute => $attribute};
	$hash->{Value} = $value if defined $value;

	$type = 'radgroup'.$type unless ($type =~ /^radgroup/);
	return $self->{success} if $self->delete_row($type, $hash, ( defined $value ? {LIMIT => 1} : {} ));
}
####################################################################################################

### delete_user_group(); ###########################################################################

=pod

=head2 delete_user_group($username, $groupname);

=over 4

=item * I<summary>

Remove a user from the specified group

=item * I<arguments>

 $username	- user to remove from $groupname
 $groupname	- group to remove $username

=item * I<sample>

 $radius->delete_user_group('barney', 'PPP'); 

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE	- Internal Database/SQL Syntax Error
 ITEM_NOT_FOUND	- the specified user was not found in the specified group

=back

=cut

sub delete_user_group {
        my $self = shift;
	my $username = shift;
	my $groupname = shift;

	return $self->set_error('ITEM_NOT_FOUND') unless $self->select_count('usergroup', {UserName => $username, GroupName => $groupname});
	return $self->{success} if $self->delete_row('usergroup', {UserName => $username, GroupName => $groupname}, {LIMIT => 1});
}
####################################################################################################

### delete_realm(); ################################################################################

=pod

=head2 delete_realm($realmname);

=over 4

=item * I<summary>

delete a realm

=item * I<arguments>

 $realmname - realm to delete

=item * I<sample>

 $radius->delete_realm('flintstone.com');

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub delete_realm {
        my $self = shift;
	my $realmname = shift;
	$self->delete_row('realms', {realmname => $realmname});
	$self->delete_row('realmgroup', {RealmName => $realmname});
	return $self->{success}
}
####################################################################################################

### delete_nas(); ##################################################################################

=pod

=head2 delete_nas($nasname);

=over 4

=item * I<summary>

delete a nas

=item * I<arguments>

 $nasname - nas to delete

=item * I<sample>

 $radius->delete_nas('flintstone.com');

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub delete_nas {
        my $self = shift;
	my $nasname = shift;
	$self->delete_row('nas', {nasname => $nasname});
	$self->delete_row('realms', {nas => $nasname});
	return $self->{success}
}
####################################################################################################

### delete_acct_sessions(); ########################################################################

=pod

=head2 delete_acct_sessions($radacctids);

=over 4

=item * I<summary>

delete sessions from the radacct table

=item * I<arguments>

 $radacctids - reference to an array of radacctids

=item * I<sample>

 $radius->delete_acct_sessions(['44440']);

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub delete_acct_sessions {
        my $self = shift;
	my $radacctids = shift;
	$radacctids = [$radacctids] unless ref $radacctids;
	foreach my $radacctid (@$radacctids) {
		$self->delete_row('radacct', {RadAcctId => $radacctid});
	}
	return $self->{success};
}
####################################################################################################

### update_user_attribute(); #######################################################################

=pod

=head2 update_user_attribute($username, $type, $attribute, $ovalue, $nvalue);

=over 4

=item * I<summary>

updates the specified user attribute to $value

=item * I<arguments>

 $username	- user to update attribute of
 $type		- check or reply
 $attribute	- attribute to update value of
 $ovalue	- old value of attribute
 $nvalue	- new value of attribute

=item * I<sample>

 $radius->update_user_attribute('fred', 'check', 'Filter-Id', 'rubble', 'bedrock'); 

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub update_user_attribute {
        my $self = shift;
	my $username = shift;
	my $type = shift;
	my $attribute = shift;
	my $ovalue = shift;
	my $nvalue = shift;

	$type = 'rad'.$type unless ($type =~ /^rad/);
	return $self->{success} if $self->update_fields($type, {Value => $nvalue}, {UserName => $username, Attribute => $attribute, Value => $ovalue});
}
####################################################################################################

### update_group_attribute(); ######################################################################

=pod

=head2 update_group_attribute($groupname, $type, $attributeid, $ovalue, $nvalue);

=over 4

=item * I<summary>

updates the sepcified group attribute to $value

=item * I<arguments>

 $groupname	- group to update attribute of
 $type		- check or reply
 $attribute	- attribute to update value of
 $ovalue	- old value of attribute
 $nvalue	- new value of attribute

=item * I<sample>

 $radius->update_group_attribute('PPP', 'reply', 'Idle-Timeout', '1000', '43200');
 
=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub update_group_attribute {
        my $self = shift;
	my $groupname = shift;
	my $type = shift;
	my $attribute = shift;
	my $ovalue = shift;
	my $nvalue = shift;

	$type = 'radgroup'.$type unless ($type =~ /^radgroup/);
	return $self->{success} if $self->update_fields($type, {Value => $nvalue}, {GroupName => $groupname, Attribute => $attribute, Value => $ovalue});
}
####################################################################################################

### replace_user_groups(); #########################################################################

=pod

=head2 replace_user_groups($username, $groups);

=over 4

=item * I<summary>

removes all groups for $username and replaces them with groups in $groups

=item * I<arguments>

 $username	- username to replace groups for
 $groups	- group or array ref of groups place user in

=item * I<sample>

 $radius->replace_user_groups('barney', 'PPP');			# one way
 $radius->replace_user_groups('barney', ['PPP', 'Metered']); 	# another way

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub replace_user_groups {
        my $self = shift;
	my $username = shift;
	my $groups = shift;

	$self->delete_row('usergroup', {UserName => $username});

	$groups = [$groups] unless ref $groups;
	foreach my $group (@$groups) {
		$self->insert_row('usergroup', {UserName => $username, Group => $group});
	}

	return $self->{success};
}
####################################################################################################

### update_realm(); ################################################################################

=pod

=head2 update_realm($orealmname, $realmname, $nas, $authport [, $option, $option...]);

=over 4

=item * I<summary>

update an existing realm

=item * I<arguments>

 $orealmname	- realms current name
 $realmname	- realms new name
 $nas		- nas name
 $authport	- auth port
 $options	- reference to array of options for realm

=item * I<sample>

 $radius->update_realm('flintstones.com', 'bedrock.com', 'bedrock', '1812', 'nostrip');

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub update_realm {
        my $self = shift;
	my $orealmname = shift;
	my $realmname = shift;
	my $nas = shift;
	my $authport = shift;
	my $options = shift;
	$options = join ',', @$options;

	return $self->{success} if $self->update_fields('realms', {realmname => $realmname, nas => $nas, authport => $authport, options => $options}, {realmname => $orealmname});
}
####################################################################################################

### update_nas(); ##################################################################################

=pod

=head2 update_nas($onasname, $nasname, $shortname, $ipaddr, $type, $ports, $secret, $community, $snmp);

=over 4

=item * I<summary>

update an existing realm

=item * I<arguments>

 $onasname	- nas' current name
 $nasname	- nas' new name
 $shortname	- short name
 $ipaddr	- ip address
 $type		- type
 $ports		- ports
 $secret	- secret
 $community	- snmp community
 $snmp		- snmp port limit checking (on or off)

=item * I<sample>

 $radius->update_nas('pm1.flintstones.com', 'pm1', '123.199.199.199', 'livingston', '46', 'Dino', 'flintsnmp', 'on'); 

=item * I<return value>

C<$self->{success}> if the operation is successful

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub update_nas {
        my $self = shift;
	my $onasname = shift;
	my $nasname = shift;
	my $shortname = shift;
	my $ipaddr = shift;
	my $type = shift;
	my $ports = shift;
	my $secret = shift;
	my $community = shift;
	my $snmp = shift;

	return $self->{success} if $self->update_fields('nas', {nasname => $nasname, shortname => $shortname, ipaddr => $ipaddr, type => $type, ports => $ports, secret => $secret, community => $community, snmp => $snmp}, {nasname => $onasname});
}
####################################################################################################

### fetch_user_list(); #############################################################################

=pod

=head2 fetch_user_list();

=over 4

=item * I<summary>

fetch a list of known users

=item * I<arguments>

none

=item * I<sample>

 $radius->fetch_user_list; 

=item * I<return value>

array or reference to an array of usernames

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_user_list {
        my $self = shift;
	my $users = {};
	my @usernames = ();

	my $sql = "SELECT DISTINCT UserName FROM radreply";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my ($user) = $sth->fetchrow_array) {
		$users->{$user} = 1 unless exists $users->{$user};
	}

	$sth->finish;

	$sql = "SELECT DISTINCT UserName FROM radcheck";
	$self->print_debug($sql, 'SQL');
	$sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my ($user) = $sth->fetchrow_array) {
		$users->{$user} = 1 unless exists $users->{$user};
	}

	$sth->finish;

	foreach my $user (sort keys %$users) {
		push @usernames, $user;
	}

	return @usernames if wantarray;
	return \@usernames;
}
####################################################################################################

### fetch_group_list() #############################################################################

=pod

=head2 fetch_group_list();

=over 4

=item * I<summary>

retrieve a list of groups

=item * I<arguments>

none

=item * I<sample>

 $radius->fetch_group_list; 

=item * I<return value>

array or reference to array of group names

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_group_list {
        my $self = shift;

	my $distinct_groups = {};

	my $sql = "SELECT DISTINCT GroupName FROM radgroupreply";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my ($group) = $sth->fetchrow_array) {
		$distinct_groups->{$group} = 1;
	}
	
	$sql = "SELECT DISTINCT GroupName FROM radgroupcheck";
	$self->print_debug($sql, 'SQL');
	$sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my ($group) = $sth->fetchrow_array) {
		$distinct_groups->{$group} = 1;
	}
	
	while (my ($group) = $sth->fetchrow_array) {
		$distinct_groups->{$group} = 1;
	}
	
	my @groups = ();

	foreach my $group (keys %$distinct_groups) {
		push @groups, $group;
	}

	return @groups if wantarray;
	return \@groups;
}
####################################################################################################

### fetch_user_reply_items(); ######################################################################

=pod

=head2 fetch_user_reply_items($username);

=over 4

=item * I<summary>

fetch all reply items on a user

=item * I<arguments>

 $username - user to fetch reply items for

=item * I<sample>

 $radius->fetch_user_reply_items('fred');

=item * I<return value>

hashref of reply items and their values

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_user_reply_items {
        my $self = shift;
	my $username = $self->{dbh}->quote(shift);
	my $reply_items = {};

	my $sql = "SELECT Attribute, Value FROM radreply WHERE UserName = $username";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my $reply_item = $sth->fetchrow_hashref) {
		if (exists $reply_items->{$reply_item->{Attribute}}) {
			$reply_items->{$reply_item->{Attribute}} = [$reply_items->{$reply_item->{Attribute}}] unless ref $reply_items->{$reply_item->{Attribute}};
			push @{$reply_items->{$reply_item->{Attribute}}}, $reply_item->{Value};
		} else {
			$reply_items->{$reply_item->{Attribute}} = $reply_item->{Value};
		}
	}

	$sth->finish;

	return $reply_items;
}
####################################################################################################

### fetch_user_check_items(); ######################################################################

=pod

=head2 fetch_user_check_items($username);

=over 4

=item * I<summary>

fetch all check items on a user

=item * I<arguments>

 $username - user to fetch check items for

=item * I<sample>

 $radius->fetch_user_check_items('fred');

=item * I<return value>

hashref of check items and their values

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_user_check_items {
        my $self = shift;
	my $username = $self->{dbh}->quote(shift);
	my $check_items = {};

	my $sql = "SELECT Attribute, Value FROM radcheck WHERE UserName = $username";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my $check_item = $sth->fetchrow_hashref) {
		if (exists $check_items->{$check_item->{Attribute}}) {
			$check_items->{$check_item->{Attribute}} = [$check_items->{$check_item->{Attribute}}] unless ref $check_items->{$check_item->{Attribute}};
			push @{$check_items->{$check_item->{Attribute}}}, $check_item->{Value};
		} else {
			$check_items->{$check_item->{Attribute}} = $check_item->{Value};
		}
	}

	$sth->finish;

	return $check_items;
}
####################################################################################################

### fetch_user_groups(); ###########################################################################

=pod

=head2 fetch_user_groups($username);

=over 4

=item * I<summary>

get a list of all groups the specified user belongs to

=item * I<arguments>

 $username - user to fetch groups of

=item * I<sample>

 $radius->fetch_users_groups('fred'); 

=item * I<return value>

array or arrayref containing group names of which the specified user belongs to

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_user_groups {
        my $self = shift;
	my $username = $self->{dbh}->quote(shift);
	my @groups = ();

	my $sql = "SELECT GroupName FROM usergroup WHERE UserName = $username";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my ($groupname) = $sth->fetchrow_array) {
		push @groups, $groupname;
	}

	$sth->finish;

	return @groups if wantarray;
	return \@groups;
}
####################################################################################################

### fetch_group_reply_items(); ######################################################################

=pod

=head2 fetch_group_reply_items($groupname);

=over 4

=item * I<summary>

fetch all reply items on a group

=item * I<arguments>

 $groupname - group to fetch reply items for

=item * I<sample>

 $radius->fetch_group_reply_items('fred');

=item * I<return value>

hashref of reply items and their values

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_group_reply_items {
        my $self = shift;
	my $groupname = $self->{dbh}->quote(shift);
	my $reply_items = {};

	my $sql = "SELECT Attribute, Value FROM radgroupreply WHERE Groupname = $groupname";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my $reply_item = $sth->fetchrow_hashref) {
		if (exists $reply_items->{$reply_item->{Attribute}}) {
			$reply_items->{$reply_item->{Attribute}} = [$reply_items->{$reply_item->{Attribute}}] unless ref $reply_items->{$reply_item->{Attribute}};
			push @{$reply_items->{$reply_item->{Attribute}}}, $reply_item->{Value};
		} else {
			$reply_items->{$reply_item->{Attribute}} = $reply_item->{Value};
		}
	}

	$sth->finish;

	return $reply_items;
}
####################################################################################################

### fetch_group_check_items(); ######################################################################

=pod

=head2 fetch_group_check_items($groupname);

=over 4

=item * I<summary>

fetch all check items on a group

=item * I<arguments>

 $groupname - group to fetch check items for

=item * I<sample>

 $radius->fetch_group_check_items('fred');

=item * I<return value>

hashref of check items and their values

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_group_check_items {
        my $self = shift;
	my $groupname = $self->{dbh}->quote(shift);
	my $check_items = {};

	my $sql = "SELECT Attribute, Value FROM radgroupcheck WHERE GroupName = $groupname";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my $check_item = $sth->fetchrow_hashref) {
		if (exists $check_items->{$check_item->{Attribute}}) {
			$check_items->{$check_item->{Attribute}} = [$check_items->{$check_item->{Attribute}}] unless ref $check_items->{$check_item->{Attribute}};
			push @{$check_items->{$check_item->{Attribute}}}, $check_item->{Value};
		} else {
			$check_items->{$check_item->{Attribute}} = $check_item->{Value};
		}
	}

	$sth->finish;

	return $check_items;
}
####################################################################################################

### fetch_attribute_list(); ########################################################################

=pod

=head2 fetch_attribute_list();

=over 4

=item * I<summary>

retrieve a list of avaialable attributes

=item * I<arguments>

none

=item * I<sample>

 my $attributes = $radius->fetch_attribute_list();

=item * I<return value>

 array or array ref of hashref's containing attribute information from the dictionary table

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_attribute_list {
        my $self = shift;
	my @attributes = ();

	my $sql = "SELECT * FROM dictionary WHERE Type = 'ATTRIBUTE'";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my $attribute = $sth->fetchrow_hashref) {
		push(@attributes, $attribute);
	}

	$sth->finish;
	
	return @attributes if wantarray;
	return \@attributes;
}
####################################################################################################

### fetch_attribute_info(); ########################################################################

=pod

=head2 fetch_attribute_info($attribute);

=over 4

=item * I<summary>

fetch information on a specified attribute

=item * I<arguments>

 $attribute - attribute to fetch info for

=item * I<sample>

 $radius->fetch_attribute_info('Password'); 

=item * I<return value>

hashref of attribute information from the dictionary table

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_attribute_info {
        my $self = shift;
	my $attribute = $self->{dbh}->quote(shift);

	my $sql = "SELECT * FROM dictionary WHERE Attribute = $attribute AND Type = 'ATTRIBUTE'";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	return $sth->fetchrow_hashref;
}
####################################################################################################

### fetch_attribute_values(); ######################################################################

=pod

=head2 fetch_attribute_values($attribute);

=over 4

=item * I<summary>

retrieve a list of values possible for a specified attribute

=item * I<arguments>

 $attribute - attribute to retrieve the possible values of

=item * I<sample>

 my $values = $radius->fetch_attribute_values('Filter-Id'); 

=item * I<return value>

array or arrayref of hashref's of attribute values

=item * I<possible errors>

 DATABASE	- Internal Database/SQL Syntax Error
 ITEM_NOT_FOUND	- There were no values associated with the attribute

=back

=cut

sub fetch_attribute_values {
        my $self = shift;
	my $attribute = $self->{dbh}->quote(shift);
	my @values = ();

	my $sql = "SELECT Value FROM dictionary WHERE Type = 'VALUE' AND Attribute = $attribute";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my ($value) = $sth->fetchrow_array) {
		push @values, $value;
	}	

	$sth->finish;

	return $self->set_error('ITEM_NOT_FOUND') unless scalar @values;

	return @values if wantarray;
	return \@values if scalar @values;
	return 0;
}
####################################################################################################

### fetch_realm_list(); ############################################################################

=pod

=head2 fetch_realm_list();

=over 4

=item * I<summary>

retrieve a list of realms

=item * I<arguments>

none

=item * I<sample>

 my $realms = $radius->fetch_realms_list; 

=item * I<return value>

array or reference to an array of hash references containing realm information

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_realm_list {
        my $self = shift;
	my @realms = ();

	my $sql = "SELECT * FROM realms";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my $realm = $sth->fetchrow_hashref) {
		push @realms, $realm;
	}

	return @realms if wantarray;
	return \@realms;
}
####################################################################################################

### fetch_realm_options(); #########################################################################

=pod

=head2 fetch_realm_options();

=over 4

=item * I<summary>

retrieve a list of available options for realms

=item * I<arguments>

none

=item * I<sample>

 my $realms = $radius->fetch_realms_options; 

=item * I<return value>

array or reference to an array of options

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_realm_options {
        my $self = shift;
	my @options = ('nostrip', 'dohints', 'loglocal');

	return @options if wantarray;
	return \@options;
}
####################################################################################################

### fetch_realm_info(); ############################################################################

=pod

=head2 fetch_realm_info($realmname);

=over 4

=item * I<summary>

fetch information on a specified realm

=item * I<arguments>

 $realmname - realm to fetch info for

=item * I<sample>

 $radius->fetch_realm_info('LOCAL'); 

=item * I<return value>

hashref of information on the specified realm

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_realm_info {
        my $self = shift;
	my $realmname = $self->{dbh}->quote(shift);

	my $sql = "SELECT * FROM realms WHERE realmname = $realmname";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	return $sth->fetchrow_hashref;
}
####################################################################################################

### fetch_nas_list(); ##############################################################################

=pod

=head2 fetch_nas_list();

=over 4

=item * I<summary>

retrieve a list of nas'

=item * I<arguments>

none

=item * I<sample>

 my $nas = $radius->fetch_nas_list; 

=item * I<return value>

array or reference to an array of hash references containing nas information

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_nas_list {
        my $self = shift;
	my @nas_list = ();

	my $sql = "SELECT * FROM nas";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	while (my $nas = $sth->fetchrow_hashref) {
		push @nas_list, $nas;
	}

	return @nas_list if wantarray;
	return \@nas_list;
}
####################################################################################################

### fetch_nas_info(); ##############################################################################

=pod

=head2 fetch_nas_info($nasname);

=over 4

=item * I<summary>

fetch information on a specified nas

=item * I<arguments>

 $nasname - nas to fetch info for

=item * I<sample>

 $radius->fetch_nas_info('pm.flintstones.com'); 

=item * I<return value>

hashref of information on the specified nas

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_nas_info {
        my $self = shift;
	my $nasname = $self->{dbh}->quote(shift);

	my $sql = "SELECT * FROM nas WHERE nasname = $nasname";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	return $sth->fetchrow_hashref;
}
####################################################################################################

### fetch_session_info(); ##########################################################################

=pod

=head2 fetch_session_info($radacctid);

=over 4

=item * I<summary>

fetch information on a specified session

=item * I<arguments>

 $radacctid - session to fetch info for

=item * I<sample>

 $radius->fetch_session_info('44440'); 

=item * I<return value>

hashref of attribute information about the session from the radacct table

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_session_info {
        my $self = shift;
	my $radacctid = $self->{dbh}->quote(shift);

	my $sql = "SELECT * FROM radacct WHERE RadAcctId = $radacctid";
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	return $sth->fetchrow_hashref;
}
####################################################################################################

### fetch_last_insert_id(); ########################################################################

=pod

=head2 fetch_last_insert_id();

=over 4

=item * I<summary>

retrieves the id of the row most recently inserted into a mysql table

=item * I<arguments>

none

=item * I<sample>

 my $id = $self->fetch_last_insert_id(); 

=item * I<return value>

id of the most recently inserted row

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub fetch_last_insert_id {
        my $self = shift;

	my $sql = 'SELECT LAST_INSERT_ID()';
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');
	
	my ($id) = $sth->fetchrow_array;
	$sth->finish;

	return $id;
}
####################################################################################################

### insert_row(); ##################################################################################

=pod

=head2 insert_row($table, $fields);

=over 4

=item * I<summary>



=item * I<arguments>

 $table		- table to insert row into
 $fields	- hashref containing keys that match up to the database to be updated with corresponding values.

=item * I<sample>

 

=item * I<return value>



=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub insert_row {
        my $self = shift;
	my $table = shift;
	my $fields = shift;

	$self->print_debug('called from '.(caller 1)[3]);

	my $sql = "INSERT INTO $table SET ";

	foreach my $field (keys %$fields) {
		my $value = $fields->{$field};
		my $rvalue_quoting = 1;
		while ($value =~ s/^(\?)//) {
			$rvalue_quoting = 0;
		}
		$value = $self->{dbh}->quote($value) if $rvalue_quoting;
		$sql .= "$field = $value, ";
	}
	$sql =~ s/(, )*$//;
	
	$self->print_debug($sql, 'SQL');
	$self->{dbh}->do($sql) || return $self->set_error('DATABASE');

	return $self->fetch_last_insert_id();
}
####################################################################################################

### delete_row(); ##################################################################################

=pod

=head2 delete_row($table, $criteria);

=over 4

=item * I<summary>



=item * I<arguments>

 $table		- table to delete row from
 $criteria	- arrayref of arrayrefs of hashref's containing criteria for where clause.  keys should be the left side of the equals and values the right.

=item * I<sample>

 

=item * I<return value>



=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub delete_row {
        my $self = shift;
	my $table = shift;
	my $criteria = shift;
	my $rules = shift;

	$self->print_debug('called from '.(caller 1)[3]);

	my $sql = "DELETE FROM $table";

	my $where;
	$criteria = [[$criteria]] unless (ref($criteria) eq 'ARRAY');
	foreach my $clauses (@$criteria) {
		my $count = 0;
		$clauses = [$clauses] unless (ref($clauses) eq 'ARRAY');
		foreach my $clause (@$clauses) {
			my $field_count = 0;
			foreach my $field (keys %$clause) {
				my $logical_op = 'AND';
				my $compare_op = '=';
				my $untouched_field = $field;
				while ($field =~ s/^(\&|\!|\|)//) {
					$_ = $1;
					$self->print_debug('multiple key/value pairs used with operators', 'WARNING') if $field_count;
					SWITCH: {
						if (/\&/)	{ $logical_op = 'AND';  last SWITCH; }
						if (/\|/)	{ $logical_op = 'OR';	last SWITCH; }
						if (/\!/)	{ $compare_op = '!=';	last SWITCH; }
					}
				}
				my $value = $clause->{$untouched_field};
				my $rvalue_quoting = 1;
				while ($value =~ s/^(\?)//) {
					$rvalue_quoting = 0;
				}
				$value = $self->{dbh}->quote($value) if $rvalue_quoting;
				$where .= " $logical_op " if ($where);
				$where .= ' ' unless ($count or $where);
				$where .= '(' unless $count;
				$where .= "$field $compare_op $value";
				$field_count++;
				$count++;
			}
		}
		$where .= ')';
	}

	$sql .= ' WHERE'.$where;

	if (ref $rules eq 'HASH') {
		foreach my $rule (keys %$rules) {
			$sql .= " $rule $rules->{$rule}";
		}
	}

	$self->print_debug($sql, 'SQL');
	return ($self->{dbh}->do($sql) || return $self->set_error('DATABASE'));
}
####################################################################################################

### update_fields(); ###############################################################################

=pod

=head2 update_fields($table, $fields, $criteria);

=over 4

=item * I<summary>

Update fields in $table with the specified criteria

=item * I<arguments>

 $table		- table to update fields for
 $fields	- hashref containing keys that match up to the database to be updated with corresponding values.
 $criteria	- arrayref of arrayrefs of hashref's containing criteria for where clause.  keys should be the left side of the equals and values the right.

=item * I<sample>



=item * I<return value>



=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub update_fields {
        my $self = shift;
	my $table = shift;
	my $fields = shift;
	my $criteria = shift;
	my $rules = shift;

	$self->print_debug('called from '.(caller 1)[3]);

	my $sql = "UPDATE $table SET ";

	foreach my $field (keys %$fields) {
		my $value = $fields->{$field};
		my $rvalue_quoting = 1;
		while ($value =~ s/^(\?)//) {
			$rvalue_quoting = 0;
		}
		$value = $self->{dbh}->quote($value) if $rvalue_quoting;
		$sql .= "$field = $value, ";
	}
	$sql =~ s/(, )*$//;

	my $where;
	$criteria = [[$criteria]] unless (ref($criteria) eq 'ARRAY');
	foreach my $clauses (@$criteria) {
		my $count = 0;
		$clauses = [$clauses] unless (ref($clauses) eq 'ARRAY');
		foreach my $clause (@$clauses) {
			my $field_count = 0;
			foreach my $field (keys %$clause) {
				my $logical_op = 'AND';
				my $compare_op = '=';
				my $untouched_field = $field;
				while ($field =~ s/^(\&|\!|\|)//) {
					$_ = $1;
					$self->print_debug('multiple key/value pairs used with operators', 'WARNING') if $field_count;
					SWITCH: {
						if (/\&/)	{ $logical_op = 'AND';  last SWITCH; }
						if (/\|/)	{ $logical_op = 'OR';	last SWITCH; }
						if (/\!/)	{ $compare_op = '!=';	last SWITCH; }
					}
				}
				my $value = $clause->{$untouched_field};
				my $rvalue_quoting = 1;
				while ($value =~ s/^(\?)//) {
					$rvalue_quoting = 0;
				}
				$value = $self->{dbh}->quote($value) if $rvalue_quoting;
				$where .= " $logical_op " if ($where);
				$where .= ' ' unless ($count or $where);
				$where .= '(' unless $count;
				$where .= "$field $compare_op $value";
				$field_count++;
				$count++;
			}
		}
		$where .= ')';
	}

	$sql .= ' WHERE'.$where;

	if (ref $rules eq 'HASH') {
		foreach my $rule (keys %$rules) {
			$sql .= " $rule $rules->{$rule}";
		}
	}

	$self->print_debug($sql, 'SQL');
	return ($self->{dbh}->do($sql) || return $self->set_error('DATABASE'));
}
####################################################################################################

### select_count(); ################################################################################

=pod

=head2 select_count();

=over 4

=item * I<summary>



=item * I<arguments>

 $ - 

=item * I<sample>

 

=item * I<return value>



=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub select_count {
        my $self = shift;
	my $table = shift;
	my $criteria = shift;

	$self->print_debug('called from '.(caller 1)[3]);

	my $sql = "SELECT COUNT(*) FROM $table";

	my $where;
	$criteria = [[$criteria]] unless (ref($criteria) eq 'ARRAY');
	foreach my $clauses (@$criteria) {
		my $count = 0;
		$clauses = [$clauses] unless (ref($clauses) eq 'ARRAY');
		foreach my $clause (@$clauses) {
			my $field_count = 0;
			foreach my $field (keys %$clause) {
				my $logical_op = 'AND';
				my $compare_op = '=';
				my $untouched_field = $field;
				while ($field =~ s/^(\&|\!|\|)//) {
					$_ = $1;
					$self->print_debug('multiple key/value pairs used with operators', 'WARNING') if $field_count;
					SWITCH: {
						if (/\&/)	{ $logical_op = 'AND';  last SWITCH; }
						if (/\|/)	{ $logical_op = 'OR';	last SWITCH; }
						if (/\!/)	{ $compare_op = '!=';	last SWITCH; }
					}
				}
				my $value = $clause->{$untouched_field};
				my $rvalue_quoting = 1;
				while ($value =~ s/^(\?)//) {
					$rvalue_quoting = 0;
				}
				$value = $self->{dbh}->quote($value) if $rvalue_quoting;
				$where .= " $logical_op " if ($where);
				$where .= ' ' unless ($count or $where);
				$where .= '(' unless $count;
				$where .= "$field $compare_op $value";
				$field_count++;
				$count++;
			}
		}
		$where .= ')';
	}

	$sql .= ' WHERE'.$where;
	$self->print_debug($sql, 'SQL');
	my $sth = $self->{dbh}->prepare($sql);
	$sth->execute || return $self->set_error('DATABASE');

	return ($sth->fetchrow_array);
}
####################################################################################################

### print_debug(); #################################################################################

=pod

=head2 print_debug($string, $type);

=over 4

=item * I<summary>

used to print debug code to STDERR.  The format is "LINE: PACKAGE::method: $type: $string".
$type is an optional argument and is ommited if left blank.  While this method was originally
designed to be used within the module, it could be used from the code using the module as well.

=item * I<arguments>

 $string	- the debug message
 $type		- the optional argument that is the type of debug message such as 'SQL'.

=item * I<sample>

 $sql = 'SELECT * FROM table';
 $self->print_debug($sql, 'SQL');
 # SQL execute code

=item * I<return value>

C<$self->{success}>

=item * I<possible errors>

none

=back

=cut

sub print_debug {
	my $self = shift;
	my $string = shift;
	my $type = shift;
	print STDERR ''.(caller 0)[2].': '.(caller 1)[3].( $type ? ": $type" : '' ).': '.$string."\n" if $self->{debug};
	return $self->{success};
}
####################################################################################################

### print_error(); #################################################################################

=pod

=head2 print_error($string, $type);

=over 4

=item * I<summary>

used to print error to STDERR.  The format is "LINE: PACKAGE::method: $type: $string".
$type is an optional argument and is ommited if left blank.  While this method was originally
designed to be used within the module, it could be used from the code using the module as well.

=item * I<arguments>

 $string	- the error message
 $type		- the optional argument that is the type of error message such as 'SQL'.

=item * I<sample>

 $radius->print_error("Unable to find user $user") unless (user_exists($user));

=item * I<return value>

C<$self->{success}>

=item * I<possible errors>

none

=back

=cut

sub print_error {
	my $self = shift;
	my $string = shift;
	my $type = shift;
	print STDERR ''.(caller 0)[2].': '.(caller 1)[3].( $type ? ": $type" : '' ).': '.$string."\n";
	return $self->{success};
}
####################################################################################################

### set_error(); ###################################################################################

=pod

=head2 set_error($error);

=over 4

=item * I<summary>

sets the current error to the specified error

=item * I<arguments>

 $error - error number or error label to set error to

=item * I<sample>

 return $self->set_error('ITEM_NOT_FOUND') unless $found; 

=item * I<return value>

$self->{failure}

=item * I<possible errors>

 DATABASE - Internal Database/SQL Syntax Error

=back

=cut

sub set_error {
        my $self = shift;
	$_ = shift;

	if (/^-{0,1}\d+$/) {
		$self->{error_label} = $self->{errors}->{$_};
	 } else {
		$self->{error_label} = $_;
	}

	$self->{error_number} = $self->{errors}->{$self->{error_label}}->{number};
	$self->{error_string} = $self->{errors}->{$self->{error_label}}->{string};

	return $self->{failure};
}
####################################################################################################

1;
