#/usr/bin/perl
# funclib.pl version 2.5c
# Jun 12/2001

use IMAP::Admin;
use IMAP::Sieve;

$IMAPERROR='';
$SIEVEERROR='';

sub openimap {
	my ($uid,$pass,$server,$port,$ssl,$separator)=@_;
	my $err;
	$IMAPERROR='';
	undef $imap;
	$port='143' if !$port;
	$separator='.' if !$separator;
	if ($ssl) {
		eval {$imap=IMAP::Admin->new('Server'=>$server,'Login'=>$uid,'Password'=>$pass,'Port'=>$port,'SSL'=>$ssl,'Separator'=>$separator)};
	}
	else {
		eval {$imap=IMAP::Admin->new('Server'=>$server,'Login'=>$uid,'Password'=>$pass,'Port'=>$port,'Separator'=>$separator)};
	}
	$err=$imap->{'Error'};
	if ($err) {
		return $imap if $err =~/No Errors/i;
		$IMAPERROR=$err;
		return;
	}
	return $imap;
}
	
sub closeimap {
	 if ($imap) {
	 eval {$imap->close}};
	 undef $imap;
}

sub listmailbox {
   	my ($mbx) = @_;
   	@mbx=$imap->list($mbx);
	$IMAPERROR=$imap->{'Error'} if !defined @mbx;
   	return (@mbx);
}   	
   	
	
	
sub getquota {
	my ($mbx) = @_;	
	@tmp=eval {$imap->get_quotaroot($mbx)};
	$IMAPERROR=$imap->{'Error'} unless (defined(@tmp) && scalar(@tmp) > 1);
	return  unless (defined(@tmp) && scalar(@tmp) > 1);
#recreate array and remove extra spaces - fixes array properly
#	@tmp=($tmp[3],$tmp[4],$tmp[5]);
	return @tmp;
       	
}


sub getacl {
	my ($mbx) = @_;
	@acl=$imap->get_acl($mbx);
	return(@acl);
}

sub setacl {
	my ($mbx,$user,$acl)=@_;
	my $err;
	$err=$imap->set_acl("$mbx",$user,$acl);
	if ($err) {
		$err=$imap->{'Error'};
		return $err;
	}
	return;
}

	
sub setquota {
	my ($mbx,$quota) = @_;
	my $err=eval {$imap->set_quota("$mbx",$quota)};
	if ($err) {
		$err=$imap->{'Error'};
		return $err;
	}
	return;
}	       	

sub createmailbox {
	my ($mbx,$partition) = @_;
	if ($partition) {
		my $err=$imap->create($mbx,$partition);
	} else {
		$err=$imap->create($mbx);
	}
	
	if ($err) {
		$err=$imap->{'Error'};
		return $err;
	}
	return;
}

sub deletemailbox {
	my ($mbx) = @_;
	my $err=$imap->delete("$mbx");
	if ($err) {
		$err=$imap->{'Error'};
		return $err;
	}
	return;
}

sub opensieve {
	my ($uid,$pass,$port,$server,$ssl)=@_;
	$SIEVEERROR='';
	if ($ssl) {
		eval {$sieve=IMAP::Sieve->new('Proxy'=>$proxy,'Port'=>$port,'Server'=>$server,'Login'=>$uid,'Password'=>$pass,'SSL'=>$ssl)};
	}
	else {
		eval {$sieve=IMAP::Sieve->new('Proxy'=>$proxy,'Port'=>$port,'Server'=>$server,'Login'=>$uid,'Password'=>$pass)};
	}
	my $err=$sieve->{'Error'};
	if ($err) {
		return $sieve if $err =~/No Errors/i;
		$SIEVEERROR=$err;
		return '';
	}
	return $sieve;
	
	
}
	
sub closesieve {
	 if ($sieve) {$sieve->close};
	 undef $sieve;
}

sub listscripts {
   	@scripts=$sieve->listscripts;
   	return @scripts;
}   	
   	
sub getscript {
	my ($scriptname) = @_;
	my ($script);
	$script=$sieve->getscript($scriptname);
	$SIEVEERROR=$sieve->{'Error'};
	$SIEVEERROR='' if $SIEVEERROR=~/No Errors/i;
	return $script;

}

sub putscript {
	my ($scriptname,$script) = @_;
	$res=$sieve->putscript($scriptname,$script);
	my @scripts=$sieve->listscripts;
	if ($res) { 
		$res=$sieve->{'Error'};
		print "res=$res<br>";
		return $res;	
	}
	return;
}
	
sub setactive {
	my ($script)=@_;
	$res=$sieve->setactive($script);
	if ($res) { 
		$res= $sieve->{'Error'};
		return $res;
	}
	return;
}
	
sub noop {
	$test=$sieve->noop;
	return;
}

sub deletescript {
	my ($script)=@_;
	$res=$sieve->deletescript($script);
	if ($res) {
		$res= $sieve->{'Error'};
		return $res;
	}
	return;
}
	
1;


syntax highlighted by Code2HTML, v. 0.9.1