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

Annotation of /Sprout/ERDBQueryConsole.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     #
4 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
5 :     # for Interpretations of Genomes. All Rights Reserved.
6 :     #
7 :     # This file is part of the SEED Toolkit.
8 :     #
9 :     # The SEED Toolkit is free software. You can redistribute
10 :     # it and/or modify it under the terms of the SEED Toolkit
11 :     # Public License.
12 :     #
13 :     # You should have received a copy of the SEED Toolkit Public License
14 :     # along with this program; if not write to the University of Chicago
15 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
16 :     # Genomes at veronika@thefig.info or download a copy from
17 :     # http://www.theseed.org/LICENSE.TXT.
18 :     #
19 :    
20 :     package ERDBQueryConsole;
21 :    
22 :     use strict;
23 :     use Tracer;
24 :     use CGI;
25 :     use ERDB;
26 :     use Stats;
27 :    
28 :     =head1 ERDB Query Console Helper
29 :    
30 :     =head2 Introduction
31 :    
32 :     This is a simple helper class used by the ERDB Query Console. The console
33 :     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
35 :     the proper credentials and then calling this package's main method. To construct
36 : parrello 1.3 a console helper object, simply pass in the database name and the user's security
37 : parrello 1.1 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
39 :     everything went fine, call L</Headers> to get the names and styles for the result
40 :     columns and then L</GetRow> to get the individual result rows. The row elements
41 :     will be pre-encoded into HTML.
42 :    
43 :     The fields in this object are as follows.
44 :    
45 :     =over 4
46 :    
47 :     =item erdb
48 :    
49 : parrello 1.6 L<ERDB> database object for the current database.
50 : parrello 1.1
51 :     =item query
52 :    
53 : parrello 1.6 L<ERDBQuery> object for obtaining the query results.
54 : parrello 1.1
55 :     =item fields
56 :    
57 :     Reference to a list of result field information, in order. For
58 :     each result field, the list contains a hash consisting of the
59 :     field name (C<name>), a flag indicating whether or not it is
60 :     secondary (C<secondary>), and a reference to the field's
61 :     type object (C<type>).
62 :    
63 :     =item objects
64 :    
65 :     Object name string for the query.
66 :    
67 :     =item filterString
68 :    
69 :     Filter string for the query.
70 :    
71 :     =item parms
72 :    
73 :     Reference to a list of parameter values. There should be one parameter
74 :     value for each parameter mark in the query.
75 :    
76 :     =item secure
77 :    
78 :     TRUE if the user is privileged, else FALSE.
79 :    
80 :     =item stats
81 :    
82 :     Statistics object.
83 :    
84 :     =back
85 :    
86 :     =cut
87 :    
88 :     =head3 new
89 :    
90 :     my $eq = ERDBQueryConsole->new($db, %options);
91 :    
92 :     Construct a new ERDBQueryConsole object. The parameters are as follows.
93 :    
94 :     =over 4
95 :    
96 :     =item db
97 :    
98 : parrello 1.6 Database against which to run the query. This can be either an L<ERDB>
99 : parrello 1.1 object for the database or a string containing the database name.
100 :    
101 :     =item options
102 :    
103 :     A hash of constructor options.
104 :    
105 :     =back
106 :    
107 :     The following options are supported.
108 :    
109 :     =over 4
110 :    
111 :     =item secure
112 :    
113 :     TRUE if the user is privileged and can make unlimited queries. The default
114 :     is FALSE.
115 :    
116 : parrello 1.5 =item raw
117 :    
118 :     TRUE to return the results in raw form rather than in HTML form.
119 :    
120 : parrello 1.1 =back
121 :    
122 :     =cut
123 :    
124 :     sub new {
125 :     # Get the parameters.
126 :     my ($class, $db, %options) = @_;
127 :     # Get the options.
128 :     my $secure = $options{secure} || 0;
129 : parrello 1.5 my $raw = $options{raw} || 0;
130 : parrello 1.1 # Get access to the database.
131 :     my $erdb;
132 :     if (! ref $db) {
133 :     $erdb = ERDB::GetDatabase($db);
134 :     } else {
135 :     $erdb = $db;
136 :     }
137 :     # Create the ERDBQueryConsole object.
138 :     my $retVal = {
139 :     erdb => $erdb,
140 :     secure => $secure,
141 : parrello 1.5 raw => $raw,
142 : parrello 1.1 };
143 :     # Bless and return it.
144 :     bless $retVal, $class;
145 :     return $retVal;
146 :     }
147 :    
148 :     =head2 Public Methods
149 :    
150 :     =head3 Submit
151 :    
152 : parrello 1.3 my $okFlag = $eq->Submit($objects, $filterString, \@parms, $fields, $limitNumber);
153 : parrello 1.1
154 :     Submit a query to the console. This method stores the relevant
155 :     information about the query and creates the query object. Other methods
156 :     can be used to get the results of the query or a list of error messages.
157 :    
158 :     =over 4
159 :    
160 :     =item objects
161 :    
162 :     Object name string containing the list of objects that particpate in the
163 :     query.
164 :    
165 :     =item filterString
166 :    
167 :     Filter string for the query, specifying the query conditions, sort order,
168 :     and limit.
169 :    
170 :     =item parms
171 :    
172 :     Reference to a list of parameter values. Each parameter value is plugged
173 :     into a parameter mark in the filter string.
174 :    
175 :     =item fields
176 :    
177 : parrello 1.3 String containing the result field names.
178 : parrello 1.1
179 :     =item limitNumber
180 :    
181 : parrello 1.3 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 : parrello 1.4 a false value (undefined or 0) indicates an unlimited query.
185 : parrello 1.1
186 :     =item RETURN
187 :    
188 :     Returns TRUE if the query was successful, FALSE if an error was
189 :     detected.
190 :    
191 :     =back
192 :    
193 :     =cut
194 :    
195 :     sub Submit {
196 :     # Get the parameters.
197 :     my ($self, $objects, $filterString, $parms, $fields, $limitNumber) = @_;
198 :     # Clear this object for a new query.
199 :     $self->Clear();
200 :     # Count the parameter marks in the filter string.
201 :     my $parmCount = ERDB::CountParameterMarks($filterString);
202 :     # Count the parameters.
203 :     my $suppliedParms = scalar(@$parms);
204 :     Trace("$suppliedParms parameters found.") if T(3);
205 :     # Verify the various parameters.
206 :     if (! $objects) {
207 :     $self->Error("No object list specified. Query aborted.");
208 :     } elsif (! $fields) {
209 :     $self->Error("No output fields specified. Query aborted.");
210 :     } elsif ($parmCount > $suppliedParms) {
211 :     $self->Error("You have $parmCount parameter marks but only $suppliedParms " .
212 :     "Parameters. Insure each parameter is on a separate line in " .
213 :     "the parameters box and that you don't have any extra question " .
214 :     "marks (?) in the Filter String.");
215 :     } elsif ($parmCount < $suppliedParms) {
216 :     $self->Error("You have $suppliedParms Parameters but there are only " .
217 :     "$parmCount parameter marks in the Filter String.")
218 :     } else {
219 :     # Now we can do the query. First, get the database object.
220 :     my $db = $self->{erdb};
221 :     # Parse the object name list.
222 :     my @nameErrors = $db->CheckObjectNames($objects);
223 :     if (@nameErrors) {
224 :     # Here there were errors in the object name string.
225 :     for my $nameError (@nameErrors) {
226 :     $self->Error($nameError);
227 :     }
228 :     $self->Error("Errors were found in the Object Names.");
229 :     } else {
230 :     # Check to see if we need to limit this query.
231 :     my $limitClause = "";
232 :     if (! $self->{secure}) {
233 :     # We do. Check for an existing limit.
234 : parrello 1.3 if ($filterString =~ /(.*)LIMIT\s+(\d+)(.*)/) {
235 : parrello 1.1 # Fix it if it's too big.
236 : parrello 1.3 if ($2 >= $ERDBExtras::query_limit) {
237 :     $filterString = "$1LIMIT $ERDBExtras::query_limit$3";
238 : parrello 1.1 }
239 :     } else {
240 :     # No limit present, so add one.
241 : parrello 1.3 $limitClause = " LIMIT $ERDBExtras::query_limit";
242 : parrello 1.1 }
243 :     } else {
244 :     # Privileged users can request a different limit. Only use it
245 :     # if there is not already a limit in the filter clause.
246 : parrello 1.3 if ($limitNumber && $filterString !~ /(?:^|\s)LIMIT\s/) {
247 : parrello 1.1 $limitClause = " LIMIT $limitNumber";
248 :     Trace("Limit clause for $limitNumber rows added to query.") if T(2);
249 :     }
250 :     }
251 :     # Now we need to find things out about the fields. For each one,
252 :     # we need a column name and a cell format. To get that, we
253 :     # start the query and analyze the fields.
254 :     Trace("Preparing query.") if T(3);
255 :     my $query = eval('$db->Prepare($objects, "$filterString$limitClause", $parms)');
256 :     if ($@) {
257 :     # Here the query preparation failed for some reason. This is usually an
258 :     # SQL syntax error.
259 :     $self->Error("QUERY ERROR: $@");
260 :     } else {
261 :     Trace("Parsing field list.") if T(3);
262 :     # We need to get the necessary data for each field in the field list.
263 :     # This will be set to TRUE if a valid field is found.
264 :     my $found;
265 :     # Now loop through the field names.
266 :     for my $field (@$fields) {
267 :     Trace("Processing field name \"$field\".") if T(3);
268 :     # Get the data for this field.
269 :     my ($objectName, $fieldName, $type) = $query->CheckFieldName($field);
270 :     if (! defined $objectName) {
271 :     # Here the field specification had an invalid format.
272 :     $self->Error("Field specifier \"$field\" has an invalid format.");
273 :     } elsif (! defined $fieldName) {
274 :     # Here the object name was invalid. That generates a warning.
275 :     $self->Error("Object name \"$objectName\" not found in query.");
276 :     } elsif (! defined $type) {
277 :     # Here the field name was invalid. That is also a warning.
278 :     $self->Error("Field \"$fieldName\" not found in $objectName.");
279 :     } else {
280 :     # Here the field name is okay. Save its data.
281 :     push @{$self->{fields}},
282 :     { name => $field, type => $type,
283 :     secondary => $db->IsSecondary($fieldName, $objectName)
284 :     };
285 :     # Count the field.
286 :     $self->AddStat(fields => 1);
287 :     $found = 1;
288 :     }
289 :     }
290 :     # Insure we have at least one valid field.
291 :     if (! $found) {
292 :     $self->Error("No valid field names were specified for this query.");
293 :     } else {
294 :     # We do, so save the query and its parameters.
295 :     $self->{query} = $query;
296 :     $self->{parms} = $parms;
297 :     $self->{objects} = $objects;
298 :     $self->{filterString} = $filterString;
299 :     }
300 :     }
301 :     }
302 :     }
303 :     # Return TRUE if no errors were detected.
304 :     return defined $self->{query};
305 :     }
306 :    
307 :     =head3 Headers
308 :    
309 :     my @columnData = $eq->Headers();
310 :    
311 :     Return the header information for each column of the output. The header
312 :     information is returned as a list of 2-tuples. For each column, the
313 :     2-tuple includes the column caption and the alignment (C<left>, C<right>,
314 :     or C<center>).
315 :    
316 :     =cut
317 :    
318 :     sub Headers {
319 :     # Get the parameters.
320 :     my ($self) = @_;
321 :     # Declare the return variable.
322 :     my @retVal;
323 :     # Insure we have fields. If we don't, the query will be treated as
324 :     # having 0 output columns: we'll return an empty list.
325 :     if (defined $self->{fields}) {
326 :     # We have something, so loop through the fields.
327 :     for my $field (@{$self->{fields}}) {
328 :     # Compute the alignment.
329 :     my $align = $field->{type}->align();
330 :     # Push it into the result list along with the field name.
331 :     push @retVal, [$field->{name}, $align];
332 :     }
333 :     }
334 :     # Return the result.
335 :     return @retVal;
336 :     }
337 :    
338 :     =head3 GetRow
339 :    
340 :     my @items = $eq->GetRow();
341 :    
342 :     Get the next row of data from the query. Each row will consist of a list
343 : parrello 1.5 of HTML strings (in normal mode) or PERL objects (in raw mode), one per result
344 :     column, in the same order the field names appeared when the query was submitted.
345 : parrello 1.1
346 :     If the query is complete, an empty list will be returned.
347 :    
348 :     =cut
349 :    
350 :     sub GetRow {
351 :     # Get the parameters.
352 :     my ($self) = @_;
353 :     # Declare the return variable.
354 :     my @retVal;
355 :     # Only proceed if we have an active query.
356 :     if (defined $self->{query}) {
357 :     # We do, so try to get the next record. Note we accumulate the
358 :     # time spent and protect from errors.
359 :     my $start = time();
360 :     my $record = $self->{query}->Fetch();
361 :     $self->AddStat(duration => time() - $start);
362 :     # Only proceed if a record was found.
363 :     if (defined $record) {
364 : parrello 1.6 $self->AddStat(records => 1);
365 : parrello 1.1 # Now we have the data for this row, and it's time to
366 :     # stuff it into the return list. Loop through the fields.
367 :     for my $field (@{$self->{fields}}) {
368 :     # Get the values for this field.
369 :     my @values = $record->Value($field->{name});
370 :     $self->AddStat(values => scalar(@values));
371 : parrello 1.5 # 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};
375 :     # Convert the values to HTML and string them together.
376 :     my $cell = join("<br /><hr /><br />",
377 :     map { $type->html($_) } @values);
378 :     # Put the result into the output list.
379 :     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 : parrello 1.1 }
390 :     }
391 :     }
392 :     # Return the result.
393 :     return @retVal;
394 :     }
395 :    
396 :     =head3 GetCode
397 :    
398 :     my $codeString = $eq->GetCode($dbVarName, $codeStyle, @parameters);
399 :    
400 :     Return the PERL code to perform the query submitted to this console.
401 :    
402 :     =over 4
403 :    
404 :     =item dbVarName
405 :    
406 :     Name to give to the variable containing the database object.
407 :    
408 :     =item codeStyle
409 :    
410 :     Coding style to use: C<Get> for a get loop, C<GetAll> for a single get-all
411 :     statement.
412 :    
413 :     =item parameters
414 :    
415 :     List of parameter names. If a parameter name is a string, then the
416 :     corresponding parameter will be encoded as a variable with the name
417 :     given by the string. If a parameter name is an undefined value, the
418 :     parameter value will be encoded as a constant.
419 :    
420 :     =item RETURN
421 :    
422 :     Returns a string containing the PERL code to duplicate the incoming
423 :     query.
424 :    
425 :     =back
426 :    
427 :     =cut
428 :    
429 : parrello 1.6 use constant GET_VAR_NAME => { Get => '$qh', GetFlat => '@results',
430 :     GetAll => '@rows' };
431 :    
432 : parrello 1.1 sub GetCode {
433 :     # Get the parameters.
434 :     my ($self, $dbVarName, $codeStyle, @parameters) = @_;
435 :     # We'll create lines of PERL code in here.
436 :     my @codeLines;
437 :     # We'll use this constant for tabbing purposes.
438 :     my $tab = " " x 4;
439 :     # Compute the name of the database object.
440 :     my $dbObjectName = '$' . $dbVarName;
441 :     # We start with some USE statements.
442 :     push @codeLines, "use ERDB;",
443 :     "use Tracer;";
444 :     # Get the field list. We'll be using it a lot.
445 :     my $fields = $self->{fields};
446 :     # Add "use" statements for all the field types. We build a hash
447 :     # to prevent duplicates.
448 :     my %uses;
449 :     for my $field (@$fields) {
450 :     my $type = $field->{type}->objectType();
451 :     if ($type) {
452 :     $uses{$type} = 1;
453 :     }
454 :     }
455 :     push @codeLines, map { "use $_;" } sort keys %uses;
456 :     # Now create the database object.
457 :     my $dbType = ref $self->{erdb};
458 :     push @codeLines, "",
459 :     "my $dbObjectName = ERDB::GetDatabase('$dbType');",
460 :     "";
461 :     # Compute the parameter strings list.
462 :     my @parmStrings;
463 :     my $parms = $self->{parms};
464 :     my $parmsCount = scalar @$parms;
465 :     for (my $i = 0; $i < $parmsCount; $i++) {
466 :     if (defined $parameters[$i]) {
467 : parrello 1.3 push @parmStrings, $parameters[$i];
468 : parrello 1.1 } else {
469 :     push @parmStrings, Quotify($parms->[$i]);
470 :     }
471 :     }
472 :     # Clean up and quote the object name string.
473 :     my $quotedObjectNameString = qq("$self->{objects}");
474 :     $quotedObjectNameString =~ s/\s+/ /;
475 :     # Quote the filter string.
476 :     my $quotedFilterString = Quotify($self->{filterString});
477 : parrello 1.3 # 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 : parrello 1.6 # The result from the Get call depends on the type: a list for
482 :     # GetAll or GetFlat, a scalar for Get.
483 :     my $getResultName = GET_VAR_NAME->{$getName};
484 : parrello 1.1 # 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
486 :     # we're doing a Get or a GetAll.
487 : parrello 1.3 my $buffer = "my $getResultName = $dbObjectName->$getName(";
488 : parrello 1.1 my $continueTab = " " x length($buffer);
489 :     # 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.
491 :     $buffer .= "$quotedObjectNameString, ";
492 :     # Now we break the rest of the statement into pieces.
493 :     my @pieces = "$quotedFilterString, ";
494 :     if (! @parmStrings) {
495 :     push @pieces, "[]";
496 :     } else {
497 : parrello 1.5 # Here we have a list of parameters. The first begins with a left bracket.
498 : parrello 1.1 push @pieces, "[" . shift(@parmStrings);
499 : parrello 1.5 # 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 : parrello 1.1 $pieces[$#pieces] .= "]";
508 :     }
509 :     # If this is a GetAll, the field names go in here, too.
510 :     if ($codeStyle eq 'GetAll') {
511 :     # First, we need to put a comma at the end of the last parameter.
512 :     $pieces[$#pieces] .= ", ";
513 : parrello 1.3 # Is this GetFlat?
514 :     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;
522 :     $quotedFields[0] = "[qw(" . $quotedFields[0];
523 :     $quotedFields[$#quotedFields] .= ")]";
524 :     for (my $i = 0; $i < $#quotedFields; $i++) {
525 :     $quotedFields[$i] .= " ";
526 :     }
527 :     push @pieces, @quotedFields;
528 : parrello 1.1 }
529 :     }
530 :     # Put the statement terminator on the last piece.
531 :     $pieces[$#pieces] .= ");";
532 :     # Loop through the pieces, building the code lines.
533 :     for my $piece (@pieces) {
534 :     if (length($buffer) + length($piece) > 80) {
535 :     push @codeLines, $buffer;
536 :     $buffer = $continueTab;
537 :     }
538 :     $buffer .= $piece;
539 :     }
540 :     # Finish the Get statement. The buffer is never empty after the above
541 :     # loop.
542 :     push @codeLines, $buffer;
543 :     # The rest of this is only necessary for the Get-style.
544 :     if ($codeStyle eq 'Get') {
545 :     # Build the fetch loop.
546 :     push @codeLines, "while (my \$resultRow = \$qh->Fetch()) {";
547 :     # Extract each field value.
548 :     for my $field (@$fields) {
549 :     # Get the field name.
550 :     my $fieldName = $field->{name};
551 :     # Convert the field name to a camel-cased variable name.
552 :     my @pieces = split /[^a-z]+/, lc $fieldName;
553 :     my $varName = shift @pieces;
554 :     $varName .= join("", map { ucfirst $_ } @pieces);
555 :     # We'll put the retrieval statement in here.
556 :     my $statement;
557 :     # Is this a primary field or a secondary field?
558 :     if ($field->{secondary}) {
559 :     # It's a secondary field, so we get a list of values.
560 :     $statement = "my \@$varName = \$resultRow->Value('$fieldName');";
561 :     } else {
562 :     # It's primary, so we get a single value.
563 :     $statement = "my \$$varName = \$resultRow->PrimaryValue('$fieldName');";
564 :     }
565 :     # If this field is complex, add a comment about the field type.
566 :     my $type = $field->{type}->objectType();
567 :     if (defined $type) {
568 :     $statement .= " # $type object";
569 :     }
570 :     # Output the statement.
571 :     push @codeLines, "$tab$statement";
572 :     }
573 : parrello 1.3 # Close the fetch loop. This next line looks strange, but it
574 :     # 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 : parrello 1.1 push @codeLines, "}";
579 :     }
580 :     # Return the result.
581 :     return join("\n", @codeLines, "");
582 :     }
583 :    
584 :     =head3 Summary
585 :    
586 :     my $statsHtml = $eq->Summary();
587 :    
588 :     Return an HTML display of the statistics and messages for this query.
589 :    
590 :     =cut
591 :    
592 :     sub Summary {
593 :     # Get the parameters.
594 :     my ($self) = @_;
595 :     # We'll accumulate HTML in here.
596 :     my $retVal = "";
597 :     # Get the statistics object.
598 :     my $stats = $self->{stats};
599 :     # Extract the messages.
600 :     my @messages = $stats->Messages();
601 :     # If there are messages, we need to display them.
602 :     if (scalar @messages) {
603 :     $retVal .= CGI::p("Errors and warnings for this query.") .
604 :     CGI::ul(map { CGI::li(CGI::escapeHTML($_)) } @messages);
605 :     }
606 :     # Now we display the statistics in alphabetical order, using a table.
607 :     my $statMap = $stats->Map();
608 :     my @keys = sort { Tracer::Cmp($a, $b) } keys %$statMap;
609 :     $retVal .= CGI::h3("Query Statistics");
610 :     $retVal .= CGI::table(
611 :     map { CGI::Tr(CGI::th($_), CGI::td({ align => 'right' },
612 :     $statMap->{$_})) } @keys);
613 :     # Return the result.
614 :     return $retVal;
615 :     }
616 :    
617 : parrello 1.5 =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 : parrello 1.3 =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 : parrello 1.1
671 :     =head2 Internal Methods
672 :    
673 :     =head3 Quotify
674 :    
675 :     my $quoted = ERDBQueryConsole::Quotify($string);
676 :    
677 :     Convert the input string to a PERL string constant. Internal single
678 :     quotes will be escaped, and the entire string will be surrounded by
679 :     single quotes.
680 :    
681 :     =over 4
682 :    
683 :     =item string
684 :    
685 :     String to be quoted.
686 :    
687 :     =item RETURN
688 :    
689 :     Returns the string in a format suitable for encoding as a PERL
690 :     string literal.
691 :    
692 :     =back
693 :    
694 :     =cut
695 :    
696 :     sub Quotify {
697 :     # Get the parameters.
698 :     my ($string) = @_;
699 :     # Declare the return variable.
700 :     my $retVal = $string;
701 :     # Quote the internal quotes.
702 :     $retVal =~ s/'/\\'/g;
703 :     # Literalize the new-lines.
704 :     $retVal =~ s/\n/\\n/g;
705 :     # Return the result.
706 :     return "'$retVal'";
707 :     }
708 :    
709 :     =head3 Error
710 :    
711 :     $eq->Error($message);
712 :    
713 :     Record an error message. Error messages are kept in a list attached to
714 :     this object.
715 :    
716 :     =over 4
717 :    
718 :     =item message
719 :    
720 :     Message to add to the error list.
721 :    
722 :     =back
723 :    
724 :     =cut
725 :    
726 :     sub Error {
727 :     # Get the parameters.
728 :     my ($self, $message) = @_;
729 :     # Add the error message to our statistics object.
730 :     $self->{stats}->AddMessage($message);
731 :     # Record the error as a statistic.
732 :     $self->AddStat(errors => 1);
733 :     }
734 :    
735 :     =head3 AddStat
736 :    
737 :     $eq->AddStat($statName => $value);
738 :    
739 :     Add the specified value to the named statistic.
740 :    
741 :     =over 4
742 :    
743 :     =item statName
744 :    
745 :     Name of the relevant statistic.
746 :    
747 :     =item value
748 :    
749 :     Value to add to the named statistic counter.
750 :    
751 :     =back
752 :    
753 :     =cut
754 :    
755 :     sub AddStat {
756 :     # Get the parameters.
757 :     my ($self, $statName, $value) = @_;
758 :     $self->{stats}->Add($statName => $value);
759 :     }
760 :    
761 :     =head3 Clear
762 :    
763 :     $eq->Clear();
764 :    
765 :     Initialize this object for a new query.
766 :    
767 :     =cut
768 :    
769 :     sub Clear {
770 :     # Get the parameters.
771 :     my ($self) = @_;
772 :     # Empty the field list.
773 :     $self->{fields} = [];
774 :     # Erase the statistics.
775 :     $self->{stats} = Stats->new(qw(records fields errors));
776 :     # Denote we have no query attached.
777 :     $self->{query} = undef;
778 :     }
779 :    
780 :    
781 : parrello 1.3
782 :    
783 : parrello 1.1 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3