--- loncom/lonnet/perl/lonnet.pm	2009/05/16 01:19:36	1.1001
+++ loncom/lonnet/perl/lonnet.pm	2009/06/11 19:19:57	1.1003
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1001 2009/05/16 01:19:36 raeburn Exp $
+# $Id: lonnet.pm,v 1.1003 2009/06/11 19:19:57 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3930,7 +3930,7 @@ sub set_userprivs {
 }
 
 sub role_status {
-    my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
+    my ($rolekey,$then,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
     my @pwhere = ();
     if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
         (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
@@ -3941,7 +3941,41 @@ sub role_status {
             $$tstatus='is';
             if ($$tstart && $$tstart>$then) {
                 $$tstatus='future';
-                if ($$tstart<$now) { $$tstatus='will'; }
+                if ($$tstart && $$tstart>$refresh) {
+                    if ($$tstart<$now) {
+                        if (($$where ne '') && ($$role ne '')) {
+                            my (%allroles,%allgroups,$group_privs);
+                            my %userroles = (
+                                'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend
+                            );
+                            my $spec=$$role.'.'.$$where;
+                            my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
+                            if ($$role eq 'gr') {
+                                my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
+                                                    $env{'user.name'})=@_;
+                                my ($trole) = split('_',$role,1);
+                                (undef,my $group_privs) = split(/\//,$trole);
+                                $group_privs = &unescape($group_privs);
+                            }
+                            if ($$role =~ /^cr\//) {
+                                &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where);
+                            } elsif ($$role eq 'gr') {
+                                my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
+                                                    $env{'user.name'});
+                                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);
+                            } else {
+                                &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
+                            }
+                            my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups);
+                            &appenv(\%userroles,[$$role,'cm']);
+                            &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
+                            $$tstatus = 'is';
+                        }
+                    }
+                }
             }
             if ($$tend) {
                 if ($$tend<$then) {
@@ -3955,11 +3989,11 @@ sub role_status {
 }
 
 sub check_adhoc_privs {
-    my ($cdom,$cnum,$then,$now,$checkrole) = @_;
+    my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
     if ($env{$cckey}) {
         my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
-        &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+        &role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
         unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
             &set_adhoc_privileges($cdom,$cnum,$checkrole);
         }
@@ -5664,7 +5698,40 @@ sub auto_instcode_defaults {
     }
 
     return $response;
-} 
+}
+
+sub auto_possible_instcodes {
+    my ($domain,$codetitles,$cat_titles,$cat_order) = @_;
+    my (@homeservers,$uhome);
+    if (defined(&domain($domain,'primary'))) {
+        $uhome=&domain($domain,'primary');
+        push(@homeservers,&domain($domain,'primary'));
+    } else {
+        my %servers = &get_servers($domain,'library');
+        foreach my $tryserver (keys(%servers)) {
+            if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+                push(@homeservers,$tryserver);
+            }
+        }
+    }
+    my $response;
+    foreach my $server (@homeservers) {
+        $response=&reply('autopossibleinstcodes:'.$domain,$server);
+        next if ($response =~ /(con_lost|error|no_such_host|refused)/);
+        my ($codetitlestr,$cat_title,$cat_order) = split(':',$response);
+        @{$codetitles} = map { &unescape($_); } (split('&',$codetitlestr));  
+        foreach my $item (split('&',$cat_title)) {   
+            my ($name,$value)=split('&',$item);
+            $cat_titles->{&unescape($name)}=&unescape($value);
+        }
+        foreach my $item (split('&',$cat_order)) {
+            my ($name,$value)=split('&',$item);
+            $cat_order->{&unescape($name)}=&unescape($value);
+        }
+        return 'ok';
+    }
+    return $response;
+}
 
 sub auto_validate_class_sec {
     my ($cdom,$cnum,$owners,$inst_class) = @_;