popufare/server/scripts/RideLogicACL.pm

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;