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

Annotation of /Sprout/ERDBQueryConsole.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (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 :     [[ErdbPm]] database object for the current database.
50 :    
51 :     =item query
52 :    
53 :     [[ERDBQueryPm]] object for obtaining the query results.
54 :    
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 :     Database against which to run the query. This can be either an [[ErdbPm]]
99 :     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 :     # Now we have the data for this row, and it's time to
365 :     # stuff it into the return list. Loop through the fields.
366 :     for my $field (@{$self->{fields}}) {
367 :     # Get the values for this field.
368 :     my @values = $record->Value($field->{name});
369 :     $self->AddStat(values => scalar(@values));
370 : parrello 1.5 # 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};
374 :     # Convert the values to HTML and string them together.
375 :     my $cell = join("<br /><hr /><br />",
376 :     map { $type->html($_) } @values);
377 :     # Put the result into the output list.
378 :     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 : parrello 1.1 }
389 :     }
390 :     }
391 :     # Return the result.
392 :     return @retVal;
393 :     }
394 :    
395 :     =head3 GetCode
396 :    
397 :     my $codeString = $eq->GetCode($dbVarName, $codeStyle, @parameters);
398 :    
399 :     Return the PERL code to perform the query submitted to this console.
400 :    
401 :     =over 4
402 :    
403 :     =item dbVarName
404 :    
405 :     Name to give to the variable containing the database object.
406 :    
407 :     =item codeStyle
408 :    
409 :     Coding style to use: C<Get> for a get loop, C<GetAll> for a single get-all
410 :     statement.
411 :    
412 :     =item parameters
413 :    
414 :     List of parameter names. If a parameter name is a string, then the
415 :     corresponding parameter will be encoded as a variable with the name
416 :     given by the string. If a parameter name is an undefined value, the
417 :     parameter value will be encoded as a constant.
418 :    
419 :     =item RETURN
420 :    
421 :     Returns a string containing the PERL code to duplicate the incoming
422 :     query.
423 :    
424 :     =back
425 :    
426 :     =cut
427 :    
428 :     sub GetCode {
429 :     # Get the parameters.
430 :     my ($self, $dbVarName, $codeStyle, @parameters) = @_;
431 :     # We'll create lines of PERL code in here.
432 :     my @codeLines;
433 :     # We'll use this constant for tabbing purposes.
434 :     my $tab = " " x 4;
435 :     # Compute the name of the database object.
436 :     my $dbObjectName = '$' . $dbVarName;
437 :     # We start with some USE statements.
438 :     push @codeLines, "use ERDB;",
439 :     "use Tracer;";
440 :     # Get the field list. We'll be using it a lot.
441 :     my $fields = $self->{fields};
442 :     # Add "use" statements for all the field types. We build a hash
443 :     # to prevent duplicates.
444 :     my %uses;
445 :     for my $field (@$fields) {
446 :     my $type = $field->{type}->objectType();
447 :     if ($type) {
448 :     $uses{$type} = 1;
449 :     }
450 :     }
451 :     push @codeLines, map { "use $_;" } sort keys %uses;
452 :     # Now create the database object.
453 :     my $dbType = ref $self->{erdb};
454 :     push @codeLines, "",
455 :     "my $dbObjectName = ERDB::GetDatabase('$dbType');",
456 :     "";
457 :     # Compute the parameter strings list.
458 :     my @parmStrings;
459 :     my $parms = $self->{parms};
460 :     my $parmsCount = scalar @$parms;
461 :     for (my $i = 0; $i < $parmsCount; $i++) {
462 :     if (defined $parameters[$i]) {
463 : parrello 1.3 push @parmStrings, $parameters[$i];
464 : parrello 1.1 } else {
465 :     push @parmStrings, Quotify($parms->[$i]);
466 :     }
467 :     }
468 :     # Clean up and quote the object name string.
469 :     my $quotedObjectNameString = qq("$self->{objects}");
470 :     $quotedObjectNameString =~ s/\s+/ /;
471 :     # Quote the filter string.
472 :     my $quotedFilterString = Quotify($self->{filterString});
473 :     # The result from the Get call depends on the type: a list for
474 :     # GetAll, a scalar for Get.
475 :     my $getResultName = ($codeStyle eq 'Get' ? '$qh' : '@resultRows');
476 : parrello 1.3 # 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 : parrello 1.1 # 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
482 :     # we're doing a Get or a GetAll.
483 : parrello 1.3 my $buffer = "my $getResultName = $dbObjectName->$getName(";
484 : parrello 1.1 my $continueTab = " " x length($buffer);
485 :     # 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.
487 :     $buffer .= "$quotedObjectNameString, ";
488 :     # Now we break the rest of the statement into pieces.
489 :     my @pieces = "$quotedFilterString, ";
490 :     if (! @parmStrings) {
491 :     push @pieces, "[]";
492 :     } else {
493 : parrello 1.5 # Here we have a list of parameters. The first begins with a left bracket.
494 : parrello 1.1 push @pieces, "[" . shift(@parmStrings);
495 : parrello 1.5 # 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 : parrello 1.1 $pieces[$#pieces] .= "]";
504 :     }
505 :     # If this is a GetAll, the field names go in here, too.
506 :     if ($codeStyle eq 'GetAll') {
507 :     # First, we need to put a comma at the end of the last parameter.
508 :     $pieces[$#pieces] .= ", ";
509 : parrello 1.3 # Is this GetFlat?
510 :     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;
518 :     $quotedFields[0] = "[qw(" . $quotedFields[0];
519 :     $quotedFields[$#quotedFields] .= ")]";
520 :     for (my $i = 0; $i < $#quotedFields; $i++) {
521 :     $quotedFields[$i] .= " ";
522 :     }
523 :     push @pieces, @quotedFields;
524 : parrello 1.1 }
525 :     }
526 :     # Put the statement terminator on the last piece.
527 :     $pieces[$#pieces] .= ");";
528 :     # Loop through the pieces, building the code lines.
529 :     for my $piece (@pieces) {
530 :     if (length($buffer) + length($piece) > 80) {
531 :     push @codeLines, $buffer;
532 :     $buffer = $continueTab;
533 :     }
534 :     $buffer .= $piece;
535 :     }
536 :     # Finish the Get statement. The buffer is never empty after the above
537 :     # loop.
538 :     push @codeLines, $buffer;
539 :     # The rest of this is only necessary for the Get-style.
540 :     if ($codeStyle eq 'Get') {
541 :     # Build the fetch loop.
542 :     push @codeLines, "while (my \$resultRow = \$qh->Fetch()) {";
543 :     # Extract each field value.
544 :     for my $field (@$fields) {
545 :     # Get the field name.
546 :     my $fieldName = $field->{name};
547 :     # Convert the field name to a camel-cased variable name.
548 :     my @pieces = split /[^a-z]+/, lc $fieldName;
549 :     my $varName = shift @pieces;
550 :     $varName .= join("", map { ucfirst $_ } @pieces);
551 :     # We'll put the retrieval statement in here.
552 :     my $statement;
553 :     # Is this a primary field or a secondary field?
554 :     if ($field->{secondary}) {
555 :     # It's a secondary field, so we get a list of values.
556 :     $statement = "my \@$varName = \$resultRow->Value('$fieldName');";
557 :     } else {
558 :     # It's primary, so we get a single value.
559 :     $statement = "my \$$varName = \$resultRow->PrimaryValue('$fieldName');";
560 :     }
561 :     # If this field is complex, add a comment about the field type.
562 :     my $type = $field->{type}->objectType();
563 :     if (defined $type) {
564 :     $statement .= " # $type object";
565 :     }
566 :     # Output the statement.
567 :     push @codeLines, "$tab$statement";
568 :     }
569 : parrello 1.3 # Close the fetch loop. This next line looks strange, but it
570 :     # 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 : parrello 1.1 push @codeLines, "}";
575 :     }
576 :     # Return the result.
577 :     return join("\n", @codeLines, "");
578 :     }
579 :    
580 :     =head3 Summary
581 :    
582 :     my $statsHtml = $eq->Summary();
583 :    
584 :     Return an HTML display of the statistics and messages for this query.
585 :    
586 :     =cut
587 :    
588 :     sub Summary {
589 :     # Get the parameters.
590 :     my ($self) = @_;
591 :     # We'll accumulate HTML in here.
592 :     my $retVal = "";
593 :     # Get the statistics object.
594 :     my $stats = $self->{stats};
595 :     # Extract the messages.
596 :     my @messages = $stats->Messages();
597 :     # If there are messages, we need to display them.
598 :     if (scalar @messages) {
599 :     $retVal .= CGI::p("Errors and warnings for this query.") .
600 :     CGI::ul(map { CGI::li(CGI::escapeHTML($_)) } @messages);
601 :     }
602 :     # Now we display the statistics in alphabetical order, using a table.
603 :     my $statMap = $stats->Map();
604 :     my @keys = sort { Tracer::Cmp($a, $b) } keys %$statMap;
605 :     $retVal .= CGI::h3("Query Statistics");
606 :     $retVal .= CGI::table(
607 :     map { CGI::Tr(CGI::th($_), CGI::td({ align => 'right' },
608 :     $statMap->{$_})) } @keys);
609 :     # Return the result.
610 :     return $retVal;
611 :     }
612 :    
613 : parrello 1.5 =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 : parrello 1.3 =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 : parrello 1.1
667 :     =head2 Internal Methods
668 :    
669 :     =head3 Quotify
670 :    
671 :     my $quoted = ERDBQueryConsole::Quotify($string);
672 :    
673 :     Convert the input string to a PERL string constant. Internal single
674 :     quotes will be escaped, and the entire string will be surrounded by
675 :     single quotes.
676 :    
677 :     =over 4
678 :    
679 :     =item string
680 :    
681 :     String to be quoted.
682 :    
683 :     =item RETURN
684 :    
685 :     Returns the string in a format suitable for encoding as a PERL
686 :     string literal.
687 :    
688 :     =back
689 :    
690 :     =cut
691 :    
692 :     sub Quotify {
693 :     # Get the parameters.
694 :     my ($string) = @_;
695 :     # Declare the return variable.
696 :     my $retVal = $string;
697 :     # Quote the internal quotes.
698 :     $retVal =~ s/'/\\'/g;
699 :     # Literalize the new-lines.
700 :     $retVal =~ s/\n/\\n/g;
701 :     # Return the result.
702 :     return "'$retVal'";
703 :     }
704 :    
705 :     =head3 Error
706 :    
707 :     $eq->Error($message);
708 :    
709 :     Record an error message. Error messages are kept in a list attached to
710 :     this object.
711 :    
712 :     =over 4
713 :    
714 :     =item message
715 :    
716 :     Message to add to the error list.
717 :    
718 :     =back
719 :    
720 :     =cut
721 :    
722 :     sub Error {
723 :     # Get the parameters.
724 :     my ($self, $message) = @_;
725 :     # Add the error message to our statistics object.
726 :     $self->{stats}->AddMessage($message);
727 :     # Record the error as a statistic.
728 :     $self->AddStat(errors => 1);
729 :     }
730 :    
731 :     =head3 AddStat
732 :    
733 :     $eq->AddStat($statName => $value);
734 :    
735 :     Add the specified value to the named statistic.
736 :    
737 :     =over 4
738 :    
739 :     =item statName
740 :    
741 :     Name of the relevant statistic.
742 :    
743 :     =item value
744 :    
745 :     Value to add to the named statistic counter.
746 :    
747 :     =back
748 :    
749 :     =cut
750 :    
751 :     sub AddStat {
752 :     # Get the parameters.
753 :     my ($self, $statName, $value) = @_;
754 :     $self->{stats}->Add($statName => $value);
755 :     }
756 :    
757 :     =head3 Clear
758 :    
759 :     $eq->Clear();
760 :    
761 :     Initialize this object for a new query.
762 :    
763 :     =cut
764 :    
765 :     sub Clear {
766 :     # Get the parameters.
767 :     my ($self) = @_;
768 :     # Empty the field list.
769 :     $self->{fields} = [];
770 :     # Erase the statistics.
771 :     $self->{stats} = Stats->new(qw(records fields errors));
772 :     # Denote we have no query attached.
773 :     $self->{query} = undef;
774 :     }
775 :    
776 :    
777 : parrello 1.3
778 :    
779 : parrello 1.1 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3