[Bio] / Sprout / ERDBQueryConsole.pm Repository:
ViewVC logotype

Diff of /Sprout/ERDBQueryConsole.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Mon Mar 23 19:36:37 2009 UTC revision 1.5, Thu Jun 18 01:29:58 2009 UTC
# Line 33  Line 33 
33  appears in two places: once as a SeedViewer page, and once as an NMPDR plugin  appears in two places: once as a SeedViewer page, and once as an NMPDR plugin
34  Wiki console. Each of these places is responsible for insuring that the user has  Wiki console. Each of these places is responsible for insuring that the user has
35  the proper credentials and then calling this package's main method. To construct  the proper credentials and then calling this package's main method. To construct
36  a console helper, simply pass in the database name and the user's security  a console helper object, simply pass in the database name and the user's security
37  level, then call L</Submit> to validate the parameters and build the query. If  level, then call L</Submit> to validate the parameters and build the query. If
38  there are problems, call L</Errors> to get a list of error messages. If  there are problems, call L</Errors> to get a list of error messages. If
39  everything went fine, call L</Headers> to get the names and styles for the result  everything went fine, call L</Headers> to get the names and styles for the result
# Line 113  Line 113 
113  TRUE if the user is privileged and can make unlimited queries. The default  TRUE if the user is privileged and can make unlimited queries. The default
114  is FALSE.  is FALSE.
115    
116    =item raw
117    
118    TRUE to return the results in raw form rather than in HTML form.
119    
120  =back  =back
121    
122  =cut  =cut
# Line 122  Line 126 
126      my ($class, $db, %options) = @_;      my ($class, $db, %options) = @_;
127      # Get the options.      # Get the options.
128      my $secure = $options{secure} || 0;      my $secure = $options{secure} || 0;
129        my $raw = $options{raw} || 0;
130      # Get access to the database.      # Get access to the database.
131      my $erdb;      my $erdb;
132      if (! ref $db) {      if (! ref $db) {
# Line 133  Line 138 
138      my $retVal = {      my $retVal = {
139                      erdb => $erdb,                      erdb => $erdb,
140                      secure => $secure,                      secure => $secure,
141                        raw => $raw,
142                   };                   };
143      # Bless and return it.      # Bless and return it.
144      bless $retVal, $class;      bless $retVal, $class;
# Line 143  Line 149 
149    
150  =head3 Submit  =head3 Submit
151    
152      my $okFlag = $eq->Submit($objects, $filterString, \@parms, \@fields, $limitNumber);      my $okFlag = $eq->Submit($objects, $filterString, \@parms, $fields, $limitNumber);
153    
154  Submit a query to the console. This method stores the relevant  Submit a query to the console. This method stores the relevant
155  information about the query and creates the query object. Other methods  information about the query and creates the query object. Other methods
# Line 168  Line 174 
174    
175  =item fields  =item fields
176    
177  List of result field names.  String containing the result field names.
178    
179  =item limitNumber  =item limitNumber
180    
181  Maximum number of rows for the query. If the user is not privileged,  Maximum number of rows for the query. If the user is not privileged,
182    all queries are limited to a maximum number of rows determined by
183    the C<$ERDBExtras::query_limit> parameter. If the user is privileged,
184    a false value (undefined or 0) indicates an unlimited query.
185    
186  =item RETURN  =item RETURN
187    
# Line 190  Line 199 
199      $self->Clear();      $self->Clear();
200      # Count the parameter marks in the filter string.      # Count the parameter marks in the filter string.
201      my $parmCount = ERDB::CountParameterMarks($filterString);      my $parmCount = ERDB::CountParameterMarks($filterString);
     # Start the web page.  
     TWiki::Plugins::NmpdrPlugin::StartPage("ERDB Query Output", []);  
202      # Count the parameters.      # Count the parameters.
203      my $suppliedParms = scalar(@$parms);      my $suppliedParms = scalar(@$parms);
204      Trace("$suppliedParms parameters found.") if T(3);      Trace("$suppliedParms parameters found.") if T(3);
# Line 224  Line 231 
231              my $limitClause = "";              my $limitClause = "";
232              if (! $self->{secure}) {              if (! $self->{secure}) {
233                  # We do. Check for an existing limit.                  # We do. Check for an existing limit.
234                  if ($filterString =~ /(.+)\s+LIMIT\s+(\d+)(.*)/) {                  if ($filterString =~ /(.*)LIMIT\s+(\d+)(.*)/) {
235                      # Fix it if it's too big.                      # Fix it if it's too big.
236                      if ($2 >= $FIG_Config::query_limit) {                      if ($2 >= $ERDBExtras::query_limit) {
237                          $filterString = "$1 LIMIT $FIG_Config::query_limit$3";                          $filterString = "$1LIMIT $ERDBExtras::query_limit$3";
238                      }                      }
239                  } else {                  } else {
240                      # No limit present, so add one.                      # No limit present, so add one.
241                      $limitClause = " LIMIT $FIG_Config::query_limit";                      $limitClause = " LIMIT $ERDBExtras::query_limit";
242                  }                  }
243              } else {              } else {
244                  # Privileged users can request a different limit. Only use it                  # Privileged users can request a different limit. Only use it
245                  # if there is not already a limit in the filter clause.                  # if there is not already a limit in the filter clause.
246                  if ($limitNumber && $filterString !~ /\sLIMIT\s/) {                  if ($limitNumber && $filterString !~ /(?:^|\s)LIMIT\s/) {
247                      $limitClause = " LIMIT $limitNumber";                      $limitClause = " LIMIT $limitNumber";
248                      Trace("Limit clause for $limitNumber rows added to query.") if T(2);                      Trace("Limit clause for $limitNumber rows added to query.") if T(2);
249                  }                  }
# Line 333  Line 340 
340      my @items = $eq->GetRow();      my @items = $eq->GetRow();
341    
342  Get the next row of data from the query. Each row will consist of a list  Get the next row of data from the query. Each row will consist of a list
343  of HTML strings, one per result column, in the same order the field names  of HTML strings (in normal mode) or PERL objects (in raw mode), one per result
344  appeared when the query was submitted.  column, in the same order the field names appeared when the query was submitted.
345    
346  If the query is complete, an empty list will be returned.  If the query is complete, an empty list will be returned.
347    
# Line 349  Line 356 
356      if (defined $self->{query}) {      if (defined $self->{query}) {
357          # We do, so try to get the next record. Note we accumulate the          # We do, so try to get the next record. Note we accumulate the
358          # time spent and protect from errors.          # time spent and protect from errors.
   
359          my $start = time();          my $start = time();
360          my $record = $self->{query}->Fetch();          my $record = $self->{query}->Fetch();
361          $self->AddStat(duration => time() - $start);          $self->AddStat(duration => time() - $start);
# Line 361  Line 367 
367                  # Get the values for this field.                  # Get the values for this field.
368                  my @values = $record->Value($field->{name});                  my @values = $record->Value($field->{name});
369                  $self->AddStat(values => scalar(@values));                  $self->AddStat(values => scalar(@values));
370                  # Get the field type.                  # Are we returning raw data or HTML?
371                    if (! $self->{raw}) {
372                        # Here we are in HTML mode. Get the field type.
373                  my $type = $field->{type};                  my $type = $field->{type};
374                  # Convert the values to HTML and string them together.                  # Convert the values to HTML and string them together.
375                  my $cell = join("<br />", map { $type->html($_) } @values);                      my $cell = join("<br /><hr /><br />",
376                                        map { $type->html($_) } @values);
377                  # Put the result into the output list.                  # Put the result into the output list.
378                  push @retVal, $cell;                  push @retVal, $cell;
379                    } elsif ($field->{secondary}) {
380                        # This is a raw secondary field. It's returned as a list reference.
381                        push @retVal, \@values;
382                    } else {
383                        # This is a raw primary field. It's returned as a scalar.
384                        # Note that if the field is empty, we'll be stuffing an
385                        # undefined value in its position of this row.
386                        push @retVal, $values[0];
387                    }
388              }              }
389          }          }
390      }      }
# Line 442  Line 460 
460      my $parmsCount = scalar @$parms;      my $parmsCount = scalar @$parms;
461      for (my $i = 0; $i < $parmsCount; $i++) {      for (my $i = 0; $i < $parmsCount; $i++) {
462          if (defined $parameters[$i]) {          if (defined $parameters[$i]) {
463              push @parmStrings, '$' . $parameters[$i];              push @parmStrings, $parameters[$i];
464          } else {          } else {
465              push @parmStrings, Quotify($parms->[$i]);              push @parmStrings, Quotify($parms->[$i]);
466          }          }
# Line 455  Line 473 
473      # The result from the Get call depends on the type: a list for      # The result from the Get call depends on the type: a list for
474      # GetAll, a scalar for Get.      # GetAll, a scalar for Get.
475      my $getResultName = ($codeStyle eq 'Get' ? '$qh' : '@resultRows');      my $getResultName = ($codeStyle eq 'Get' ? '$qh' : '@resultRows');
476        # Not we compute the function name. It's the same as the code style
477        # unless we're doing a GetAll and there's only one field. In that case
478        # we do a GetFlat.
479        my $getName = ($codeStyle eq 'GetAll' && scalar(@$fields) == 1 ? 'GetFlat' : $codeStyle);
480      # Build the Get. It's multiple lines, so we need to compute how far to      # Build the Get. It's multiple lines, so we need to compute how far to
481      # indent the secondary lines. In addition, we need to decide here whether      # indent the secondary lines. In addition, we need to decide here whether
482      # we're doing a Get or a GetAll.      # we're doing a Get or a GetAll.
483      my $buffer = "my $getResultName = $dbObjectName->$codeStyle(";      my $buffer = "my $getResultName = $dbObjectName->$getName(";
484      my $continueTab = " " x length($buffer);      my $continueTab = " " x length($buffer);
485      # Now set up the buffer so that it has the Get call and the object      # Now set up the buffer so that it has the Get call and the object
486      # name string. This is the minimum content for the first line.      # name string. This is the minimum content for the first line.
# Line 468  Line 490 
490      if (! @parmStrings) {      if (! @parmStrings) {
491          push @pieces, "[]";          push @pieces, "[]";
492      } else {      } else {
493            # Here we have a list of parameters. The first begins with a left bracket.
494          push @pieces, "[" . shift(@parmStrings);          push @pieces, "[" . shift(@parmStrings);
495          push @pieces, @parmStrings;          # If there's more than one, we need to do some comma-joining.
496            while (my $piece = shift @parmStrings) {
497                # Put a comma at the end of the last piece.
498                $pieces[$#pieces] .= ",";
499                # Add the next piece.
500                push @pieces, $piece;
501            }
502            # Put a right bracket on the last piece.
503          $pieces[$#pieces] .= "]";          $pieces[$#pieces] .= "]";
504      }      }
505      # If this is a GetAll, the field names go in here, too.      # If this is a GetAll, the field names go in here, too.
506      if ($codeStyle eq 'GetAll') {      if ($codeStyle eq 'GetAll') {
507          # First, we need to put a comma at the end of the last parameter.          # First, we need to put a comma at the end of the last parameter.
508          $pieces[$#pieces] .= ", ";          $pieces[$#pieces] .= ", ";
509          # Now, we create a list of the field names. We use the qw          # Is this GetFlat?
510          # trick to make them into a list.          if ($getName eq 'GetFlat') {
511                # Yes, so we have a single field.
512                my $fieldName = $fields->[0]{name};
513                push @pieces, "'$fieldName'";
514            } else {
515                # No, so we create a list of the field names. We use the qw
516                # trick to do this.
517          my @quotedFields = map { $_->{name} } @$fields;          my @quotedFields = map { $_->{name} } @$fields;
518          $quotedFields[0] = "[qw(" . $quotedFields[0];          $quotedFields[0] = "[qw(" . $quotedFields[0];
519          $quotedFields[$#quotedFields] .= ")]";          $quotedFields[$#quotedFields] .= ")]";
# Line 486  Line 522 
522          }          }
523          push @pieces, @quotedFields;          push @pieces, @quotedFields;
524      }      }
525        }
526      # Put the statement terminator on the last piece.      # Put the statement terminator on the last piece.
527      $pieces[$#pieces] .= ");";      $pieces[$#pieces] .= ");";
528      # Loop through the pieces, building the code lines.      # Loop through the pieces, building the code lines.
# Line 529  Line 566 
566              # Output the statement.              # Output the statement.
567              push @codeLines, "$tab$statement";              push @codeLines, "$tab$statement";
568          }          }
569          # Close the fetch loop.          # Close the fetch loop. This next line looks strange, but it
570          push @codeLines, "$tab##TODO: Process data";          # is necessary to keep the Komodo TODO-hunter from flagging this
571            # line as an uncompleted task.
572            my $sharps = "##" . "TODO";
573            push @codeLines, "$tab##" . "TODO: Process data";
574          push @codeLines, "}";          push @codeLines, "}";
575                          }                          }
576      # Return the result.      # Return the result.
# Line 570  Line 610 
610      return $retVal;      return $retVal;
611  }  }
612    
613    =head3 Messages
614    
615        my $messages = $eq->Messages();
616    
617    Return the error and status messages for the current query as a single string.
618    
619    =cut
620    
621    sub Messages {
622        # Get the parameters.
623        my ($self) = @_;
624        # Return the queued messages.
625        return join("\n", $self->{stats}->Messages());
626    }
627    
628    
629    
630    =head3 SplitFields
631    
632        my @fields = ERDBQueryConsole::SplitFields($fieldString);
633    
634    Convert a field string to a list of field names. The string can be either
635    comma-delimited or space-delimited.
636    
637    =over 4
638    
639    =item fieldString
640    
641    String of field names.
642    
643    =item RETURN
644    
645    Returns a list of the field names culled from the string.
646    
647    =back
648    
649    =cut
650    
651    sub SplitFields {
652        # Get the parameters.
653        my ($fieldString) = @_;
654        # Declare the return variable.
655        my @retVal;
656        if ($fieldString =~ /,/) {
657            # We found a comma, so use the comma pattern.
658            push @retVal, split /\s*,\s*/, $fieldString;
659        } else {
660            # No commas, so use the space pattern.
661            push @retVal, split /\s+/, $fieldString;
662        }
663        # Return the result.
664        return @retVal;
665    }
666    
667  =head2 Internal Methods  =head2 Internal Methods
668    
# Line 681  Line 774 
774  }  }
775    
776    
777    
778    
779  1;  1;

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3