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

raeburn raeburn at source.lon-capa.org
Sun Sep 1 18:39:48 EDT 2013


raeburn		Sun Sep  1 22:39:48 2013 EDT

  Modified files:              
    /loncom/interface	lonsearchcat.pm 
    /loncom	lonsql 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Re-enable search across domains when querying metadata for resources on 
    multi-domain servers. (to accommodate changes in lonsearchat rev. 1.322).
  
  
-------------- next part --------------
Index: loncom/interface/lonsearchcat.pm
diff -u loncom/interface/lonsearchcat.pm:1.335 loncom/interface/lonsearchcat.pm:1.336
--- loncom/interface/lonsearchcat.pm:1.335	Tue Aug 13 13:02:57 2013
+++ loncom/interface/lonsearchcat.pm	Sun Sep  1 22:39:39 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Search Catalog
 #
-# $Id: lonsearchcat.pm,v 1.335 2013/08/13 13:02:57 raeburn Exp $
+# $Id: lonsearchcat.pm,v 1.336 2013/09/01 22:39:39 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -321,31 +321,31 @@
         &display_results($r,$importbutton,$closebutton,$diropendb,
                          $env{'form.area'});
     } elsif ($env{'form.phase'} =~ /^(sort|run_search)$/) {
-        my ($query,$customquery,$customshow,$libraries,$pretty_string) =
+        my ($query,$customquery,$customshow,$libraries,$pretty_string,$domainsref) =
             &get_persistent_data($persistent_db_file,
                  ['query','customquery','customshow',
-                  'libraries','pretty_string']);
+                  'libraries','pretty_string','domains']);
         if ($env{'form.phase'} eq 'sort') {
             &print_sort_form($r,$pretty_string);
         } elsif ($env{'form.phase'} eq 'run_search') {
             &run_search($r,$query,$customquery,$customshow,
-                        $libraries,$pretty_string,$env{'form.area'});
+                        $libraries,$pretty_string,$env{'form.area'},$domainsref);
         }
     } elsif(($env{'form.phase'} eq 'basic_search') ||
             ($env{'form.phase'} eq 'adv_search')) {
         #
         # We are running a search, try to parse it
-        my ($query,$customquery,$customshow,$libraries) = 
-            (undef,undef,undef,undef);
+        my ($query,$customquery,$customshow,$libraries,$domains) = 
+            (undef,undef,undef,undef,undef);
         my $pretty_string;
         if ($env{'form.phase'} eq 'basic_search') {
-            ($query,$pretty_string,$libraries) = 
+            ($query,$pretty_string,$libraries,$domains) = 
                 &parse_basic_search($r,$closebutton,$hidden_fields);
             return OK if (! defined($query));
             &make_persistent({ basicexp => $env{'form.basicexp'}},
                              $persistent_db_file);
         } else {                      # Advanced search
-            ($query,$customquery,$customshow,$libraries,$pretty_string) 
+            ($query,$customquery,$customshow,$libraries,$pretty_string,$domains) 
                 = &parse_advanced_search($r,$closebutton,$hidden_fields);
             return OK if (! defined($query));
         }
@@ -353,7 +353,8 @@
                            customquery => $customquery,
                            customshow => $customshow,
                            libraries => $libraries,
-                           pretty_string => $pretty_string },
+                           pretty_string => $pretty_string,
+                           domains => $domains },
                          $persistent_db_file);
         #
         # Set up table
@@ -1012,8 +1013,9 @@
 
 This function is the reverse of &make_persistent();
 Retrieve persistent data from %persistent_db.  Retrieved items will have their
-values unescaped.  If the item contains commas (before unescaping), the
-returned value will be an array pointer. 
+values unescaped.  If the item is 'domains; then the returned
+value will be a hash pointer.  Otherwise, if the item contains
+commas (before unescaping), the returned value will be an array pointer. 
 
 =cut
 
@@ -1031,13 +1033,25 @@
             push @Values, undef;
             next;
         }
