home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / fcn-grp.pl < prev    next >
Text File  |  2009-11-06  |  4KB  |  136 lines
  1. # FILE: fcn-grp.pl
  2. # DESCRIPTION: Group Manipulation Functions (groups.txt)
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### check_group_authorization
  20. ###
  21. ### Checks to see if $moderator is authorized to edit $group
  22. ###
  23.  
  24. sub check_group_authorization {
  25.     my ($moderator, $group, $file_in) = @_;
  26.     return 1 if $moderator eq $DCONF->{superuser};
  27.     if (! defined $file_in) {
  28.         $file_in = read_group_file();
  29.     }
  30.     return $file_in->{by_mod}->{$moderator}->{$group};
  31. }
  32.  
  33. ###
  34. ### read_group_file
  35. ###
  36. ### Low-level reading of the groups.txt file
  37. ###
  38.  
  39. sub read_group_file {
  40.     my ($no_lock) = @_;
  41.     my $file = $no_lock == 1 ? readfile("$DCONF->{admin_dir}/groups.txt", "read_group_file", { no_lock => 1, no_unlock => 1, zero_ok => 1 }) : readfile("$DCONF->{admin_dir}/groups.txt", "read_group_file", { zero_ok => 1 });
  42.     undef my $result;
  43.     foreach my $line (@{ $file }) {
  44.         chomp $line;
  45.         my ($grp, $mods) = split(/:/, $line);
  46.         next if $grp eq "#";
  47.         next if $grp !~ m|\S|;
  48.         my @mods = split(/,/, $mods);
  49.         push (@{ $result->{group_list} }, $grp);
  50.         foreach my $mod (@mods) {
  51.             $result->{by_mod}->{$mod}->{$grp} = 1;
  52.             $result->{by_grp}->{$grp}->{$mod} = 1;
  53.         }
  54.     }
  55.     return $result;
  56. }
  57.  
  58. ###
  59. ### write_group_file
  60. ###
  61. ### Low-level writing of the groups.txt file based on a list of "actions"
  62. ###
  63.  
  64. sub write_group_file {
  65.     my ($actions) = @_;
  66.     my @newfile = ();
  67.     my @newgroups = ();
  68.     undef my $classify;
  69.     foreach my $action (@{ $actions }) {
  70.         my ($gr, $a, $m) = ($action->{group}, $action->{action}, $action->{moderator});
  71.         foreach my $g (split(/,/, $gr)) {
  72.             if ($a eq "add_group") {
  73.                 push (@newgroups, $g);
  74.             } elsif ($a eq "del_group") {
  75.                 $classify->{$g}->{del} = 1;
  76.             } elsif ($a eq "set_equal") {
  77.                 $classify->{$g}->{modequals} = $m;
  78.             } else {
  79.                 foreach my $md (split(/,/, $m)) {
  80.                     if ($a eq "add_mod") {
  81.                         $classify->{$g}->{modadd}->{$md} = 1;
  82.                     } elsif ($a eq "del_mod") {
  83.                         $classify->{$g}->{moddel}->{$md} = 1;
  84.                     }
  85.                 }
  86.             }
  87.         }
  88.     }
  89.     my $file = readfile("$DCONF->{admin_dir}/groups.txt", "write_group_file", { no_unlock => 1, zero_ok => 1 });
  90.     my $c = 0;
  91.     undef my $groups;
  92.     foreach my $line (@{ $file }) {
  93.         my $line_manip = $line; chomp $line_manip;
  94.         my ($grp, $mods) = split(/:/, $line_manip);
  95.         if ($grp eq "#") {
  96.             push (@newfile, $line); next;
  97.         }
  98.         if ($grp !~ m|\S|) {
  99.             next;
  100.         }
  101.         if (defined $classify->{$grp}->{modequals}) {
  102.             push (@newfile, "$grp:$classify->{$grp}->{modequals}\n");
  103.             next;
  104.         }
  105.         if ($classify->{$grp}->{del}) {
  106.             $c += 1; next;
  107.         }
  108.         my @mods = split(/,/, $mods);
  109.         undef my @modsnew;
  110.         foreach my $m (@mods) {
  111.             next if $classify->{$grp}->{moddel}->{$m};
  112.             next if $classify->{$grp}->{modadd}->{$m};
  113.             next if $classify->{"*"}->{moddel}->{$m};
  114.             push (@modsnew, $m);
  115.         }
  116.         foreach my $k (keys(%{ $classify->{$grp}->{modadd} })) {
  117.             push (@modsnew, $k);
  118.         }
  119.         $mods = join(",", sort @modsnew);
  120.         $line_manip = join(":", $grp, $mods);
  121.         $line_manip .= "\n";
  122.         push (@newfile, $line_manip);
  123.         $groups->{$grp} = 1;
  124.     }
  125.     foreach my $i (@newgroups) {
  126.         if (! $groups->{$i} ) {
  127.             push (@newfile, "$i:$DCONF->{superuser}\n");
  128.             $c += 1;
  129.         }
  130.     }
  131.     writefile("$DCONF->{admin_dir}/groups.txt", \@newfile, "write_group_file", { no_lock => 1, zero_ok => 1 });
  132.     return $c;
  133. }
  134.  
  135. 1;
  136.