--- loncom/lonnet/perl/lonnet.pm 2014/10/13 15:47:14 1.1172.2.55 +++ loncom/lonnet/perl/lonnet.pm 2014/10/26 13:02:42 1.1172.2.57 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.55 2014/10/13 15:47:14 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.57 2014/10/26 13:02:42 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1647,6 +1647,7 @@ sub dump_dom { sub get_dom { my ($namespace,$storearr,$udom,$uhome)=@_; + return if ($udom eq 'public'); my $items=''; foreach my $item (@$storearr) { $items.=&escape($item).'&'; @@ -1654,6 +1655,7 @@ sub get_dom { $items=~s/\&$//; if (!$udom) { $udom=$env{'user.domain'}; + return if ($udom eq 'public'); if (defined(&domain($udom,'primary'))) { $uhome=&domain($udom,'primary'); } else { @@ -6063,10 +6065,15 @@ sub get_timebased_id { my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix); my $id = time; $newid = $id; + if ($idtype eq 'addcode') { + $newid .= &sixnum_code(); + } my $idtries = 0; while (exists($inuse{$prefix."\0".$newid}) && $idtries < $maxtries) { if ($idtype eq 'concat') { $newid = $id.$idtries; + } elsif ($idtype eq 'addcode') { + $newid = $newid.&sixnum_code(); } else { $newid ++; } @@ -6083,6 +6090,7 @@ sub get_timebased_id { $error = 'error saving new item: '.$putresult; } } else { + undef($newid); $error = ('error: no unique suffix available for the new item '); } # remove lock @@ -6095,6 +6103,14 @@ sub get_timebased_id { return ($newid,$dellock,$error); } +sub sixnum_code { + my $code; + for (0..6) { + $code .= int( rand(9) ); + } + return $code; +} + # -------------------------------------------------- portfolio access checking sub portfolio_access {