--- loncom/lonnet/perl/lonnet.pm 2004/06/08 22:09:44 1.506 +++ loncom/lonnet/perl/lonnet.pm 2004/06/21 22:01:39 1.513 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.506 2004/06/08 22:09:44 raeburn Exp $ +# $Id: lonnet.pm,v 1.513 2004/06/21 22:01:39 banghart Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1615,11 +1615,11 @@ sub courseidput { } sub courseiddump { - my ($domfilter,$descfilter,$sincefilter,$hostid)=@_; + my ($domfilter,$descfilter,$sincefilter,$hostidflag,$hostidref)=@_; my %returnhash=(); unless ($domfilter) { $domfilter=''; } foreach my $tryserver (keys %libserv) { - if (($hostid && $tryserver eq $hostid) || (!$hostid)) { + if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) { if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) { foreach ( split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. @@ -3054,14 +3054,20 @@ sub log_query { return get_query_reply($queryid); } -# ------- Request retrieval of institutional classlists from course homerserver +# ------- Request retrieval of institutional classlists for course(s) sub fetch_enrollment_query { - my ($homeserver,$dom,$affiliatesref,$replyref) = @_; + my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_; + my $homeserver; + if ($context eq 'automated') { + $homeserver = $perlvar{'lonHostID'}; + } else { + $homeserver = &homeserver($cnum,$dom); + } my $host=$hostname{$homeserver}; my $cmd = ''; foreach (keys %{$affiliatesref}) { - $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%'; + $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%'; } $cmd =~ s/%%$//; $cmd = &escape($cmd); @@ -3143,15 +3149,17 @@ sub userlog_query { #--------- Call auto-enrollment subs in localenroll.pm for homeserver for course sub auto_run { - my $homeserver = shift; - my $response = &reply('autorun',$homeserver); + my ($cnum,$cdom) = @_; + my $homeserver = &homeserver($cnum,$cdom); + my $response = &reply('autorun:'.$cdom,$homeserver); return $response; } sub auto_get_sections { - my ($homeserver,$coursecode) = @_; + my ($cnum,$cdom,$inst_coursecode) = @_; + my $homeserver = &homeserver($cnum,$cdom); my @secs = (); - my $response=&unescape(&reply('autogetsections:'.$coursecode,$homeserver)); + my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver)); unless ($response eq 'refused') { @secs = split/:/,$response; } @@ -3159,22 +3167,25 @@ sub auto_get_sections { } sub auto_new_course { - my ($homeserver,$course_id,$owner) = @_; - my $response=&unescape(&reply('autonewcourse:'.$course_id.':'.$owner,$homeserver)); + my ($cnum,$cdom,$inst_course_id,$owner) = @_; + my $homeserver = &homeserver($cnum,$cdom); + my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner,':'.$cdom,$homeserver)); return $response; } sub auto_validate_courseID { - my ($homeserver,$course_id) = @_; - my $response=&unescape(&reply('autovalidatecourse:'.$course_id,$homeserver)); + my ($cnum,$cdom,$inst_course_id) = @_; + my $homeserver = &homeserver($cnum,$cdom); + my $response=&unescape(&reply('autovalidatecourse:'.$inst_course_id.':'.$cdom,$homeserver)); return $response; } sub auto_create_password { - my ($homeserver,$authparam) = @_; + my ($cnum,$cdom,$authparam) = @_; + my $homeserver = &homeserver($cnum,$cdom); my $create_passwd = 0; my $authchk = ''; - my $response=&unescape(&reply('autocreatepassword:'.$authparam,$homeserver)); + my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver)); if ($response eq 'refused') { $authchk = 'refused'; } else { @@ -3564,6 +3575,31 @@ sub revokecustomrole { $deleteflag); } + +# ------------------------------------------------------------ Portfolio Director Lister +sub portfoliolist { + # returns listing of contents of user's /userfiles/portfolio/ directory + # + my ($udom, $uname, $uhome); + $uname=$ENV{'user.name'}; + $udom=$ENV{'user.domain'}; + $uhome=$ENV{'user.home'}; + my $listing = reply('portls:'.$uname.':'.$udom, $uhome); + return $listing; +} +sub portfoliomanage { + # handles deleting and renaming files in user's userfiles/portfolio/ directory + # + my ($filename, $fileaction, $filenewname) = @_; + my ($udom, $uname, $uhome); + $uname=$ENV{'user.name'}; + $udom=$ENV{'user.domain'}; + $uhome=$ENV{'user.home'}; + my $listing = reply('portfoliomanage:'.$uname.':'.$udom.':'.$filename.':'.$fileaction.':'.$filenewname, $uhome); + return $listing; +} + + # ------------------------------------------------------------ Directory lister sub dirlist { @@ -4359,7 +4395,10 @@ sub symblist { # --------------------------------------------------------------- Verify a symb sub symbverify { - my ($symb,$thisfn)=@_; + my ($symb,$thisurl)=@_; + my $thisfn=$thisurl; +# wrapper not part of symbs + $thisfn=~s/^\/adm\/wrapper//; $thisfn=&declutter($thisfn); # direct jump to resource in page or to a sequence - will construct own symbs if ($thisfn=~/\.(page|sequence)$/) { return 1; } @@ -4369,6 +4408,7 @@ sub symbverify { unless ($url eq $thisfn) { return 0; } $symb=&symbclean($symb); + $thisurl=&deversion($thisurl); $thisfn=&deversion($thisfn); my %bighash; @@ -4376,9 +4416,9 @@ sub symbverify { if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', &GDBM_READER(),0640)) { - my $ids=$bighash{'ids_'.&clutter($thisfn)}; + my $ids=$bighash{'ids_'.&clutter($thisurl)}; unless ($ids) { - $ids=$bighash{'ids_/'.$thisfn}; + $ids=$bighash{'ids_/'.$thisurl}; } if ($ids) { # ------------------------------------------------------------------- Has ID(s) @@ -4407,6 +4447,9 @@ sub symbclean { # remove version from URL $symb=~s/\.(\d+)\.(\w+)$/\.$2/; +# remove wrapper + + $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/; return $symb; } @@ -4962,7 +5005,7 @@ sub declutter { sub clutter { my $thisfn='/'.&declutter(shift); - unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv)\//) { + unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv|public)\//) { $thisfn='/res'.$thisfn; } return $thisfn;