--- loncom/lonnet/perl/lonnet.pm 2009/08/08 19:55:24 1.1011 +++ loncom/lonnet/perl/lonnet.pm 2009/08/11 11:33:52 1.1014 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1011 2009/08/08 19:55:24 raeburn Exp $ +# $Id: lonnet.pm,v 1.1014 2009/08/11 11:33:52 droeschl Exp $ # # Copyright Michigan State University Board of Trustees # @@ -958,6 +958,43 @@ sub idput { } } +# ------------------------------------------------ dump from domain db files + +sub dump_dom { + my ($namespace,$udom,$uhome,$regexp,$range)=@_; + if (!$udom) { + $udom=$env{'user.domain'}; + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } else { + undef($uhome); + } + } else { + if (!$uhome) { + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } + } + } + my %returnhash; + if ($udom && $uhome && ($uhome ne 'no_host')) { + if ($regexp) { + $regexp=&escape($regexp); + } else { + $regexp='.'; + } + my $rep=&reply("dumpdom:$udom:$namespace:$regexp:$range",$uhome); + my @pairs=split(/\&/,$rep); + foreach my $item (@pairs) { + my ($key,$value)=split(/=/,$item,2); + $key = &unescape($key); + next if ($key =~ /^error: 2 /); + $returnhash{$key}=&thaw_unescape($value); + } + } + return %returnhash; +} + # ------------------------------------------- get items from domain db files sub get_dom { @@ -1032,6 +1069,70 @@ sub put_dom { } } +# -------------------------------------- newput for items in domain db files + +sub newput_dom { + my ($namespace,$storehash,$udom,$uhome) = @_; + my $result; + if (!$udom) { + $udom=$env{'user.domain'}; + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } else { + undef($uhome); + } + } else { + if (!$uhome) { + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } + } + } + if ($udom && $uhome && ($uhome ne 'no_host')) { + my $items=''; + if (ref($storehash) eq 'HASH') { + foreach my $key (keys(%$storehash)) { + $items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; + } + $items=~s/\&$//; + $result = &reply("newputdom:$udom:$namespace:$items",$uhome); + } + } else { + &logthis("put_dom failed - no homeserver and/or domain"); + } + return $result; +} + +sub del_dom { + my ($namespace,$storearr,$udom,$uhome)=@_; + if (ref($storearr) eq 'ARRAY') { + my $items=''; + foreach my $item (@$storearr) { + $items.=&escape($item).'&'; + } + $items=~s/\&$//; + if (!$udom) { + $udom=$env{'user.domain'}; + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } else { + undef($uhome); + } + } else { + if (!$uhome) { + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } + } + } + if ($udom && $uhome && ($uhome ne 'no_host')) { + return &reply("deldom:$udom:$namespace:$items",$uhome); + } else { + &logthis("del_dom failed - no homeserver and/or domain"); + } + } +} + sub retrieve_inst_usertypes { my ($udom) = @_; my (%returnhash,@order); @@ -5777,6 +5878,11 @@ sub auto_courserequest_checks { return %validations; } +sub auto_courserequest_validation { + my ($dom,$details,$inststatuses,$message) = @_; + return 'pending'; +} + sub auto_validate_class_sec { my ($cdom,$cnum,$owners,$inst_class) = @_; my $homeserver = &homeserver($cnum,$cdom); @@ -6423,6 +6529,36 @@ sub is_course { return 0; } +sub store_coursereq { + my ($requestkey,$storehash) = @_; + my $result; + if ($requestkey =~ /^($match_domain)_($match_courseid)$/) { + if (ref($storehash) eq 'HASH') { + my $namespace = 'courserequests'; + my $uhome=&homeserver(); + if (($uhome eq '') || ($uhome eq 'no_host')) { + $result = 'error: no_host'; + } else { + $storehash->{'ip'} = $ENV{'REMOTE_ADDR'}; + $storehash->{'host'} = $perlvar{'lonHostID'}; + + my $namevalue=''; + foreach my $key (keys(%{$storehash})) { + $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; + } + $namevalue=~s/\&$//; + $result = &reply("store:$env{'user.domain'}:$env{'user.name'}:". + "$namespace:$requestkey:$namevalue",$uhome); + } + } else { + $result = 'error: data to store was not a hash reference'; + } + } else { + $result= 'error: invalid requestkey'; + } + return $result; +} + # ---------------------------------------------------------- Assign Custom Role sub assigncustomrole { @@ -7912,6 +8048,11 @@ sub devalidate_title_cache { &devalidate_cache_new('title',$key); } +# ------------------------------------------------- Get the title of a course + +sub current_course_title { + return $env{ 'course.' . $env{'request.course.id'} . '.description' }; +} # ------------------------------------------------- Get the title of a resource sub gettitle {