-        my @values = map { 
-            &unescape($_);
-        } split(',',$persistent_db{$name});
-        if (@values <= 1) {
-            push @Values,$values[0];
+        if ($name eq 'domains') {
+            my %valueshash;
+            my @items= map { &unescape($_); } split(',',$persistent_db{$name});
+            foreach my $item (@items) {
+                if ($item =~ /=/) {
+                    my ($key,$val) = map { &unescape($_); } split(/=/,$item);
+                    $valueshash{$key} = $val;
+                }
+            }
+            push(@Values,\%valueshash);
         } else {
-            push @Values,\@values;
+            my @values = map { 
+                &unescape($_);
+            } split(',',$persistent_db{$name});
+            if (@values <= 1) {
+                push @Values,$values[0];
+            } else {
+                push @Values,\@values;
+            }
         }
     }
     untie (%persistent_db);
@@ -1055,7 +1069,9 @@
 
 Store variables away to the %persistent_db.
 Values will be escaped.  Values that are array pointers will have their
-elements escaped and concatenated in a comma separated string.  
+elements escaped and concatenated in a comma separated string. Values 
+that are hash pointers will have their keys and values escaped and 
+concatenated in a comma separated string
 
 =cut
 
@@ -1067,8 +1083,17 @@
     return undef if (! tie(%persistent_db,'GDBM_File',
                            $filename,&GDBM_WRCREAT(),0640));
     foreach my $name (keys(%save)) {
-        my @values = (ref($save{$name}) ? @{$save{$name}} : ($save{$name}));
-        # We handle array references, but not recursively.
+        my @values=();
+        if (ref($save{$name}) eq 'ARRAY') {
+            @values = @{$save{$name}};
+        } elsif (ref($save{$name}) eq 'HASH') {
+            foreach my $key (%{$save{$name}}) {
+                push(@values,&escape($key).'='.&escape($save{$name}{$key}));
+            }
+        } else {
+            @values = $save{$name};
+        }
+        # We handle array and hash references, but not recursively.
         my $store = join(',', map { &escape($_); } @values );
         $persistent_db{$name} = $store;
     }
@@ -1385,7 +1410,8 @@
     ##
     ## Deal with restrictions to given domains
     ## 
-    my ($libraries_to_query,$pretty_domains_string) = &parse_domain_restrictions();
+    my ($libraries_to_query,$pretty_domains_string,$domains_to_query) = 
+        &parse_domain_restrictions();
     if ($pretty_domains_string) {
        $pretty_search_string .= $pretty_domains_string."<br />\n";
     }
@@ -1401,11 +1427,12 @@
     }
     #&Apache::lonnet::logthis('advanced query = '.$/.$query);
     return ($query,$customquery,$customshow,$libraries_to_query,
-            $pretty_search_string);
+            $pretty_search_string,$domains_to_query);
 }
 
 sub parse_domain_restrictions {
     my $libraries_to_query = undef;
+    my $domains_to_query = undef;
     # $env{'form.domains'} can be either a scalar or an array reference.
     # We need an array.
     if (! exists($env{'form.domains'}) || $env{'form.domains'} eq '') {
@@ -1429,12 +1456,32 @@
         foreach (sort @allowed_domains) {
             $pretty_domains_string .= "<b>".$_."</b> ";
         }
-	my %servers = &Apache::lonnet::get_unique_servers(\@allowed_domains,
-						   'library');
+	my %library_servers = &Apache::lonnet::get_unique_servers(\@allowed_domains,
+						                  'library');
+        my (%older_library_servers,%okdoms,%domains_for_id);
+        map { $okdoms{$_} = 1; } @allowed_domains;
+        foreach my $key (keys(%library_servers)) {
+            if (&Apache::lonnet::get_server_loncaparev('',$key) =~ /^\'?(\d+)\.(\d+)/) {
+                my $major = $1;
+                my $minor = $2;
+                if (($major < 2) || (($major == 2) && ($minor < 11))) {
+                    map { $older_library_servers{$_} = 1; }
+                        &Apache::lonnet::machine_ids($library_servers{$key});
+                } else {
+                    my %possdoms;
+                    map { $possdoms{$_}=1 if ($okdoms{$_}); }
+                        &Apache::lonnet::machine_domains($library_servers{$key});
+                    $domains_for_id{$key} = join(',',sort(keys(%possdoms)));
+                }
+            }
+        }
+        my %servers = (%library_servers,%older_library_servers);
 	$libraries_to_query = [keys(%servers)];
+        $domains_to_query = \%domains_for_id;
     }
     return ($libraries_to_query,
-            $pretty_domains_string);
+            $pretty_domains_string,
+            $domains_to_query);
 }
 
 ######################################################################
