--- loncom/lonnet/perl/lonnet.pm 2008/09/12 21:25:54 1.968 +++ loncom/lonnet/perl/lonnet.pm 2008/11/12 20:01:15 1.971 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.968 2008/09/12 21:25:54 raeburn Exp $ +# $Id: lonnet.pm,v 1.971 2008/11/12 20:01:15 jms Exp $ # # Copyright Michigan State University Board of Trustees # @@ -27,6 +27,28 @@ # ### +=pod + +=head1 Package Variables + +These are largely undocumented, so if you decipher one please note it here. + +=over 4 + +=item $processmarker + +Contains the time this process was started and this servers host id. + +=item $dumpcount + +Counts the number of times a message log flush has been attempted (regardless +of success) by this process. Used as part of the filename when messages are +delayed. + +=back + +=cut + package Apache::lonnet; use strict; @@ -61,28 +83,6 @@ require Exporter; our @ISA = qw (Exporter); our @EXPORT = qw(%env); -=pod - -=head1 Package Variables - -These are largely undocumented, so if you decipher one please note it here. - -=over 4 - -=item $processmarker - -Contains the time this process was started and this servers host id. - -=item $dumpcount - -Counts the number of times a message log flush has been attempted (regardless -of success) by this process. Used as part of the filename when messages are -delayed. - -=back - -=cut - # --------------------------------------------------------------------- Logging { @@ -4896,6 +4896,9 @@ sub log_query { sub update_portfolio_table { my ($uname,$udom,$file_name,$query,$group,$action) = @_; + if ($group ne '') { + $file_name =~s /^\Q$group\E//; + } my $homeserver = &homeserver($uname,$udom); my $queryid= &reply("querysend:".$query.':'.&escape($uname.':'.$udom.':'.$group). @@ -6149,20 +6152,18 @@ sub modify_access_controls { } } } + my ($group); + if (&is_course($domain,$user)) { + ($group,my $file) = split(/\//,$file_name,2); + } $deloutcome = &del('file_permissions',\@deletions,$domain,$user); $new_values{$file_name."\0".'accesscontrol'} = \%new_control; $outcome = &put('file_permissions',\%new_values,$domain,$user); # remove lock my @del_lock = ($file_name."\0".'locked_access_records'); my $dellockoutcome = &del('file_permissions',\@del_lock,$domain,$user); - my ($file,$group); - if (&is_course($domain,$user)) { - ($group,$file) = split(/\//,$file_name,2); - } else { - $file = $file_name; - } my $sqlresult = - &update_portfolio_table($user,$domain,$file,'portfolio_access', + &update_portfolio_table($user,$domain,$file_name,'portfolio_access', $group); } else { $outcome = "error: could not obtain lockfile\n"; @@ -8547,10 +8548,14 @@ sub get_dns { push(@{$name_to_host{$name}}, $id); $hostdom{$id}=$domain; if ($role eq 'library') { $libserv{$id}=$name; } - if ($protocol eq 'https') { - $protocol{$id} = $protocol; + if (defined($protocol)) { + if ($protocol eq 'https') { + $protocol{$id} = $protocol; + } else { + $protocol{$id} = 'http'; + } } else { - $protocol{$id} = 'http'; + $protocol{$id} = 'http'; } } }