--- loncom/lonnet/perl/lonnet.pm 2004/04/01 15:24:44 1.484 +++ loncom/lonnet/perl/lonnet.pm 2004/04/23 19:36:46 1.488 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.484 2004/04/01 15:24:44 albertel Exp $ +# $Id: lonnet.pm,v 1.488 2004/04/23 19:36:46 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -32,7 +32,8 @@ package Apache::lonnet; use strict; use LWP::UserAgent(); use HTTP::Headers; -use Date::Parse; +use HTTP::Date; +# use Date::Parse; use vars qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache @@ -616,6 +617,7 @@ sub idput { my ($udom,%ids)=@_; my %servers=(); foreach (keys %ids) { + &cput('environment',{'id'=>$ids{$_}},$udom,$_); my $uhom=&homeserver($_,$udom); if ($uhom ne 'no_host') { my $id=&escape($ids{$_}); @@ -626,7 +628,6 @@ sub idput { } else { $servers{$uhom}=$id.'='.$unam; } - &critical('put:'.$udom.':'.$unam.':environment:id='.$id,$uhom); } } foreach (keys %servers) { @@ -1186,7 +1187,8 @@ sub tokenwrapper { # --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course # input: action, courseID, current domain, home server for course, intended # path to file, source of file. -# output: ok if successful, diagnostic message otherwise +# output: url to file (if action was uploaddoc), +# ok if successful, or diagnostic message otherwise (if action was propagate or copy) # # Allows directory structure to be used within lonUsers/../userfiles/ for a # course. @@ -1201,8 +1203,9 @@ sub tokenwrapper { # and will then be copied to # /home/httpd/lonUsers/$domain/1/2/3/$course/userfiles/$file in # course's home server. +# # action = uploaddoc - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file -# will be retrived from $ENV{form.$source} via DOCS interface to +# will be retrived from $ENV{form.uploaddoc} (from DOCS interface) to # /home/httpd/html/userfiles/$domain/1/2/3/$course/$file # and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file # in course's home server. @@ -1255,7 +1258,7 @@ sub process_coursefile { } } } - unless ( ($fetchresult eq 'ok') || ($fetchresult eq 'no source file') ) { + unless ( $fetchresult eq 'ok') { &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file. ' to host '.$docuhome.': '.$fetchresult); } @@ -1280,7 +1283,6 @@ sub userfileupload { # See if there is anything left unless ($fname) { return 'error: no uploaded file'; } chop($ENV{'form.'.$formname}); - my $url = ''; # Create the directory if not present my $docuname=''; my $docudom=''; @@ -1290,18 +1292,17 @@ sub userfileupload { $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; if ($ENV{'form.folder'} =~ m/^default/) { - $url = &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname); + return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname); } else { $fname=$ENV{'form.folder'}.'/'.$fname; - $url = &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname); + return &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname); } } else { $docuname=$ENV{'user.name'}; $docudom=$ENV{'user.domain'}; $docuhome=$ENV{'user.home'}; + return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname); } - return - &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname); } sub finishuserfileupload { @@ -3306,9 +3307,10 @@ sub modify_student_enrollment { } my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene, $first,$middle); - my $value=&escape($uname.':'.$udom).'='. - &escape(join(':',$end,$start,$uid,$usec,$fullname,$type)); - my $reply=critical('put:'.$cdom.':'.$cnum.':classlist:'.$value,$chome); + my $reply=cput('classlist', + {"$uname:$udom" => + join(':',$end,$start,$uid,$usec,$fullname,$type) }, + $cdom,$cnum); unless (($reply eq 'ok') || ($reply eq 'delayed')) { return 'error: '.$reply; } @@ -4081,14 +4083,14 @@ sub metadata { #&logthis("extsion1 $extension $key !!"); #no specific packages #how's our extension if ($key!~/^extension_\Q$extension\E&/) { next; } - &metadata_create_pacakge_def($uri,$key,'extension_'.$extension, + &metadata_create_package_def($uri,$key,'extension_'.$extension, \%metathesekeys); } if (!exists($metacache{$uri}->{':packages'})) { foreach my $key (sort(keys(%packagetab))) { #no specific packages well let's get default then if ($key!~/^default&/) { next; } - &metadata_create_pacakge_def($uri,$key,'default', + &metadata_create_package_def($uri,$key,'default', \%metathesekeys); } } @@ -4120,7 +4122,7 @@ sub metadata { return $metacache{$uri}->{':'.$what}; } -sub metadata_create_pacakge_def { +sub metadata_create_package_def { my ($uri,$key,$package,$metathesekeys)=@_; my ($pack,$name,$subp)=split(/\&/,$key); if ($subp eq 'default') { next; } @@ -4690,7 +4692,7 @@ sub getuploaded { return 'failed'; } if ($reqtype eq 'HEAD') { - $$info = &Date::Parse::str2time( $response->header('Last-modified') ); + $$info = &HTTP::Date::str2time( $response->header('Last-modified') ); } elsif ($reqtype eq 'GET') { $$info = $response->content; }