[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.6, Tue Jun 30 19:53:01 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 46  Line 46 
46    
47  =item erdb  =item erdb
48    
49  [[ErdbPm]] database object for the current database.  L<ERDB> database object for the current database.
50    
51  =item query  =item query
52    
53  [[ERDBQueryPm]] object for obtaining the query results.  L<ERDBQuery> object for obtaining the query results.
54    
55  =item fields  =item fields
56    
# Line 95  Line 95 
95    
96  =item db  =item db
97    
98  Database against which to run the query. This can be either an [[ErdbPm]]  Database against which to run the query. This can be either an L<ERDB>
99  object for the database or a string containing the database name.  object for the database or a string containing the database name.
100    
101  =item options  =item options
# 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);
362          # Only proceed if a record was found.          # Only proceed if a record was found.
363          if (defined $record) {          if (defined $record) {
364                $self->AddStat(records => 1);
365              # Now we have the data for this row, and it's time to              # Now we have the data for this row, and it's time to
366              # stuff it into the return list. Loop through the fields.              # stuff it into the return list. Loop through the fields.
367              for my $field (@{$self->{fields}}) {              for my $field (@{$self->{fields}}) {
368                  # Get the values for this field.                  # Get the values for this field.
369                  my @values = $record->Value($field->{name});                  my @values = $record->Value($field->{name});
370                  $self->AddStat(values => scalar(@values));                  $self->AddStat(values => scalar(@values));
371                  # Get the field type.                  # Are we returning raw data or HTML?
372                    if (! $self->{raw}) {
373                        # Here we are in HTML mode. Get the field type.
374                  my $type = $field->{type};                  my $type = $field->{type};
375                  # Convert the values to HTML and string them together.                  # Convert the values to HTML and string them together.
376                  my $cell = join("<br />", map { $type->html($_) } @values);                      my $cell = join("<br /><hr /><br />",
377                                        map { $type->html($_) } @values);
378                  # Put the result into the output list.                  # Put the result into the output list.
379                  push @retVal, $cell;                  push @retVal, $cell;
380                    } elsif ($field->{secondary}) {
381                        # This is a raw secondary field. It's returned as a list reference.
382                        push @retVal, \@values;
383                    } else {
384                        # This is a raw primary field. It's returned as a scalar.
385                        # Note that if the field is empty, we'll be stuffing an
386                        # undefined value in its position of this row.
387                        push @retVal, $values[0];
388                    }
389              }              }
390          }          }
391      }      }
# Line 407  Line 426 
426    
427  =cut  =cut
428    
429    use constant GET_VAR_NAME => { Get => '$qh', GetFlat => '@results',
430                                   GetAll => '@rows' };
431    
432  sub GetCode {  sub GetCode {
433      # Get the parameters.      # Get the parameters.
434      my ($self, $dbVarName, $codeStyle, @parameters) = @_;      my ($self, $dbVarName, $codeStyle, @parameters) = @_;
# Line 442  Line 464 
464      my $parmsCount = scalar @$parms;      my $parmsCount = scalar @$parms;
465      for (my $i = 0; $i < $parmsCount; $i++) {      for (my $i = 0; $i < $parmsCount; $i++) {
466          if (defined $parameters[$i]) {          if (defined $parameters[$i]) {
467              push @parmStrings, '$' . $parameters[$i];              push @parmStrings, $parameters[$i];
468          } else {          } else {
469              push @parmStrings, Quotify($parms->[$i]);              push @parmStrings, Quotify($parms->[$i]);
470          }          }
# Line 452  Line 474 
474      $quotedObjectNameString =~ s/\s+/ /;      $quotedObjectNameString =~ s/\s+/ /;
475      # Quote the filter string.      # Quote the filter string.
476      my $quotedFilterString = Quotify($self->{filterString});      my $quotedFilterString = Quotify($self->{filterString});
477        # Not we compute the function name. It's the same as the code style
478        # unless we're doing a GetAll and there's only one field. In that case
479        # we do a GetFlat.
480        my $getName = ($codeStyle eq 'GetAll' && scalar(@$fields) == 1 ? 'GetFlat' : $codeStyle);
481      # 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
482      # GetAll, a scalar for Get.      # GetAll or GetFlat, a scalar for Get.
483      my $getResultName = ($codeStyle eq 'Get' ? '$qh' : '@resultRows');      my $getResultName = GET_VAR_NAME->{$getName};
484      # 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
485      # indent the secondary lines. In addition, we need to decide here whether      # indent the secondary lines. In addition, we need to decide here whether
486      # we're doing a Get or a GetAll.      # we're doing a Get or a GetAll.
487      my $buffer = "my $getResultName = $dbObjectName->$codeStyle(";      my $buffer = "my $getResultName = $dbObjectName->$getName(";
488      my $continueTab = " " x length($buffer);      my $continueTab = " " x length($buffer);
489      # 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
490      # 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 494 
494      if (! @parmStrings) {      if (! @parmStrings) {
495          push @pieces, "[]";          push @pieces, "[]";
496      } else {      } else {
497            # Here we have a list of parameters. The first begins with a left bracket.
498          push @pieces, "[" . shift(@parmStrings);          push @pieces, "[" . shift(@parmStrings);
499          push @pieces, @parmStrings;          # If there's more than one, we need to do some comma-joining.
500            while (my $piece = shift @parmStrings) {
501                # Put a comma at the end of the last piece.
502                $pieces[$#pieces] .= ",";
503                # Add the next piece.
504                push @pieces, $piece;
505            }
506            # Put a right bracket on the last piece.
507          $pieces[$#pieces] .= "]";          $pieces[$#pieces] .= "]";
508      }      }
509      # If this is a GetAll, the field names go in here, too.      # If this is a GetAll, the field names go in here, too.
510      if ($codeStyle eq 'GetAll') {      if ($codeStyle eq 'GetAll') {
511          # 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.
512          $pieces[$#pieces] .= ", ";          $pieces[$#pieces] .= ", ";
513          # Now, we create a list of the field names. We use the qw          # Is this GetFlat?
514          # trick to make them into a list.          if ($getName eq 'GetFlat') {
515                # Yes, so we have a single field.
516                my $fieldName = $fields->[0]{name};
517                push @pieces, "'$fieldName'";
518            } else {
519                # No, so we create a list of the field names. We use the qw
520                # trick to do this.
521          my @quotedFields = map { $_->{name} } @$fields;          my @quotedFields = map { $_->{name} } @$fields;
522          $quotedFields[0] = "[qw(" . $quotedFields[0];          $quotedFields[0] = "[qw(" . $quotedFields[0];
523          $quotedFields[$#quotedFields] .= ")]";          $quotedFields[$#quotedFields] .= ")]";
# Line 486  Line 526 
526          }          }
527          push @pieces, @quotedFields;          push @pieces, @quotedFields;
528      }      }
529        }
530      # Put the statement terminator on the last piece.      # Put the statement terminator on the last piece.
531      $pieces[$#pieces] .= ");";      $pieces[$#pieces] .= ");";
532      # Loop through the pieces, building the code lines.      # Loop through the pieces, building the code lines.
# Line 529  Line 570 
570              # Output the statement.              # Output the statement.
571              push @codeLines, "$tab$statement";              push @codeLines, "$tab$statement";
572          }          }
573          # Close the fetch loop.          # Close the fetch loop. This next line looks strange, but it
574          push @codeLines, "$tab##TODO: Process data";          # is necessary to keep the Komodo TODO-hunter from flagging this
575            # line as an uncompleted task.
576            my $sharps = "##" . "TODO";
577            push @codeLines, "$tab##" . "TODO: Process data";
578          push @codeLines, "}";          push @codeLines, "}";
579                          }                          }
580      # Return the result.      # Return the result.
# Line 570  Line 614 
614      return $retVal;      return $retVal;
615  }  }
616    
617    =head3 Messages
618    
619        my $messages = $eq->Messages();
620    
621    Return the error and status messages for the current query as a single string.
622    
623    =cut
624    
625    sub Messages {
626        # Get the parameters.
627        my ($self) = @_;
628        # Return the queued messages.
629        return join("\n", $self->{stats}->Messages());
630    }
631    
632    
633    
634    =head3 SplitFields
635    
636        my @fields = ERDBQueryConsole::SplitFields($fieldString);
637    
638    Convert a field string to a list of field names. The string can be either
639    comma-delimited or space-delimited.
640    
641    =over 4
642    
643    =item fieldString
644    
645    String of field names.
646    
647    =item RETURN
648    
649    Returns a list of the field names culled from the string.
650    
651    =back
652    
653    =cut
654    
655    sub SplitFields {
656        # Get the parameters.
657        my ($fieldString) = @_;
658        # Declare the return variable.
659        my @retVal;
660        if ($fieldString =~ /,/) {
661            # We found a comma, so use the comma pattern.
662            push @retVal, split /\s*,\s*/, $fieldString;
663        } else {
664            # No commas, so use the space pattern.
665            push @retVal, split /\s+/, $fieldString;
666        }
667        # Return the result.
668        return @retVal;
669    }
670    
671  =head2 Internal Methods  =head2 Internal Methods
672    
# Line 681  Line 778 
778  }  }
779    
780    
781    
782    
783  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3