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

Annotation of /Sprout/ERDBQueryConsole.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (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 :     =back
117 :    
118 :     =cut
119 :    
120 :     sub new {
121 :     # Get the parameters.
122 :     my ($class, $db, %options) = @_;
123 :     # Get the options.
124 :     my $secure = $options{secure} || 0;
125 :     # Get access to the database.
126 :     my $erdb;
127 :     if (! ref $db) {
128 :     $erdb = ERDB::GetDatabase($db);
129 :     } else {
130 :     $erdb = $db;
131 :     }
132 :     # Create the ERDBQueryConsole object.
133 :     my $retVal = {
134 :     erdb => $erdb,
135 :     secure => $secure,
136 :     };
137 :     # Bless and return it.
138 :     bless $retVal, $class;
139 :     return $retVal;
140 :     }
141 :    
142 :     =head2 Public Methods
143 :    
144 :     =head3 Submit
145 :    
146 : parrello 1.3 my $okFlag = $eq->Submit($objects, $filterString, \@parms, $fields, $limitNumber);
147 : parrello 1.1
148 :     Submit a query to the console. This method stores the relevant
149 :     information about the query and creates the query object. Other methods
150 :     can be used to get the results of the query or a list of error messages.
151 :    
152 :     =over 4
153 :    
154 :     =item objects
155 :    
156 :     Object name string containing the list of objects that particpate in the
157 :     query.
158 :    
159 :     =item filterString
160 :    
161 :     Filter string for the query, specifying the query conditions, sort order,
162 :     and limit.
163 :    
164 :     =item parms
165 :    
166 :     Reference to a list of parameter values. Each parameter value is plugged
167 :     into a parameter mark in the filter string.
168 :    
169 :     =item fields
170 :    
171 : parrello 1.3 String containing the result field names.
172 : parrello 1.1
173 :     =item limitNumber
174 :    
175 : parrello 1.3 Maximum number of rows for the query. If the user is not privileged,
176 :     all queries are limited to a maximum number of rows determined by
177 :     the C<$ERDBExtras::query_limit> parameter. If the user is privileged,
178 :     a false value (undefined of 0) indicates an unlimited query.
179 : parrello 1.1
180 :     =item RETURN
181 :    
182 :     Returns TRUE if the query was successful, FALSE if an error was
183 :     detected.
184 :    
185 :     =back
186 :    
187 :     =cut
188 :    
189 :     sub Submit {
190 :     # Get the parameters.
191 :     my ($self, $objects, $filterString, $parms, $fields, $limitNumber) = @_;
192 :     # Clear this object for a new query.
193 :     $self->Clear();
194 :     # Count the parameter marks in the filter string.
195 :     my $parmCount = ERDB::CountParameterMarks($filterString);
196 :     # Count the parameters.
197 :     my $suppliedParms = scalar(@$parms);
198 :     Trace("$suppliedParms parameters found.") if T(3);
199 :     # Verify the various parameters.
200 :     if (! $objects) {
201 :     $self->Error("No object list specified. Query aborted.");
202 :     } elsif (! $fields) {
203 :     $self->Error("No output fields specified. Query aborted.");
204 :     } elsif ($parmCount > $suppliedParms) {
205 :     $self->Error("You have $parmCount parameter marks but only $suppliedParms " .
206 :     "Parameters. Insure each parameter is on a separate line in " .
207 :     "the parameters box and that you don't have any extra question " .
208 :     "marks (?) in the Filter String.");
209 :     } elsif ($parmCount < $suppliedParms) {
210 :     $self->Error("You have $suppliedParms Parameters but there are only " .
211 :     "$parmCount parameter marks in the Filter String.")
212 :     } else {
213 :     # Now we can do the query. First, get the database object.
214 :     my $db = $self->{erdb};
215 :     # Parse the object name list.
216 :     my @nameErrors = $db->CheckObjectNames($objects);
217 :     if (@nameErrors) {
218 :     # Here there were errors in the object name string.
219 :     for my $nameError (@nameErrors) {
220 :     $self->Error($nameError);
221 :     }
222 :     $self->Error("Errors were found in the Object Names.");
223 :     } else {
224 :     # Check to see if we need to limit this query.
225 :     my $limitClause = "";
226 :     if (! $self->{secure}) {
227 :     # We do. Check for an existing limit.
228 : parrello 1.3 if ($filterString =~ /(.*)LIMIT\s+(\d+)(.*)/) {
229 : parrello 1.1 # Fix it if it's too big.
230 : parrello 1.3 if ($2 >= $ERDBExtras::query_limit) {
231 :     $filterString = "$1LIMIT $ERDBExtras::query_limit$3";
232 : parrello 1.1 }
233 :     } else {
234 :     # No limit present, so add one.
235 : parrello 1.3 $limitClause = " LIMIT $ERDBExtras::query_limit";
236 : parrello 1.1 }
237 :     } else {
238 :     # Privileged users can request a different limit. Only use it
239 :     # if there is not already a limit in the filter clause.
240 : parrello 1.3 if ($limitNumber && $filterString !~ /(?:^|\s)LIMIT\s/) {
241 : parrello 1.1 $limitClause = " LIMIT $limitNumber";
242 :     Trace("Limit clause for $limitNumber rows added to query.") if T(2);
243 :     }
244 :     }
245 :     # Now we need to find things out about the fields. For each one,
246 :     # we need a column name and a cell format. To get that, we
247 :     # start the query and analyze the fields.
248 :     Trace("Preparing query.") if T(3);
249 :     my $query = eval('$db->Prepare($objects, "$filterString$limitClause", $parms)');
250 :     if ($@) {
251 :     # Here the query preparation failed for some reason. This is usually an
252 :     # SQL syntax error.
253 :     $self->Error("QUERY ERROR: $@");
254 :     } else {
255 :     Trace("Parsing field list.") if T(3);
256 :     # We need to get the necessary data for each field in the field list.
257 :     # This will be set to TRUE if a valid field is found.
258 :     my $found;
259 :     # Now loop through the field names.
260 :     for my $field (@$fields) {
261 :     Trace("Processing field name \"$field\".") if T(3);
262 :     # Get the data for this field.
263 :     my ($objectName, $fieldName, $type) = $query->CheckFieldName($field);
264 :     if (! defined $objectName) {
265 :     # Here the field specification had an invalid format.
266 :     $self->Error("Field specifier \"$field\" has an invalid format.");
267 :     } elsif (! defined $fieldName) {
268 :     # Here the object name was invalid. That generates a warning.
269 :     $self->Error("Object name \"$objectName\" not found in query.");
270 :     } elsif (! defined $type) {
271 :     # Here the field name was invalid. That is also a warning.
272 :     $self->Error("Field \"$fieldName\" not found in $objectName.");
273 :     } else {
274 :     # Here the field name is okay. Save its data.
275 :     push @{$self->{fields}},
276 :     { name => $field, type => $type,
277 :     secondary => $db->IsSecondary($fieldName, $objectName)
278 :     };
279 :     # Count the field.
280 :     $self->AddStat(fields => 1);
281 :     $found = 1;
282 :     }
283 :     }
284 :     # Insure we have at least one valid field.
285 :     if (! $found) {
286 :     $self->Error("No valid field names were specified for this query.");
287 :     } else {
288 :     # We do, so save the query and its parameters.
289 :     $self->{query} = $query;
290 :     $self->{parms} = $parms;
291 :     $self->{objects} = $objects;
292 :     $self->{filterString} = $filterString;
293 :     }
294 :     }
295 :     }
296 :     }
297 :     # Return TRUE if no errors were detected.
298 :     return defined $self->{query};
299 :     }
300 :    
301 :     =head3 Headers
302 :    
303 :     my @columnData = $eq->Headers();
304 :    
305 :     Return the header information for each column of the output. The header
306 :     information is returned as a list of 2-tuples. For each column, the
307 :     2-tuple includes the column caption and the alignment (C<left>, C<right>,
308 :     or C<center>).
309 :    
310 :     =cut
311 :    
312 :     sub Headers {
313 :     # Get the parameters.
314 :     my ($self) = @_;
315 :     # Declare the return variable.
316 :     my @retVal;
317 :     # Insure we have fields. If we don't, the query will be treated as
318 :     # having 0 output columns: we'll return an empty list.
319 :     if (defined $self->{fields}) {
320 :     # We have something, so loop through the fields.
321 :     for my $field (@{$self->{fields}}) {
322 :     # Compute the alignment.
323 :     my $align = $field->{type}->align();
324 :     # Push it into the result list along with the field name.
325 :     push @retVal, [$field->{name}, $align];
326 :     }
327 :     }
328 :     # Return the result.
329 :     return @retVal;
330 :     }
331 :    
332 :     =head3 GetRow
333 :    
334 :     my @items = $eq->GetRow();
335 :    
336 :     Get the next row of data from the query. Each row will consist of a list
337 :     of HTML strings, one per result column, in the same order the field names
338 :     appeared when the query was submitted.
339 :    
340 :     If the query is complete, an empty list will be returned.
341 :    
342 :     =cut
343 :    
344 :     sub GetRow {
345 :     # Get the parameters.
346 :     my ($self) = @_;
347 :     # Declare the return variable.
348 :     my @retVal;
349 :     # Only proceed if we have an active query.
350 :     if (defined $self->{query}) {
351 :     # We do, so try to get the next record. Note we accumulate the
352 :     # time spent and protect from errors.
353 :     my $start = time();
354 :     my $record = $self->{query}->Fetch();
355 :     $self->AddStat(duration => time() - $start);
356 :     # Only proceed if a record was found.
357 :     if (defined $record) {
358 :     # Now we have the data for this row, and it's time to
359 :     # stuff it into the return list. Loop through the fields.
360 :     for my $field (@{$self->{fields}}) {
361 :     # Get the values for this field.
362 :     my @values = $record->Value($field->{name});
363 :     $self->AddStat(values => scalar(@values));
364 :     # Get the field type.
365 :     my $type = $field->{type};
366 :     # Convert the values to HTML and string them together.
367 :     my $cell = join("<br />", map { $type->html($_) } @values);
368 :     # Put the result into the output list.
369 :     push @retVal, $cell;
370 :     }
371 :     }
372 :     }
373 :     # Return the result.
374 :     return @retVal;
375 :     }
376 :    
377 :     =head3 GetCode
378 :    
379 :     my $codeString = $eq->GetCode($dbVarName, $codeStyle, @parameters);
380 :    
381 :     Return the PERL code to perform the query submitted to this console.
382 :    
383 :     =over 4
384 :    
385 :     =item dbVarName
386 :    
387 :     Name to give to the variable containing the database object.
388 :    
389 :     =item codeStyle
390 :    
391 :     Coding style to use: C<Get> for a get loop, C<GetAll> for a single get-all
392 :     statement.
393 :    
394 :     =item parameters
395 :    
396 :     List of parameter names. If a parameter name is a string, then the
397 :     corresponding parameter will be encoded as a variable with the name
398 :     given by the string. If a parameter name is an undefined value, the
399 :     parameter value will be encoded as a constant.
400 :    
401 :     =item RETURN
402 :    
403 :     Returns a string containing the PERL code to duplicate the incoming
404 :     query.
405 :    
406 :     =back
407 :    
408 :     =cut
409 :    
410 :     sub GetCode {
411 :     # Get the parameters.
412 :     my ($self, $dbVarName, $codeStyle, @parameters) = @_;
413 :     # We'll create lines of PERL code in here.
414 :     my @codeLines;
415 :     # We'll use this constant for tabbing purposes.
416 :     my $tab = " " x 4;
417 :     # Compute the name of the database object.
418 :     my $dbObjectName = '$' . $dbVarName;
419 :     # We start with some USE statements.
420 :     push @codeLines, "use ERDB;",
421 :     "use Tracer;";
422 :     # Get the field list. We'll be using it a lot.
423 :     my $fields = $self->{fields};
424 :     # Add "use" statements for all the field types. We build a hash
425 :     # to prevent duplicates.
426 :     my %uses;
427 :     for my $field (@$fields) {
428 :     my $type = $field->{type}->objectType();
429 :     if ($type) {
430 :     $uses{$type} = 1;
431 :     }
432 :     }
433 :     push @codeLines, map { "use $_;" } sort keys %uses;
434 :     # Now create the database object.
435 :     my $dbType = ref $self->{erdb};
436 :     push @codeLines, "",
437 :     "my $dbObjectName = ERDB::GetDatabase('$dbType');",
438 :     "";
439 :     # Compute the parameter strings list.
440 :     my @parmStrings;
441 :     my $parms = $self->{parms};
442 :     my $parmsCount = scalar @$parms;
443 :     for (my $i = 0; $i < $parmsCount; $i++) {
444 :     if (defined $parameters[$i]) {
445 : parrello 1.3 push @parmStrings, $parameters[$i];
446 : parrello 1.1 } else {
447 :     push @parmStrings, Quotify($parms->[$i]);
448 :     }
449 :     }
450 :     # Clean up and quote the object name string.
451 :     my $quotedObjectNameString = qq("$self->{objects}");
452 :     $quotedObjectNameString =~ s/\s+/ /;
453 :     # Quote the filter string.
454 :     my $quotedFilterString = Quotify($self->{filterString});
455 :     # The result from the Get call depends on the type: a list for
456 :     # GetAll, a scalar for Get.
457 :     my $getResultName = ($codeStyle eq 'Get' ? '$qh' : '@resultRows');
458 : parrello 1.3 # Not we compute the function name. It's the same as the code style
459 :     # unless we're doing a GetAll and there's only one field. In that case
460 :     # we do a GetFlat.
461 :     my $getName = ($codeStyle eq 'GetAll' && scalar(@$fields) == 1 ? 'GetFlat' : $codeStyle);
462 : parrello 1.1 # Build the Get. It's multiple lines, so we need to compute how far to
463 :     # indent the secondary lines. In addition, we need to decide here whether
464 :     # we're doing a Get or a GetAll.
465 : parrello 1.3 my $buffer = "my $getResultName = $dbObjectName->$getName(";
466 : parrello 1.1 my $continueTab = " " x length($buffer);
467 :     # Now set up the buffer so that it has the Get call and the object
468 :     # name string. This is the minimum content for the first line.
469 :     $buffer .= "$quotedObjectNameString, ";
470 :     # Now we break the rest of the statement into pieces.
471 :     my @pieces = "$quotedFilterString, ";
472 :     if (! @parmStrings) {
473 :     push @pieces, "[]";
474 :     } else {
475 :     push @pieces, "[" . shift(@parmStrings);
476 :     push @pieces, @parmStrings;
477 :     $pieces[$#pieces] .= "]";
478 :     }
479 :     # If this is a GetAll, the field names go in here, too.
480 :     if ($codeStyle eq 'GetAll') {
481 :     # First, we need to put a comma at the end of the last parameter.
482 :     $pieces[$#pieces] .= ", ";
483 : parrello 1.3 # Is this GetFlat?
484 :     if ($getName eq 'GetFlat') {
485 :     # Yes, so we have a single field.
486 :     my $fieldName = $fields->[0]{name};
487 :     push @pieces, "'$fieldName'";
488 :     } else {
489 :     # No, so we create a list of the field names. We use the qw
490 :     # trick to do this.
491 :     my @quotedFields = map { $_->{name} } @$fields;
492 :     $quotedFields[0] = "[qw(" . $quotedFields[0];
493 :     $quotedFields[$#quotedFields] .= ")]";
494 :     for (my $i = 0; $i < $#quotedFields; $i++) {
495 :     $quotedFields[$i] .= " ";
496 :     }
497 :     push @pieces, @quotedFields;
498 : parrello 1.1 }
499 :     }
500 :     # Put the statement terminator on the last piece.
501 :     $pieces[$#pieces] .= ");";
502 :     # Loop through the pieces, building the code lines.
503 :     for my $piece (@pieces) {
504 :     if (length($buffer) + length($piece) > 80) {
505 :     push @codeLines, $buffer;
506 :     $buffer = $continueTab;
507 :     }
508 :     $buffer .= $piece;
509 :     }
510 :     # Finish the Get statement. The buffer is never empty after the above
511 :     # loop.
512 :     push @codeLines, $buffer;
513 :     # The rest of this is only necessary for the Get-style.
514 :     if ($codeStyle eq 'Get') {
515 :     # Build the fetch loop.
516 :     push @codeLines, "while (my \$resultRow = \$qh->Fetch()) {";
517 :     # Extract each field value.
518 :     for my $field (@$fields) {
519 :     # Get the field name.
520 :     my $fieldName = $field->{name};
521 :     # Convert the field name to a camel-cased variable name.
522 :     my @pieces = split /[^a-z]+/, lc $fieldName;
523 :     my $varName = shift @pieces;
524 :     $varName .= join("", map { ucfirst $_ } @pieces);
525 :     # We'll put the retrieval statement in here.
526 :     my $statement;
527 :     # Is this a primary field or a secondary field?
528 :     if ($field->{secondary}) {
529 :     # It's a secondary field, so we get a list of values.
530 :     $statement = "my \@$varName = \$resultRow->Value('$fieldName');";
531 :     } else {
532 :     # It's primary, so we get a single value.
533 :     $statement = "my \$$varName = \$resultRow->PrimaryValue('$fieldName');";
534 :     }
535 :     # If this field is complex, add a comment about the field type.
536 :     my $type = $field->{type}->objectType();
537 :     if (defined $type) {
538 :     $statement .= " # $type object";
539 :     }
540 :     # Output the statement.
541 :     push @codeLines, "$tab$statement";
542 :     }
543 : parrello 1.3 # Close the fetch loop. This next line looks strange, but it
544 :     # is necessary to keep the Komodo TODO-hunter from flagging this
545 :     # line as an uncompleted task.
546 :     my $sharps = "##" . "TODO";
547 :     push @codeLines, "$tab##" . "TODO: Process data";
548 : parrello 1.1 push @codeLines, "}";
549 :     }
550 :     # Return the result.
551 :     return join("\n", @codeLines, "");
552 :     }
553 :    
554 :     =head3 Summary
555 :    
556 :     my $statsHtml = $eq->Summary();
557 :    
558 :     Return an HTML display of the statistics and messages for this query.
559 :    
560 :     =cut
561 :    
562 :     sub Summary {
563 :     # Get the parameters.
564 :     my ($self) = @_;
565 :     # We'll accumulate HTML in here.
566 :     my $retVal = "";
567 :     # Get the statistics object.
568 :     my $stats = $self->{stats};
569 :     # Extract the messages.
570 :     my @messages = $stats->Messages();
571 :     # If there are messages, we need to display them.
572 :     if (scalar @messages) {
573 :     $retVal .= CGI::p("Errors and warnings for this query.") .
574 :     CGI::ul(map { CGI::li(CGI::escapeHTML($_)) } @messages);
575 :     }
576 :     # Now we display the statistics in alphabetical order, using a table.
577 :     my $statMap = $stats->Map();
578 :     my @keys = sort { Tracer::Cmp($a, $b) } keys %$statMap;
579 :     $retVal .= CGI::h3("Query Statistics");
580 :     $retVal .= CGI::table(
581 :     map { CGI::Tr(CGI::th($_), CGI::td({ align => 'right' },
582 :     $statMap->{$_})) } @keys);
583 :     # Return the result.
584 :     return $retVal;
585 :     }
586 :    
587 : parrello 1.3 =head3 SplitFields
588 :    
589 :     my @fields = ERDBQueryConsole::SplitFields($fieldString);
590 :    
591 :     Convert a field string to a list of field names. The string can be either
592 :     comma-delimited or space-delimited.
593 :    
594 :     =over 4
595 :    
596 :     =item fieldString
597 :    
598 :     String of field names.
599 :    
600 :     =item RETURN
601 :    
602 :     Returns a list of the field names culled from the string.
603 :    
604 :     =back
605 :    
606 :     =cut
607 :    
608 :     sub SplitFields {
609 :     # Get the parameters.
610 :     my ($fieldString) = @_;
611 :     # Declare the return variable.
612 :     my @retVal;
613 :     if ($fieldString =~ /,/) {
614 :     # We found a comma, so use the comma pattern.
615 :     push @retVal, split /\s*,\s*/, $fieldString;
616 :     } else {
617 :     # No commas, so use the space pattern.
618 :     push @retVal, split /\s+/, $fieldString;
619 :     }
620 :     # Return the result.
621 :     return @retVal;
622 :     }
623 : parrello 1.1
624 :     =head2 Internal Methods
625 :    
626 :     =head3 Quotify
627 :    
628 :     my $quoted = ERDBQueryConsole::Quotify($string);
629 :    
630 :     Convert the input string to a PERL string constant. Internal single
631 :     quotes will be escaped, and the entire string will be surrounded by
632 :     single quotes.
633 :    
634 :     =over 4
635 :    
636 :     =item string
637 :    
638 :     String to be quoted.
639 :    
640 :     =item RETURN
641 :    
642 :     Returns the string in a format suitable for encoding as a PERL
643 :     string literal.
644 :    
645 :     =back
646 :    
647 :     =cut
648 :    
649 :     sub Quotify {
650 :     # Get the parameters.
651 :     my ($string) = @_;
652 :     # Declare the return variable.
653 :     my $retVal = $string;
654 :     # Quote the internal quotes.
655 :     $retVal =~ s/'/\\'/g;
656 :     # Literalize the new-lines.
657 :     $retVal =~ s/\n/\\n/g;
658 :     # Return the result.
659 :     return "'$retVal'";
660 :     }
661 :    
662 :     =head3 Error
663 :    
664 :     $eq->Error($message);
665 :    
666 :     Record an error message. Error messages are kept in a list attached to
667 :     this object.
668 :    
669 :     =over 4
670 :    
671 :     =item message
672 :    
673 :     Message to add to the error list.
674 :    
675 :     =back
676 :    
677 :     =cut
678 :    
679 :     sub Error {
680 :     # Get the parameters.
681 :     my ($self, $message) = @_;
682 :     # Add the error message to our statistics object.
683 :     $self->{stats}->AddMessage($message);
684 :     # Record the error as a statistic.
685 :     $self->AddStat(errors => 1);
686 :     }
687 :    
688 :     =head3 AddStat
689 :    
690 :     $eq->AddStat($statName => $value);
691 :    
692 :     Add the specified value to the named statistic.
693 :    
694 :     =over 4
695 :    
696 :     =item statName
697 :    
698 :     Name of the relevant statistic.
699 :    
700 :     =item value
701 :    
702 :     Value to add to the named statistic counter.
703 :    
704 :     =back
705 :    
706 :     =cut
707 :    
708 :     sub AddStat {
709 :     # Get the parameters.
710 :     my ($self, $statName, $value) = @_;
711 :     $self->{stats}->Add($statName => $value);
712 :     }
713 :    
714 :     =head3 Clear
715 :    
716 :     $eq->Clear();
717 :    
718 :     Initialize this object for a new query.
719 :    
720 :     =cut
721 :    
722 :     sub Clear {
723 :     # Get the parameters.
724 :     my ($self) = @_;
725 :     # Empty the field list.
726 :     $self->{fields} = [];
727 :     # Erase the statistics.
728 :     $self->{stats} = Stats->new(qw(records fields errors));
729 :     # Denote we have no query attached.
730 :     $self->{query} = undef;
731 :     }
732 :    
733 :    
734 : parrello 1.3
735 :    
736 : parrello 1.1 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3