[LON-CAPA-cvs] cvs: loncom /interface courseprefs.pm /lonnet/perl lonnet.pm

[raeburn]

raeburn		Thu Jul 20 12:47:10 2023 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
    /loncom/interface	courseprefs.pm 
  Log:
  - &get_ltitools_id() moved from courseprefs.pm to lonnet.pm to facilitate
    reuse.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1512 loncom/lonnet/perl/lonnet.pm:1.1513
--- loncom/lonnet/perl/lonnet.pm:1.1512	Tue Jun 20 14:03:57 2023
+++ loncom/lonnet/perl/lonnet.pm	Thu Jul 20 12:47:09 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1512 2023/06/20 14:03:57 raeburn Exp $
+# $Id: lonnet.pm,v 1.1513 2023/07/20 12:47:09 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -12787,6 +12787,73 @@
     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;
Index: loncom/interface/courseprefs.pm
diff -u loncom/interface/courseprefs.pm:1.124 loncom/interface/courseprefs.pm:1.125
--- loncom/interface/courseprefs.pm:1.124	Sat Jun  3 11:21:37 2023
+++ loncom/interface/courseprefs.pm	Thu Jul 20 12:47:10 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler to set configuration settings for a course
 #
-# $Id: courseprefs.pm,v 1.124 2023/06/03 11:21:37 raeburn Exp $
+# $Id: courseprefs.pm,v 1.125 2023/07/20 12:47:10 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1914,7 +1914,7 @@
     if ($env{'form.ltitools_add'}) {
         my $title = $env{'form.ltitools_add_title'};
         $title =~ s/(`)/'/g;
-        my ($newid,$error) = &get_ltitools_id($context,$cdom,$cnum,$title);
+        my ($newid,$error) = &Apache::lonnet::get_ltitools_id($context,$cdom,$cnum,$title);
         if ($newid) {
             my $position = $env{'form.ltitools_add_pos'};
             $position =~ s/\D+//g;
@@ -2368,73 +2368,6 @@
     return $errors;
 }
 
-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 = &Apache::lonnet::newput_dom('ltitools',$lockhash,$cdom);
-    } else {
-        $gotlock = &Apache::lonnet::newput('ltitools',$lockhash,$cdom,$cnum);
-    }
-    while (($gotlock ne 'ok') && ($tries<10)) {
-        $tries ++;
-        sleep (0.1);
-        if ($context eq 'domain') {
-            $gotlock = &Apache::lonnet::newput_dom('ltitools',$lockhash,$cdom);
-        } else {
-            $gotlock = &Apache::lonnet::newput('ltitools',$lockhash,$cdom,$cnum);
-        }
-    }
-    if ($gotlock eq 'ok') {
-        my %currids;
-        if ($context eq 'domain') {
-            %currids = &Apache::lonnet::dump_dom('ltitools',$cdom);
-        } else {
-            %currids = &Apache::lonnet::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 (&Apache::lonnet::newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') {
-                        $error = 'nostore';
-                    }
-                } else {
-                    unless (&Apache::lonnet::newput('ltitools',{ $id => $title },$cdom,$cnum) eq 'ok') {
-                        $error = 'nostore';
-                    }
-                }
-            } else {
-                $error = 'nonumber';
-            }
-        }
-        my $dellockoutcome;
-        if ($context eq 'domain') {
-            $dellockoutcome = &Apache::lonnet::del_dom('ltitools',['lock'],$cdom);
-        } else {
-            $dellockoutcome = &Apache::lonnet::del('ltitools',['lock'],$cdom,$cnum);
-        }
-    } else {
-        $error = 'nolock';
-    }
-    return ($id,$error);
-}
-
 sub process_ltitools_image {
     my ($r,$context,$dom,$cnum,$confname,$caller,$itemid,$configuserok,$switch,$author_ok,$currimg) = @_;
     my $filename = $env{'form.'.$caller.'.filename'};