--- loncom/lonnet/perl/lonnet.pm 2023/09/04 18:59:17 1.1172.2.146.2.14 +++ loncom/lonnet/perl/lonnet.pm 2023/09/06 13:33:33 1.1172.2.146.2.15 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.146.2.14 2023/09/04 18:59:17 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.146.2.15 2023/09/06 13:33:33 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -12095,6 +12095,73 @@ sub domainlti_itemid { return $itemid; } +sub get_ltitools_id { + my ($context,$cdom,$cnum,$title) = @_; + my ($lockhash,$tries,$gotlock,$id,$error); + + # get lock on ltitools db + $lockhash = { + lock => $env{'user.name'}. + ':'.$env{'user.domain'}, + }; + $tries = 0; + if ($context eq 'domain') { + $gotlock = &newput_dom('ltitools',$lockhash,$cdom); + } else { + $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum); + } + while (($gotlock ne 'ok') && ($tries<10)) { + $tries ++; + sleep (0.1); + if ($context eq 'domain') { + $gotlock = &newput_dom('ltitools',$lockhash,$cdom); + } else { + $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum); + } + } + if ($gotlock eq 'ok') { + my %currids; + if ($context eq 'domain') { + %currids = &dump_dom('ltitools',$cdom); + } else { + %currids = &dump('ltitools',$cdom,$cnum); + } + if ($currids{'lock'}) { + delete($currids{'lock'}); + if (keys(%currids)) { + my @curr = sort { $a <=> $b } keys(%currids); + if ($curr[-1] =~ /^\d+$/) { + $id = 1 + $curr[-1]; + } + } else { + $id = 1; + } + if ($id) { + if ($context eq 'domain') { + unless (&newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') { + $error = 'nostore'; + } + } else { + unless (&newput('ltitools',{ $id => $title },$cdom,$cnum) eq 'ok') { + $error = 'nostore'; + } + } + } else { + $error = 'nonumber'; + } + } + my $dellockoutcome; + if ($context eq 'domain') { + $dellockoutcome = &del_dom('ltitools',['lock'],$cdom); + } else { + $dellockoutcome = &del('ltitools',['lock'],$cdom,$cnum); + } + } else { + $error = 'nolock'; + } + return ($id,$error); +} + sub count_supptools { my ($cnum,$cdom,$ignorecache,$reload)=@_; my $hashid=$cnum.':'.$cdom;