@@ -1463,7 +1510,8 @@
 	$env{"form.$_"}=&unescape($env{"form.$_"});
 	$env{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
     }
-    my ($libraries_to_query,$pretty_domains_string) = &parse_domain_restrictions();
+    my ($libraries_to_query,$pretty_domains_string,$domains_to_query) = 
+        &parse_domain_restrictions();
     #
     # Check to see if enough of a query is filled in
     my $search_string = $env{'form.basicexp'};
@@ -1509,7 +1557,7 @@
     $pretty_search_string =~ s:^<br /> and ::;
     &Apache::lonnet::logthis('simple search final query = '.$/.$final_query);
     return ($final_query,$pretty_search_string,
-            $libraries_to_query);
+            $libraries_to_query,$domains_to_query);
 }
 
 
@@ -2259,7 +2307,7 @@
 ######################################################################
 sub run_search {
     my ($r,$query,$customquery,$customshow,$serverlist,
-        $pretty_string,$area) = @_;
+        $pretty_string,$area,$domainsref) = @_;
     my $tabletype = 'metadata';
     if ($area eq 'portfolio') {
         $tabletype = 'portfolio_search';
@@ -2291,16 +2339,39 @@
     $r->rflush();
     #
     # Determine the servers we need to contact.
-    my @Servers_to_contact;
+    my (@Servers_to_contact,%domains_by_server);
     if (defined($serverlist)) {
         if (ref($serverlist) eq 'ARRAY') {
             @Servers_to_contact = @$serverlist;
         } else {
             @Servers_to_contact = ($serverlist);
         }
+        if (ref($domainsref) eq 'HASH') {
+            foreach my $server (@Servers_to_contact) {
+                $domains_by_server{$server} = $domainsref->{$server};
+            }
+        }
     } else {
-	my %all_library_servers = &Apache::lonnet::unique_library();
+	my %library_servers = &Apache::lonnet::unique_library();
+        my (%all_library_servers, %older_library_servers);
+        foreach my $key (keys(%library_servers)) {
+            if (&Apache::lonnet::get_server_loncaparev('',$key) =~ /^\'?(\d+)\.(\d+)/) {
+                my $major = $1;
+                my $minor = $2;
+                if (($major < 2) || (($major == 2) && ($minor < 11))) {
+                    map { $older_library_servers{$_} = 1; } 
+                        &Apache::lonnet::machine_ids($library_servers{$key});
+                }
+            }
+        }
+        %all_library_servers = (%library_servers,%older_library_servers);
         @Servers_to_contact = sort(keys(%all_library_servers));
+        foreach my $server (@Servers_to_contact) {
+            my %possdoms;
+            map { $possdoms{$_}=1;  } &Apache::lonnet::machine_domains($all_library_servers{$server});
+            $domains_by_server{$server} = 
+                join(',',sort(&Apache::lonnet::machine_domains($all_library_servers{$server})));
+        }
     }
     my %Server_status;
     #
@@ -2370,7 +2441,7 @@
             my $server = shift(@Servers_to_contact);
             &update_status($r,&mt('contacting [_1]',$server));
             my $reply=&Apache::lonnet::metadata_query($query,$customquery,
-                                                      $customshow,[$server]);
+                                                      $customshow,[$server],\%domains_by_server);
             ($server) = keys(%$reply);
             $Server_status{$server} = $reply->{$server};
         } else {
Index: loncom/lonsql
diff -u loncom/lonsql:1.91 loncom/lonsql:1.92
--- loncom/lonsql:1.91	Mon Nov  7 18:13:38 2011
+++ loncom/lonsql	Sun Sep  1 22:39:44 2013
@@ -3,7 +3,7 @@
 # The LearningOnline Network
 # lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
 #
-# $Id: lonsql,v 1.91 2011/11/07 18:13:38 raeburn Exp $
+# $Id: lonsql,v 1.92 2013/09/01 22:39:44 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -489,7 +489,7 @@
                 $result = &allusers_table_update($query,$uname,$udom,\%userdata);
             } else {
                 # Do an sql query
-                $result = &do_sql_query($query,$arg1,$arg2,$searchdomain);
+                $result = &do_sql_query($query,$arg1,$arg2,$arg3,$searchdomain);
             }
             # result does not need to be escaped because it has already been
             # escaped.
