CVS: macs/lib/MACS GMA.pm,NONE,1.1

[Mario D. S. <sa...@us...>]

Update of /cvsroot/macs/macs/lib/MACS
In directory usw-pr-cvs1:/tmp/cvs-serv13705/lib/MACS

Added Files:
	GMA.pm 
Log Message:
wrote the gma cgi and .pm
updated README & Makefile w/ new HTML::Mason perl module requirement
updated INSTALL with new apache configuration info
created a groups-as-resource hierarchy in macs.sql.{mysql,pgsql}


--- NEW FILE: GMA.pm ---
package MACS::GMA;

# $Id: GMA.pm,v 1.1 2002/04/30 07:03:04 santana Exp $
# The Group Management Agent perl module
# 
# Does all the low-level work so upper-level libs don't have to.

use strict;
use MACS::Config;
use DBI;

sub new {
    my($dbh) = DBI->connect($cfg{db}{d}, $cfg{db}{l}, $cfg{db}{p});
    $dbh->{RaiseError} = 1;
    #my($sth) = $dbh->prepare_cached($cfg{'sql GMA'}{get_member_groups});
    #$sth = $dbh->prepare_cached($cfg{'sql GMA'}{get_member_users});
    #$sth = $dbh->prepare_cached($cfg{'sql GMA'}{get_gres_root});
    #$sth = $dbh->prepare_cached($cfg{'sql GMA'}{get_gres_children});

    my($this) = { RMA_URL => "/rma",
		  cfg => \%cfg,
		  dbh => $dbh,
		  #sth => $sth
		  };
    bless $this;
    return $this;
} # sub new

sub DESTROY {
    my($this) = (shift);
    $this->{dbh}->disconnect;
} # sub DESTROY

sub get_member_users {
    my($this,$g) = (shift,shift);
    my($membs) = [];
    my($id,$name);

    my($sth) = $this->{dbh}->prepare($cfg{'sql GMA'}{get_member_users});
    $sth->bind_param(1,$g);
    $sth->execute;
    $sth->bind_col(1,\$id);
    $sth->bind_col(2,\$name);
    while ($sth->fetch) {
	push(@$membs, {id=>$id, name=>$name});
    }
    return $membs;
} # sub get_member_users

sub get_member_groups {
    my($this,$g) = (shift,shift);
    my($membs) = [];
    my($id,$name);

    my($sth) = $this->{dbh}->prepare($cfg{'sql GMA'}{get_member_groups});
    $sth->bind_param(1,$g);
    $sth->execute;
    $sth->bind_col(1,\$id);
    $sth->bind_col(2,\$name);
    while ($sth->fetch) {
	push(@$membs, {id=>$id, name=>$name});
    }
    return $membs;
} # sub get_member_groups

sub get_groups {
    my($this) = (shift);
    my($aryref) = [];
    my($id,$name);

    my($sth) = $this->{dbh}->prepare($cfg{'sql GMA'}{get_groups});
    $sth->execute;
    $sth->bind_col(1,\$id);
    $sth->bind_col(2,\$name);
    while ($sth->fetch) {
	push(@$aryref, {id=>$id, name=>$name});
    }
    return $aryref;
} # sub get_groups

sub get_users {
    my($this) = (shift);
    my($aryref) = [];
    my($id,$name);

    my($sth) = $this->{dbh}->prepare($cfg{'sql GMA'}{get_users});
    $sth->execute;
    $sth->bind_col(1,\$id);
    $sth->bind_col(2,\$name);
    while ($sth->fetch) {
	push(@$aryref, {id=>$id, name=>$name});
    }
    return $aryref;
} # sub get_users

sub remove_group_member {
    my($this,$gmid,$gid) = (shift,shift,shift);

    my($sth) = $this->{dbh}->prepare($cfg{'sql GMA'}{remove_group_member});
    $sth->bind_param(1,$gmid);
    $sth->bind_param(2,$gid);
    return $sth->execute;
} # sub remove_group_member

sub add_group_member {
    my($this,$ngid,$gid) = (shift,shift,shift);

    my($sth) = $this->{dbh}->prepare($cfg{'sql GMA'}{add_group_member});
    $sth->bind_param(1,$ngid);
    $sth->bind_param(2,$gid);
    return $sth->execute;
} # sub add_group_member

sub remove_user_member {
    my($this,$umid,$uid) = (shift,shift,shift);

    my($sth) = $this->{dbh}->prepare($cfg{'sql GMA'}{remove_user_member});
    $sth->bind_param(1,$umid);
    $sth->bind_param(2,$uid);
    return $sth->execute;
} # sub remove_user_member

sub add_user_member {
    my($this,$nuid,$uid) = (shift,shift,shift);

    my($sth) = $this->{dbh}->prepare($cfg{'sql GMA'}{add_user_member});
    $sth->bind_param(1,$nuid);
    $sth->bind_param(2,$uid);
    return $sth->execute;
} # sub add_user_member

sub get_user_info {
    my($this,$uid) = (shift,shift);
    my($login,$name,$email);

    my($sth) = $this->{dbh}->prepare($cfg{'sql GMA'}{get_user_info});
    $sth->bind_param(1,$uid);
    $sth->execute;
    $sth->bind_col(1,\$login);
    $sth->bind_col(2,\$name);
    $sth->bind_col(3,\$email);
    $sth->fetch;
    my($hashref) = { login => $login,
		     name => $name,
		     email => $email };
    return $hashref;
} # sub get_user_info

sub get_groups_as_resources {
    my($this,$g) = (shift,shift);
    #my(%cfg) = %{$this->{cfg}};
    my($aryref) = [];
    my($sth,$id,$name);

    if (!defined($g) || $g == '') {
	$sth = $this->{dbh}->prepare($cfg{'sql GMA'}{get_gres_root});
	$sth->execute;
	$sth->bind_col(1,\$id);
	if (!$sth->fetch) {
	    return [];
	}
	$g = $id;
    }
    
    $sth = $this->{dbh}->prepare($cfg{'sql GMA'}{get_gres_children});
    $sth->bind_param(1,$g);
    $sth->execute;
    $sth->bind_col(1,\$id);
    $sth->bind_col(2,\$name);
    while ($sth->fetch) {
	push(@$aryref, { name => $name,
			 id => $id,
			 children => $this->get_groups_as_resources($id)
			 }
	     );
    }
    return $aryref;
} # sub get_groups_as_resources

sub get_group_members {
    my($this,$g) = (shift,shift);
    my(@rv) = ();
    push @rv, { name => 'groupa',
		parent => '/groups',
		children => [] };
    push @rv, { name => 'groupb',
		parent => '/groups',
		children => [ { name => 'suba',
				parent => '/groups/groupb',
				children => [] },
			      { name => 'subb',
				parent => '/groups/groupb',
				children => [] } 
			      ] };
    push @rv, { name => 'groupc',
		parent => '/groups',
		children => [] };

    return @rv;
} # sub get_group_members

1;