--- loncom/lonnet/perl/lonnet.pm 2014/07/29 05:55:24 1.1172.2.54 +++ loncom/lonnet/perl/lonnet.pm 2014/10/24 00:37:15 1.1172.2.56 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.54 2014/07/29 05:55:24 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.56 2014/10/24 00:37:15 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -5704,18 +5704,17 @@ sub dump { if (!$uname) { $uname=$env{'user.name'}; } my $uhome=&homeserver($uname,$udomain); - my $reply; + if ($regexp) { + $regexp=&escape($regexp); + } else { + $regexp='.'; + } if (grep { $_ eq $uhome } ¤t_machine_ids()) { # user is hosted on this machine - $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain, + my $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain, $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'}); return %{&unserialize($reply, $escapedkeys)}; } - if ($regexp) { - $regexp=&escape($regexp); - } else { - $regexp='.'; - } my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); my @pairs=split(/\&/,$rep); my %returnhash=(); @@ -6064,10 +6063,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 ++; } @@ -6084,6 +6088,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 @@ -6096,6 +6101,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 {