@@ -651,12 +651,30 @@
 }
 
 sub do_sql_query {
-    my ($query,$custom,$customshow,$searchdomain) = @_;
+    my ($query,$custom,$customshow,$domainstr,$searchdomain) = @_;
 
 #
 # limit to searchdomain if given and table is metadata
 #
-    if (($searchdomain) && ($query=~/FROM metadata/)) {
+    if ($domainstr && ($query=~/FROM metadata/)) {
+        my $havingstr;
+        $domainstr = &unescape($domainstr); 
+        if ($domainstr =~ /,/) {
+            foreach my $dom (split(/,/,$domainstr)) {
+                if ($dom =~ /^$LONCAPA::domain_re$/) {
+                    $havingstr .= 'domain="'.$dom.'" OR ';
+                }
+            }
+            $havingstr =~ s/ OR $//;
+        } else {
+            if ($domainstr =~ /^$LONCAPA::domain_re$/) {
+                $havingstr = 'domain="'.$domainstr.'"';
+            }
+        }
+        if ($havingstr) {
+            $query.=' HAVING ('.$havingstr.')';
+        }
+    } elsif (($searchdomain) && ($query=~/FROM metadata/)) {
 	$query.=' HAVING (domain="'.$searchdomain.'")';
     }
 #    &logthis('doing query ('.$searchdomain.')'.$query);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1236 loncom/lonnet/perl/lonnet.pm:1.1237
--- loncom/lonnet/perl/lonnet.pm:1.1236	Wed Aug  7 00:03:33 2013
+++ loncom/lonnet/perl/lonnet.pm	Sun Sep  1 22:39:48 2013
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1236 2013/08/07 00:03:33 raeburn Exp $
+# $Id: lonnet.pm,v 1.1237 2013/09/01 22:39:48 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -7290,19 +7290,23 @@
 # ---------------- Make a metadata query against the network of library servers
 
 sub metadata_query {
-    my ($query,$custom,$customshow,$server_array)=@_;
+    my ($query,$custom,$customshow,$server_array,$domains_hash)=@_;
     my %rhash;
     my %libserv = &all_library();
     my @server_list = (defined($server_array) ? @$server_array
                                               : keys(%libserv) );
     for my $server (@server_list) {
+        my $domains = ''; 
+        if (ref($domains_hash) eq 'HASH') {
+            $domains = $domains_hash->{$server}; 
+        }
 	unless ($custom or $customshow) {
-	    my $reply=&reply("querysend:".&escape($query),$server);
+	    my $reply=&reply("querysend:".&escape($query).':::'.&escape($domains),$server);
 	    $rhash{$server}=$reply;
 	}
 	else {
 	    my $reply=&reply("querysend:".&escape($query).':'.
-			     &escape($custom).':'.&escape($customshow),
+			     &escape($custom).':'.&escape($customshow).':'.&escape($domains),
 			     $server);
 	    $rhash{$server}=$reply;
 	}


More information about the LON-CAPA-cvs mailing list