--- loncom/lonnet/perl/lonnet.pm	2010/05/21 22:09:48	1.1056.2.3
+++ loncom/lonnet/perl/lonnet.pm	2010/03/26 00:47:25	1.1060
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.2.3 2010/05/21 22:09:48 raeburn Exp $
+# $Id: lonnet.pm,v 1.1060 2010/03/26 00:47:25 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3207,7 +3207,7 @@ sub get_domain_roles {
     return %personnel;
 }
 
-# ----------------------------------------------------------- Check out an item
+# ----------------------------------------------------------- Interval timing 
 
 sub get_first_access {
     my ($type,$argsymb)=@_;
@@ -3243,91 +3243,6 @@ sub set_first_access {
     return 'already_set';
 }
 
-sub checkout {
-    my ($symb,$tuname,$tudom,$tcrsid)=@_;
-    my $now=time;
-    my $lonhost=$perlvar{'lonHostID'};
-    my $infostr=&escape(
-                 'CHECKOUTTOKEN&'.
-                 $tuname.'&'.
-                 $tudom.'&'.
-                 $tcrsid.'&'.
-                 $symb.'&'.
-		 $now.'&'.$ENV{'REMOTE_ADDR'});
-    my $token=&reply('tmpput:'.$infostr,$lonhost);
-    if ($token=~/^error\:/) { 
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
-                 "</font>");
-        return ''; 
-    }
-
-    $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
-    $token=~tr/a-z/A-Z/;
-
-    my %infohash=('resource.0.outtoken' => $token,
-                  'resource.0.checkouttime' => $now,
-                  'resource.0.outremote' => $ENV{'REMOTE_ADDR'});
-
-    unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
-       return '';
-    } else {
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
-                 "</font>");
-    }    
-
-    if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
-                         &escape('Checkout '.$infostr.' - '.
-                                                 $token)) ne 'ok') {
-	return '';
-    } else {
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
-                 "</font>");
-    }
-    return $token;
-}
-
-# ------------------------------------------------------------ Check in an item
-
-sub checkin {
-    my $token=shift;
-    my $now=time;
-    my ($ta,$tb,$lonhost)=split(/\*/,$token);
-    $lonhost=~tr/A-Z/a-z/;
-    my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
-    $dtoken=~s/\W/\_/g;
-    my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
-                 split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
-
-    unless (($tuname) && ($tudom)) {
-        &logthis('Check in '.$token.' ('.$dtoken.') failed');
-        return '';
-    }
-    
-    unless (&allowed('mgr',$tcrsid)) {
-        &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '.
-                 $env{'user.name'}.' - '.$env{'user.domain'});
-        return '';
-    }
-
-    my %infohash=('resource.0.intoken' => $token,
-                  'resource.0.checkintime' => $now,
-                  'resource.0.inremote' => $ENV{'REMOTE_ADDR'});
-
-    unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
-       return '';
-    }    
-
-    if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
-                         &escape('Checkin - '.$token)) ne 'ok') {
-	return '';
-    }
-
-    return ($symb,$tuname,$tudom,$tcrsid);    
-}
-
 # --------------------------------------------- Set Expire Date for Spreadsheet
 
 sub expirespread {
@@ -4028,36 +3943,23 @@ sub standard_roleprivs {
 }
 
 sub set_userprivs {
-    my ($userroles,$allroles,$allgroups,$groups_roles) = @_; 
+    my ($userroles,$allroles,$allgroups) = @_; 
     my $author=0;
     my $adv=0;
     my %grouproles = ();
     if (keys(%{$allgroups}) > 0) {
-        my @groupkeys;
         foreach my $role (keys(%{$allroles})) {
-            push(@groupkeys,$role);
-        }
-        if (ref($groups_roles) eq 'HASH') {
-            foreach my $key (keys(%{$groups_roles})) {
-                unless (grep(/^\Q$key\E$/,@groupkeys)) {
-                    push(@groupkeys,$key);
-                }
-            }
-        }
-        if (@groupkeys > 0) {
-            foreach my $role (@groupkeys) {
-                my ($trole,$area,$sec,$extendedarea);
-                if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
-                    $trole = $1;
-                    $area = $2;
-                    $sec = $3;
-                    $extendedarea = $area.$sec;
-                    if (exists($$allgroups{$area})) {
-                        foreach my $group (keys(%{$$allgroups{$area}})) {
-                            my $spec = $trole.'.'.$extendedarea;
-                            $grouproles{$spec.'.'.$area.'/'.$group} = 
-                                                  $$allgroups{$area}{$group};
-                        }
+            my ($trole,$area,$sec,$extendedarea);
+            if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
+                $trole = $1;
+                $area = $2;
+                $sec = $3;
+                $extendedarea = $area.$sec;
+                if (exists($$allgroups{$area})) {
+                    foreach my $group (keys(%{$$allgroups{$area}})) {
+                        my $spec = $trole.'.'.$extendedarea;
+                        $grouproles{$spec.'.'.$area.'/'.$group} = 
+                                                $$allgroups{$area}{$group};
                     }
                 }
             }
@@ -4104,58 +4006,26 @@ sub role_status {
                 if ($$tstart<$now) {
                     if ($$tstart && $$tstart>$refresh) {
                         if (($$where ne '') && ($$role ne '')) {
-                            my (%allroles,%allgroups,$group_privs,
-                                %groups_roles,@rolecodes);
+                            my (%allroles,%allgroups,$group_privs);
                             my %userroles = (
                                 'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend
                             );
-                            @rolecodes = ('cm');
                             my $spec=$$role.'.'.$$where;
                             my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
                             if ($$role =~ /^cr\//) {
                                 &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where);
-                                push(@rolecodes,'cr');
                             } elsif ($$role eq 'gr') {
-                                push(@rolecodes,$$role);
                                 my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
                                                     $env{'user.name'});
-                                my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2);
+                                my $trole = split('_',$rolehash{$$where.'_'.$$role},1);
                                 (undef,my $group_privs) = split(/\//,$trole);
                                 $group_privs = &unescape($group_privs);
                                 &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
-                                my %course_roles = &get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active'],['cc','co','in','ta','ep','ad','st','cr'],[$tdomain],1);
-                                if (keys(%course_roles) > 0) {
-                                    my ($tnum) = ($trest =~ /^($match_courseid)/);
-                                    if ($tdomain ne '' && $tnum ne '') {
-                                        foreach my $key (keys(%course_roles)) {
-                                            if ($key =~ /^\Q$tnum\E:\Q$tdomain\E:([^:]+):?([^:]*)/) {
-                                                my $crsrole = $1;
-                                                my $crssec = $2;
-                                                if ($crsrole =~ /^cr/) {
-                                                    unless (grep(/^cr$/,@rolecodes)) {
-                                                        push(@rolecodes,'cr');
-                                                    }
-                                                } else {
-                                                    unless(grep(/^\Q$crsrole\E$/,@rolecodes)) {
-                                                        push(@rolecodes,$crsrole);
-                                                    }
-                                                }
-                                                my $rolekey = $crsrole.'./'.$tdomain.'/'.$tnum;
-                                                if ($crssec ne '') {
-                                                    $rolekey .= '/'.$crssec;
-                                                }
-                                                $rolekey .= './';
-                                                $groups_roles{$rolekey} = \@rolecodes;
-                                            }
-                                        }
-                                    }
-                                }
                             } else {
-                                push(@rolecodes,$$role);
                                 &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
                             }
-                            my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles);
-                            &appenv(\%userroles,\@rolecodes);
+                            my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups);
+                            &appenv(\%userroles,[$$role,'cm']);
                             &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
                         }
                     }
@@ -6647,8 +6517,9 @@ sub modifyuser {
 #
 # If name, email and/or uid are blank (e.g., because an uploaded file
 # of users did not contain them), do not overwrite existing values
-# unless field is in $candelete array ref.
+# unless field is in $candelete array ref.  
 #
+
     my @fields = ('firstname','middlename','lastname','generation',
                   'permanentemail','id');
     my %newvalues;
@@ -6661,7 +6532,7 @@ sub modifyuser {
                     $names{$field} = $middle;
                 } elsif ($field eq 'lastname') {
                     $names{$field} = $last;
-                } elsif ($field eq 'generation') {
+                } elsif ($field eq 'generation') { 
                     $names{$field} = $gene;
                 } elsif ($field eq 'permanentemail') {
                     $names{$field} = $email;
@@ -6671,7 +6542,6 @@ sub modifyuser {
             }
         }
     }
-
     if ($first)  { $names{'firstname'}  = $first; }
     if (defined($middle)) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }
@@ -10404,7 +10274,7 @@ modifyuser($udom,$uname,$uid,$umode,$upa
 will update user information (firstname,middlename,lastname,generation,
 permanentemail), and if forceid is true, student/employee ID also.
 A user's institutional affiliation(s) can also be updated.
-User information fields will not be overwritten with empty entries
+User information fields will not be overwritten with empty entries 
 unless the field is included in the $candelete array reference.
 This array is included when a single user is modified via "Manage Users",
 or when Autoupdate.pl is run by cron in a domain.