--- loncom/lonnet/perl/lonnet.pm 2009/08/08 19:55:24 1.1011 +++ loncom/lonnet/perl/lonnet.pm 2009/08/10 23:32:35 1.1012 @@ -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.1012 2009/08/10 23:32:35 raeburn 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);