--- loncom/lonnet/perl/lonnet.pm 2014/10/18 16:49:19 1.1267 +++ loncom/lonnet/perl/lonnet.pm 2014/10/24 00:20:15 1.1268 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1267 2014/10/18 16:49:19 raeburn Exp $ +# $Id: lonnet.pm,v 1.1268 2014/10/24 00:20:15 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -5990,10 +5990,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 ++; } @@ -6010,6 +6015,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 @@ -6022,6 +6028,15 @@ 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 {