package RideLogicACL; use strict; #use RideLogic; #use RideLogicAPIQueryWrapper; use POSIX; require Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = "0.01"; @ISA = qw( Exporter ); @EXPORT = qw( ); @EXPORT_OK = qw( ); %EXPORT_TAGS = ( DEFAULT => [ qw( ) ] ); my $PACKAGE_NAME = "RideLogicACL"; ##### sub new { my $class_name = shift; my $rldbh = shift; my %acl; $acl{aro_ref} = {}; $acl{aco_ref} = {}; $acl{aro_aco_ref} = {}; my $class = {}; $class->{acl_ref} = \%acl; $class->{dbh_ref} = \$rldbh; bless($class, $class_name); $class->get_tree(); return $class; } ##### sub print_debug { my $self = shift; my $acl_href = $self->{acl_href}; my $aros_href = $acl_href->{aros_href}; my $acos_href = $acl_href->{acos_href}; my $aros_acos_href = $acl_href->{aros_acos_href}; print "aros:\n"; foreach my $k (keys(%{$aros_href})) { print "$k " . $aros_href->{$k} . "\n"; } print "\n"; print "acos:\n"; foreach my $k (keys(%{$acos_href})) { print "$k " . $acos_href->{$k} . "\n"; } print "\n"; print "aros_acos:\n"; foreach my $k (keys(%{$aros_acos_href})) { print "$k " . $aros_acos_href->{$k} . "\n"; } } ##### sub print_formatted_acl_table { my $self = shift; my $type = shift; return undef if !($type =~ /^(aros|acos|aros_acos)$/); my $rldbh = ${$self->{dbh_ref}}; my $query = $rldbh->prepare(" select * from rlapi_" . $type . " order by lft asc"); $query->execute(); my @s; while (my $row = $query->fetchrow_hashref) { my $id = $row->{id}; my $lft = $row->{lft}; my $rght = $row->{rght}; my $alias = $row->{alias}; if (scalar(@s)) { while ( (scalar(@s)>0) && ($s[scalar(@s)-1] < $rght) ) { pop @s; } } print " " x (scalar(@s)*2) . "($id)[$lft,$rght] $alias\n"; push @s, $rght; } } ##### sub print_acl_tree { my $self = shift; $self->print_formatted_acl_table("aros"); print "\n\n"; $self->print_formatted_acl_table("acos"); print "\n\n"; my $rldbh = ${$self->{dbh_ref}}; my $query = $rldbh->prepare("select id, aros_id, acos_id from rlapi_aros_acos order by id asc"); $query->execute(); while (my $row = $query->fetchrow_arrayref) { my ($id, $aros_id, $acos_id) = ($row->[0], $row->[1], $row->[2]); print "[$id] ($aros_id, $acos_id)\n"; } print "\n\n"; } ##### sub get_tree { my $self = shift; my $rldbh = ${$self->{dbh_ref}}; $self->{acl_href} = {}; my $acl_href = $self->{acl_href}; $acl_href->{aros_href} = {}; $acl_href->{acos_href} = {}; $acl_href->{aros_acos_href} = {}; my $aros_href = $acl_href->{aros_href}; my $acos_href = $acl_href->{acos_href}; my $aros_acos_href = $acl_href->{aros_acos_href}; my $query = $rldbh->prepare("select id, lft, rght, alias from rlapi_aros order by lft asc"); $query->execute(); my @rght_stack; my @alias_stack; while (my $row = $query->fetchrow_hashref) { my $id = $row->{id}; my $lft = $row->{lft}; my $rght = $row->{rght}; my $alias = $row->{alias}; if (scalar(@rght_stack)) { while ( (scalar(@rght_stack)>0) && ($rght_stack[scalar(@rght_stack)-1] < $rght) ) { pop @rght_stack; pop @alias_stack; } } push @rght_stack, $rght; push @alias_stack, $alias; $aros_href->{ join('/', @alias_stack) } = $id; } my $query = $rldbh->prepare("select id, lft, rght, alias from rlapi_acos order by lft asc"); $query->execute(); @rght_stack = (); @alias_stack = (); while (my $row = $query->fetchrow_hashref) { my $id = $row->{id}; my $lft = $row->{lft}; my $rght = $row->{rght}; my $alias = $row->{alias}; if (scalar(@rght_stack)) { while ( (scalar(@rght_stack)>0) && ($rght_stack[scalar(@rght_stack)-1] < $rght) ) { pop @rght_stack; pop @alias_stack; } } push @rght_stack, $rght; push @alias_stack, $alias; $acos_href->{ join('/', @alias_stack) } = $id; } my $query = $rldbh->prepare("select aros_id, acos_id from rlapi_aros_acos "); $query->execute(); while (my $row = $query->fetchrow_arrayref) { $aros_acos_href->{ $row->[0] . ":" . $row->[1] } = 1; } } ##### sub rlapi_acl_get_effective_id { my $ao = shift; my $ao_href = shift; $ao =~ s/^\/*//; my @a = split(/\//, $ao); while (scalar(@a)>0) { my $s = join('/', @a); if (defined($ao_href->{$s})) { return $ao_href->{$s}; } pop @a; } return undef; } ##### sub get_aro_id { my $self = shift; my $aro = shift; my $acl_href = $self->{acl_href}; return rlapi_acl_get_effective_id( $aro, $acl_href->{aros_href} ); } ##### sub get_real_aro_id { my $self = shift; my $aro = shift; $aro =~ s/^\///; my $acl_href = $self->{acl_href}; my $href = $acl_href->{aros_href}; return $href->{$aro}; } ##### sub get_aco_id { my $self = shift; my $aco = shift; my $acl_href = $self->{acl_href}; return rlapi_acl_get_effective_id( $aco, $acl_href->{acos_href} ); } ##### sub get_real_aco_id { my $self = shift; my $aco = shift; $aco =~ s/^\///; my $acl_href = $self->{acl_href}; my $href = $acl_href->{acos_href}; return $href->{$aco}; } ##### # inefficient method. need to update this to have # a local version of the tree for efficient collection sub get_aro_aco_subtree_by_aro { my $self = shift; my $aro = shift; my $aco_root = shift; $aro =~ s/^\///; $aco_root =~ s/^\///; my $acl_href = $self->{acl_href}; my $aros_href = $acl_href->{aros_href}; my $acos_href = $acl_href->{acos_href}; my $aros_acos_href = $acl_href->{aros_acos_href}; my @res; my $aco_root_len = length($aco_root); my $aro_id = rlapi_acl_get_effective_id($aro, $aros_href); foreach my $k (keys(%$acos_href)) { my $sub_aco = substr($k, 0, $aco_root_len); next if $sub_aco ne $aco_root; my $aco_id = rlapi_acl_get_effective_id($k, $acos_href); push @res, $k if $aros_acos_href->{ $aro_id . ":" . $aco_id }; } return @res; } ##### sub get_aro_aco_subtree_by_aco { my $self = shift; my $aro_root = shift; my $aco = shift; $aro_root =~ s/^\///; $aco =~ s/^\///; my $acl_href = $self->{acl_href}; my $aros_href = $acl_href->{aros_href}; my $acos_href = $acl_href->{acos_href}; my $aros_acos_href = $acl_href->{aros_acos_href}; my @res; my $aro_root_len = length($aro_root); my $aco_id = rlapi_acl_get_effective_id($aco, $acos_href); foreach my $k (keys(%$aros_href)) { my $sub_aro = substr($k, 0, $aro_root_len); next if $sub_aro ne $aro_root; my $aro_id = rlapi_acl_get_effective_id($k, $aros_href); push @res, $k if $aros_acos_href->{ $aro_id . ":" . $aco_id }; } return @res; } ##### sub has_permission { my $self = shift; my $aro = shift; my $aco = shift; my $acl_href = $self->{acl_href}; my $aros_href = $acl_href->{aros_href}; my $acos_href = $acl_href->{acos_href}; my $aros_acos_href = $acl_href->{aros_acos_href}; my $aro_id = rlapi_acl_get_effective_id($aro, $aros_href); my $aco_id = rlapi_acl_get_effective_id($aco, $acos_href); return $aros_acos_href->{ $aro_id . ":" . $aco_id }; } ##### sub insert_aro { my $self = shift; my $aro = shift; $aro =~ s/^\/*//; my $rldbh = ${$self->{dbh_ref}}; my $acl_href = $self->{acl_href}; my $aros_href = $acl_href->{aros_href}; return undef if ($aros_href->{$aro}); my $foreign_key = undef; my @a = split(/\//, $aro); my $aro_alias = pop @a; if (scalar(@a)==0) { my $query = $rldbh->prepare("call rlapi_aros_insert( 1, ?, ?)"); my $r = $query->execute($foreign_key, $aro_alias); my $tquery = $rldbh->prepare("select last_insert_id()"); my $r = $tquery->execute(); my $trow = $tquery->fetchrow_arrayref; my $id = $trow->[0]; $self->get_tree(); return $id; } my $parent_aro = join('/', @a); return undef if (!$aros_href->{$parent_aro}); my $parent_id = $aros_href->{$parent_aro}; my $query = $rldbh->prepare("call rlapi_aros_insert_under( ?, ?, ?)"); my $r = $query->execute($parent_id, $foreign_key, $aro_alias); #my $id = $rldbh->last_insert_id(); my $tquery = $rldbh->prepare("select last_insert_id()"); $tquery->execute(); my $trow = $tquery->fetchrow_arrayref; my $id = $trow->[0]; $self->get_tree(); return $id; } ##### sub insert_aco { my $self = shift; my $aco = shift; $aco =~ s/^\/*//; my $rldbh = ${$self->{dbh_ref}}; my $acl_href = $self->{acl_href}; my $acos_href = $acl_href->{acos_href}; return undef if ($acos_href->{$aco}); my $foreign_key = undef; my @a = split(/\//, $aco); my $aco_alias = pop @a; if (scalar(@a)==0) { my $query = $rldbh->prepare("call rlapi_acos_insert( 1, ?, ?)"); $query->execute($foreign_key, $aco_alias); #my $id = $rldbh->last_insert_id(undef, undef, undef, undef); my $tquery = $rldbh->prepare("select last_insert_id()"); $tquery->execute(); my $trow = $tquery->fetchrow_arrayref; my $id = $trow->[0]; $self->get_tree(); return $id; } my $parent_aco = join('/', @a); return undef if (!$acos_href->{$parent_aco}); my $parent_id = $acos_href->{$parent_aco}; my $query = $rldbh->prepare("call rlapi_acos_insert_under( ?, ?, ?)"); $query->execute($parent_id, $foreign_key, $aco_alias); #my $id = $rldbh->last_insert_id(); my $tquery = $rldbh->prepare("select last_insert_id()"); $tquery->execute(); my $trow = $tquery->fetchrow_arrayref; my $id = $trow->[0]; $self->get_tree(); return $id; } ##### sub insert_aros_acos { my $self = shift; my $aro = shift; my $aco = shift; $aro =~ s/^\///; $aco =~ s/^\///; my $rldbh = ${$self->{dbh_ref}}; my $acl_href = $self->{acl_href}; my $aros_href = $acl_href->{aros_href}; my $acos_href = $acl_href->{acos_href}; my $aros_acos_href = $acl_href->{aros_acos_href}; my $aro_id = $aros_href->{$aro}; my $aco_id = $acos_href->{$aco}; return undef if !$aro_id or !$aco_id; my $query = $rldbh->prepare("select count(id) from rlapi_aros_acos where aros_id = ? and acos_id = ?"); $query->execute($aro_id, $aco_id); return undef if $query->fetchrow_arrayref->[0]; my $query = $rldbh->prepare("insert into rlapi_aros_acos (aros_id, acos_id) values (?, ?)"); $query->execute($aro_id, $aco_id); my $tquery = $rldbh->prepare("select last_insert_id()"); $tquery->execute(); my $trow = $tquery->fetchrow_arrayref; my $id = $trow->[0]; $self->get_tree(); return $id; } ##### sub remove_aro_id { my $self = shift; my $aro_id = shift; my $rldbh = ${$self->{dbh_ref}}; my $query = $rldbh->prepare("call rlapi_aros_delete(?)"); $query->execute($aro_id); $self->get_tree(); return 1; } ##### sub remove_aco_id { my $self = shift; my $aco_id = shift; my $rldbh = ${$self->{dbh_ref}}; my $query = $rldbh->prepare("call rlapi_acos_delete(?)"); $query->execute($aco_id); $self->get_tree(); return 1; } ##### sub remove_aro_aco_id { my $self = shift; my $aro_id = shift, my $aco_id = shift; my $rldbh = ${$self->{dbh_ref}}; my $query = $rldbh->prepare("delete from rlapi_aros_acos where aros_id = ? and acos_id = ?"); $query->execute($aro_id, $aco_id); $self->get_tree(); return 1; } ##### sub remove_aro { my $self = shift; my $aro = shift; $aro =~ s/\///; my $rldbh = ${$self->{dbh_ref}}; my $acl_href = $self->{acl_href}; my $aros_href = $acl_href->{aros_href}; return undef if !$aros_href->{$aro}; my $query = $rldbh->prepare("call rlapi_aros_delete(?)"); $query->execute($aros_href->{$aro}); $self->get_tree(); return 1; } ##### sub remove_aco { my $self = shift; my $aco = shift; $aco =~ s/\///; my $rldbh = ${$self->{dbh_ref}}; my $acl_href = $self->{acl_href}; my $acos_href = $acl_href->{acos_href}; return undef if !$acos_href->{$aco}; my $query = $rldbh->prepare("call rlapi_acos_delete(?)"); $query->execute($acos_href->{$aco}); $self->get_tree(); return 1; } ##### sub remove_aros_acos { my $self = shift; my $aro = shift; my $aco = shift; $aro =~ s/^\///; $aco =~ s/^\///; my $rldbh = ${$self->{dbh_ref}}; my $acl_href = $self->{acl_href}; my $aros_href = $acl_href->{aros_href}; my $acos_href = $acl_href->{acos_href}; my $aros_acos_href = $acl_href->{aros_acos_href}; my $aro_id = $aros_href->{$aro}; my $aco_id = $acos_href->{$aco}; return undef if !$aro_id or !$aco_id; my $query = $rldbh->prepare("delete from rlapi_aros_acos where aros_id = ? and acos_id = ?"); $query->execute($aro_id, $aco_id); return 1; } return 1;