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

Annotation of /Sprout/ERDBPDocPage.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (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 ERDBPDocPage;
21 :    
22 :     use strict;
23 :     use Tracer;
24 :     use ERDB;
25 :     use CGI;
26 :     use FIGRules;
27 :    
28 :     =head1 ERDB Pseudo-Documentation Page
29 :    
30 :     =head2 Introduction
31 :    
32 :     This module is used to generate a small pseudo-documentation page for ERDB. The
33 :     page includes a dropdown box that allows you to select an object in the database
34 :     and see a summary of its fields and relationships.
35 :    
36 :     Each object in the database will have its documentation wrapped in a DIV block
37 :     computable from the object name. All the links will call a javascript method to
38 :     reveal the appropriate block. A stack of the viewed blocks is kept in the
39 :     javascript data structures so the user can go back. Each object in the database
40 :     has a name that is unique among all the object types, so the name is sufficient
41 :     to identify the DIV block.
42 :    
43 :     The fields in this object are as follows.
44 :    
45 :     =over 4
46 :    
47 :     =item erdb
48 :    
49 :     [[ErdbPm]] object describing the database.
50 :    
51 :     =item idString
52 :    
53 :     A unique ID string used to prefix the names of all the DIV blocks
54 :     generated by this object.
55 :    
56 :     =item javaThing
57 :    
58 :     The name of the JavaScript variable that will contain the current state
59 :     of the documentation HTML.
60 :    
61 :     =item selectBox
62 :    
63 :     The ID of the select box that controls this widget.
64 :    
65 :     =back
66 :    
67 :     =head3 Useful Constants
68 :    
69 :     =over 4
70 :    
71 :     =item ARITY_FROM
72 :    
73 :     Maps each arity to its description when seen in the forward direction.
74 :    
75 :     =item ARITY_TO
76 :    
77 :     Maps each arity to its description when seen in the reverse direction.
78 :    
79 :     =back
80 :    
81 :     =cut
82 :    
83 :     use constant ARITY_FROM => { '1M' => 'one-to-many', 'MM' => 'many-to-many' };
84 :     use constant ARITY_TO => { '1M' => 'many-to-one', 'MM' => 'many-to-many' };
85 :    
86 :     =head3 new
87 :    
88 :     my $html = ERDBPDocPage->new(%options);
89 :    
90 :     Construct a new ERDBPDocPage object. The following options are supported.
91 :    
92 :     =over 4
93 :    
94 :     =item name
95 :    
96 :     Name of the relevant ERDB database.
97 :    
98 :     =item dbObject
99 :    
100 :     [[ErdbPm]] object for the databasse. If this option is specified, it
101 :     overrides =name=.
102 :    
103 :     =item idString
104 :    
105 :     A unique ID string used to prefix the names of all the DIV blocks
106 :     generated by this object. If none is provided, an empty string is
107 :     used. If provided, the string must consist entirely of letters, digits,
108 :     and underscores, because it's used in javascript variable names.
109 :    
110 :     =back
111 :    
112 :     =cut
113 :    
114 :     sub new {
115 :     # Get the parameters.
116 :     my ($class, %options) = @_;
117 :     # We'll store the ERDB object we want in here.
118 :     my $erdb;
119 :     # Get the options.
120 :     my $name = $options{name};
121 :     my $dbObject = $options{dbObject};
122 :     my $idString = $options{idString} || '';
123 :     # Attach the desired ERDB object.
124 :     if ($dbObject) {
125 :     # Here we have a connected object.
126 :     $erdb = $dbObject;
127 :     } elsif ($name) {
128 :     # Here we need to create the database object from the name.
129 :     $erdb = ERDB::GetDatabase($name);
130 :     }
131 :     # Create the ERDBPDocPage object.
132 :     my $retVal = {
133 :     erdb => $erdb,
134 :     idString => $idString,
135 :     javaThing => "status_erdb_$idString",
136 :     selectBox => "select_box_$idString",
137 :     };
138 :     # Bless and return it.
139 :     bless $retVal, $class;
140 :     return $retVal;
141 :     }
142 :    
143 :     =head2 Public Methods
144 :    
145 :     =head3 DocPage
146 :    
147 :     my $docPage = $html->DocPage(%options);
148 :    
149 :     Create a documentation widget for the current ERDB database. The documentation
150 :     widget features a multi-level menu on the left. When the user selects an object,
151 :     that object's documentation block is made visible on the right. The page containing
152 :     the document needs to have [[ErdbJs]] included for scripting and [[ErdbCss]]
153 :     for styles. The parameter is a hash of options. The permissible options are given
154 :     below.
155 :    
156 :     =over 4
157 :    
158 :     =item menuSize
159 :    
160 :     The number of rows to show in the popup menu. The default is 35.
161 :    
162 :     =item boxHeight
163 :    
164 :     The height for the display area, in pixels. The default is 450.
165 :    
166 :     =item padding
167 :    
168 :     The padding to use around the display elements, in pixels. The default is 5.
169 :    
170 :     =item buttonWidth
171 :    
172 :     The width of the navigation buttons, in pixels. The default is 50.
173 :    
174 :     =item selectWidth
175 :    
176 :     The width of the selection area, in pixels. The default is 200.
177 :    
178 :     =item
179 :    
180 :     =back
181 :    
182 :     =cut
183 :    
184 :     sub DocPage {
185 :     # Get the parameters.
186 :     my ($self, %options) = @_;
187 :     # Extract the options.
188 :     my $menuSize = $options{menuSize} || 35;
189 :     my $boxHeight = $options{boxHeight} || 450;
190 :     my $padding = $options{padding} || 5;
191 :     my $buttonWidth = $options{buttonWidth} || 50;
192 :     my $selectWidth = $options{selectWidth} || 200;
193 :     # Compute the width for the popup menu thing.
194 :     my $menuWidth = $selectWidth - 2 * $padding;
195 :     # Convert all the numbers to measurements.
196 :     for my $measurement (qw(menuSize boxHeight padding buttonWidth selectWidth
197 :     menuWIdth)) {
198 :     eval("\$$measurement .= 'px'");
199 :     }
200 :     # Get the ERDB object.
201 :     my $erdb = $self->{erdb};
202 :     # We'll format our HTML in here.
203 :     my @lines;
204 :     # First and foremost, we need a list of the object types in documentation
205 :     # order.
206 :     my @types = qw(entity relationship shape);
207 :     # We need a list of the DIV block names, a list of the DIV blocks themselves,
208 :     # and a list of object names for each object type.
209 :     my (@divBlocks, @divNames);
210 :     my %optGroups = map { $_ => [] } @types;
211 :     # Loop through the three object types.
212 :     for my $type (@types) {
213 :     # Get the option group list for this type.
214 :     my $optGroup = $optGroups{$type};
215 :     # Get the table of objects of this type.
216 :     my $groupObjectsTable = $erdb->GetObjectsTable($type);
217 :     # Loop through them in lexical order.
218 :     for my $name (sort keys %$groupObjectsTable) {
219 :     # Put this object in the current option group.
220 :     push @$optGroup, $name;
221 :     # Put its DIV identifier in the name list.
222 :     my $divID = $self->_DivID($name);
223 :     push @divNames, $divID;
224 :     # Generate its block.
225 :     my $divBlockHtml = $self->DocObject($type => $name,
226 :     $groupObjectsTable->{$name});
227 :     my $divBlock = CGI::div({ id => $divID, style => 'display: none' },
228 :     $divBlockHtml);
229 :     # Save the block with the DIV ID.
230 :     push @divBlocks, $divBlock;
231 :     }
232 :     }
233 :     # Now we create the script to set this all up.
234 :     my $initCall = "new ErdbStatusThing(\"$self->{selectBox}\", \"" .
235 :     join(" ", @divNames) . "\")";
236 :     push @lines, "<script type=\"text/javascript\">",
237 :     " var $self->{javaThing} = $initCall;",
238 :     "</script>";
239 :     # Now we create the menu box. First, we need a list of the nonempty
240 :     # option groups.
241 :     my @optGroupList;
242 :     for my $type (@types) {
243 :     my $thisGroup = $optGroups{$type};
244 :     if (scalar @$thisGroup) {
245 :     push @optGroupList, CGI::optgroup(-name => ERDB::Plurals($type),
246 :     -values => $thisGroup);
247 :     }
248 :     }
249 :     # This is the event string we want when the menu box value changes.
250 :     my $event = "ShowBlockReset($self->{javaThing}, '$self->{idString}' + this.value)";
251 :     my $menuBox = CGI::popup_menu(-id => $self->{selectBox},
252 :     -values => \@optGroupList,
253 :     -style => "width: $menuWidth",
254 :     -onChange => $event, -size => $menuSize);
255 :     # Next we have the DIV blocks themselves.
256 :     my $divBlocks = join("\n", @divBlocks);
257 :     # Now we have the buttons.
258 :     my $buttonStyle = "width: $buttonWidth; text-align: center;";
259 :     my @buttons = (CGI::button(-value => 'BACK', -style => $buttonStyle,
260 :     -onClick => "ShowPrevious($self->{javaThing})"),
261 :     CGI::button(-value => 'CLEAR', -style => $buttonStyle,
262 :     -onClick => "ShowBlockReset($self->{javaThing}, '')"),
263 :     );
264 :     # Create the style for the documentation display area.
265 :     my $divStyle = "height: $boxHeight; overflow: auto";
266 :     # Assemble the menu and the div blocks.
267 :     push @lines, CGI::table({ border => 0, valign => 'top', width => "100%" },
268 :     CGI::Tr(
269 :     CGI::td({ style => "padding: $padding; width: $selectWidth" },
270 :     join(" ", @buttons) . CGI::br() . $menuBox),
271 :     CGI::td({ style => "padding: $padding"},
272 :     CGI::div({ style => $divStyle }, $divBlocks)),
273 :     ));
274 :     # Return the result.
275 :     my $retVal = join("\n", @lines, "");
276 :     return $retVal;
277 :     }
278 :    
279 :    
280 :     =head3 DocObject
281 :    
282 :     my $html = $html->DocObject($type => $name, $metadata);
283 :    
284 :     Create a documentation block for the specified entity, relationship, or
285 :     shape. The documentation block will contain a title, but will not be
286 :     wrapped in a DIV block or anything fancy.
287 :    
288 :     =over 4
289 :    
290 :     =item type
291 :    
292 :     Type of object: C<entity>, C<relationship>, or C<shape>. The types are
293 :     case-insensitive, and plurals work.
294 :    
295 :     =item name
296 :    
297 :     Name of the entity, relationship, or shape.
298 :    
299 :     =item metadata
300 :    
301 :     [[ErdbPm]] metadata object describing the entity, relationship, or shape.
302 :    
303 :     =item RETURN
304 :    
305 :     Returns a documentation block for the specified object.
306 :    
307 :     =back
308 :    
309 :     =cut
310 :    
311 :     sub DocObject {
312 :     # Get the parameters.
313 :     my ($self, $type, $name, $metadata) = @_;
314 :     # Declare the return variable.
315 :     my $retVal;
316 :     # Process according to the type of thing.
317 :     if ($type =~ /^entit(y|ies)/i) {
318 :     $retVal = $self->DocEntity($name => $metadata);
319 :     } elsif ($type =~ /^relationship/i) {
320 :     $retVal = $self->DocRelationship($name => $metadata);
321 :     } elsif ($type =~ /^shape/i) {
322 :     $retVal = $self->DocShape($name => $metadata);
323 :     } else {
324 :     Confess("Invalid object type \"$type\" in documentation handler.");
325 :     }
326 :     # Return the result.
327 :     return $retVal;
328 :     }
329 :    
330 :     =head3 DocEntity
331 :    
332 :     my $htmlBlock = $html->DocEntity($name => $metadata);
333 :    
334 :     Return the documentation block for the specified entity.
335 :    
336 :     =over 4
337 :    
338 :     =item name
339 :    
340 :     Name of the entity whose documentation block is desired.
341 :    
342 :     =item metadata
343 :    
344 :     [[ErdbPm]] metatada structure for the specified entity.
345 :    
346 :     =item RETURN
347 :    
348 :     Returns a documentation block for the specified entity.
349 :    
350 :     =back
351 :    
352 :     =cut
353 :    
354 :     sub DocEntity {
355 :     # Get the parameters.
356 :     my ($self, $name, $metadata) = @_;
357 :     # Get the database object.
358 :     my $erdb = $self->{erdb};
359 :     # We'll build the documentation block in here.
360 :     my @lines;
361 :     # Start with the heading.
362 :     push @lines, $self->ObjectHeading(entity => $name);
363 :     # Create the notes and asides.
364 :     push @lines, ERDB::ObjectNotes($metadata, $self);
365 :     # Get the connecting relationships.
366 :     my ($from, $to) = $erdb->GetConnectingRelationshipData($name);
367 :     # We'll accumulate relationship sentences in here.
368 :     my @relationships;
369 :     # First we do the forward relationships.
370 :     for my $fromRel (sort keys %$from) {
371 :     my $relData = $from->{$fromRel};
372 :     my $line = join(" ", $name, CGI::strong($self->Linked($fromRel)),
373 :     $self->Linked($relData->{to}),
374 :     "(" . ARITY_FROM->{$relData->{arity}} . ")");
375 :     push @relationships, $line;
376 :     }
377 :     # Now the backward relationships.
378 :     for my $toRel (sort keys %$to) {
379 :     my $relData = $to->{$toRel};
380 :     # This is tricky, because we want to use the converse name,
381 :     # and we may not have one. We'll assemble our components in here.
382 :     my @words;
383 :     # Get the entity on the other side.
384 :     my $from = $self->Linked($relData->{from});
385 :     # Create the sentence.
386 :     if ($relData->{converse}) {
387 :     push @words, $name,
388 :     CGI::strong($self->Linked($toRel, $relData->{converse})),
389 :     $from, "(" . ARITY_TO->{$relData->{arity}} . ")";
390 :     } else {
391 :     push @words, $from, CGI::strong($self->Linked($toRel)),
392 :     $name, "(" . ARITY_FROM->{$relData->{arity}} .")";
393 :     }
394 :     # Join the pieces together and put them in the list.
395 :     push @relationships, join(" ", @words);
396 :     }
397 :     # If there are any relationships at all, we render them as a bullet list.
398 :     if (scalar @relationships) {
399 :     # Create a heading.
400 :     push @lines, $self->Heading(4, "Relationships");
401 :     # Convert the relationship sentences to list items.
402 :     my @sentences = map { CGI::li($_) } @relationships;
403 :     # Form them into a bullet list if there's only one, a numbered list
404 :     # otherwise.
405 :     if (scalar @relationships == 1) {
406 :     push @lines, CGI::start_ul(), @sentences, CGI::end_ul();
407 :     } else {
408 :     push @lines, CGI::start_ol(), @sentences, CGI::end_ol();
409 :     }
410 :     }
411 :     # Display the fields.
412 :     push @lines, $self->DocFields($name, $metadata);
413 :     # Display the indexes.
414 :     push @lines, $self->DocIndexes($name, $metadata);
415 :     # Return the result.
416 :     my $retVal = join("\n", @lines);
417 :     return $retVal;
418 :     }
419 :    
420 :     =head3 DocRelationship
421 :    
422 :     my $htmlBlock = $html->DocRelationship($name => $metadata);
423 :    
424 :     Create a documentation block for the specified relationship. The
425 :     documentation block will contain a title, but will not be wrapped in a
426 :     DIV block or anything fancy.
427 :    
428 :     =over 4
429 :    
430 :     =item name
431 :    
432 :     Name of the relationship to document.
433 :    
434 :     =item metadata
435 :    
436 :     [[ErdbPm]] metadata structure for the relationship.
437 :    
438 :     =item RETURN
439 :    
440 :     Returns an HTML string describing the relationship.
441 :    
442 :     =back
443 :    
444 :     =cut
445 :    
446 :     sub DocRelationship {
447 :     # Get the parametrs.
448 :     my ($self, $name, $metadata) = @_;
449 :     # We'll build the documentation block in here.
450 :     my @lines;
451 :     # Start with the heading.
452 :     push @lines, $self->ObjectHeading(relationship => $name);
453 :     # Create the notes and asides.
454 :     push @lines, ERDB::ObjectNotes($metadata, $self);
455 :     # Create linked-up versions of the entity names.
456 :     my $fromEntity = $self->Linked($metadata->{from});
457 :     my $toEntity = $self->Linked($metadata->{to});
458 :     # Get the arities.
459 :     my $fromArity = ARITY_FROM->{$metadata->{arity}};
460 :     my $toArity = ARITY_TO->{$metadata->{arity}};
461 :     # Create the from-sentence.
462 :     my $fromLine = join(" ", $fromEntity, $name, $toEntity,
463 :     "($fromArity)");
464 :     # Determine whether or not we have a converse.
465 :     my $converseName = $metadata->{converse} || "[$name]";
466 :     # Create the to-sentence.
467 :     my $toLine = join(" ", $toEntity, $converseName, $fromEntity,
468 :     "($toArity)");
469 :     # Generate the relationship sentences.
470 :     push @lines, CGI::ul(CGI::li([$fromLine, $toLine]));
471 :     # Display the fields.
472 :     push @lines, $self->DocFields($name, $metadata);
473 :     # Display the indexes.
474 :     push @lines, $self->DocIndexes($name, $metadata);
475 :     # Return the result.
476 :     my $retVal = join("\n", @lines);
477 :     return $retVal;
478 :     }
479 :    
480 :     =head3 DocShape
481 :    
482 :     my @lines = $html->DocShape($name => $metadata);
483 :    
484 :     Create a documentation block for the specified shape. The documentation
485 :     block will contain a title, but will not be wrapped in a DIV block or
486 :     anything fancy.
487 :    
488 :     =over 4
489 :    
490 :     =item name
491 :    
492 :     Name of the shape to document.
493 :    
494 :     =item metadata
495 :    
496 :     [[ErdbPm]] metadata structure for the shape.
497 :    
498 :     =item RETURN
499 :    
500 :     Returns an HTML string describing the shape.
501 :    
502 :     =back
503 :    
504 :     =cut
505 :    
506 :     sub DocShape {
507 :     # Get the parameters.
508 :     my ($self, $name, $metadata) = @_;
509 :     # We'll build the documentation block in here.
510 :     my @lines;
511 :     # Start with the heading.
512 :     push @lines, $self->ObjectHeading(shape => $name);
513 :     # Create the notes and asides.
514 :     push @lines, ERDB::ObjectNotes($metadata, $self);
515 :     # Return the result.
516 :     my $retVal = join("\n", @lines);
517 :     return $retVal;
518 :     }
519 :    
520 :     =head3 DocIndexes
521 :    
522 :     my @lines = $html->DocIndexes($name, $metadata);
523 :    
524 :     Display the indexes associated with the specified object.
525 :    
526 :     =over 4
527 :    
528 :     =item name
529 :    
530 :     Name of the entity or relationship whose indexes are to be documented.
531 :    
532 :     =item metadata
533 :    
534 :     [[ErdbPm]] metadata structure for the specified entity or relationship.
535 :    
536 :     =item RETURN
537 :    
538 :     Returns a list of HTML lines that describe the indexes of the specified
539 :     object.
540 :    
541 :     =back
542 :    
543 :     =cut
544 :    
545 :     sub DocIndexes {
546 :     # Get the parameters.
547 :     my ($self, $name, $metadata) = @_;
548 :     # Declare the return variable.
549 :     my @retVal;
550 :     # Get the list of relations for this object.
551 :     my $relations = $metadata->{Relations};
552 :     # Create a heading for the index table. There is always at least
553 :     # one index, so the heading will never be empty.
554 :     push @retVal, $self->Heading(4, "$name Indexes");
555 :     # Compute the column headers.
556 :     my @headers = (text => 'Table', text => 'Name', text => 'Type',
557 :     text => 'Fields', text => 'Notes');
558 :     # We'll put the table rows in here.
559 :     my @rows;
560 :     # Loop through the relations.
561 :     for my $relation (sort keys %$relations) {
562 :     # Get this relation's index list.
563 :     my $indexes = $relations->{$relation}{Indexes};
564 :     # Loop through the indexes. For each index, we generate a table row.
565 :     for my $index (sort keys %$indexes) {
566 :     # Get this index's descriptor.
567 :     my $indexData = $indexes->{$index};
568 :     # Compute its notes.
569 :     my $notes = join("\n", ERDB::ObjectNotes($indexData, $self));
570 :     # Compute its type.
571 :     my $type = ($indexData->{Unique} ? 'unique' : '');
572 :     # Compute its field list.
573 :     my $fields = join(", ", @{$indexData->{IndexFields}});
574 :     # Only list the index if it is noteworthy.
575 :     if ($fields ne 'id' || $notes) {
576 :     # Create the table row.
577 :     push @rows, [$relation, $index, $type, $fields, $notes];
578 :     }
579 :     }
580 :     }
581 :     # Emit the table.
582 :     push @retVal, $self->FancyTable(\@headers, @rows);
583 :     # Return the result.
584 :     return @retVal;
585 :     }
586 :    
587 :     =head3 DocFields
588 :    
589 :     my @lines = $html->DocFields($name, $metadata);
590 :    
591 :     Display the table of fields for the specified object.
592 :    
593 :     =over 4
594 :    
595 :     =item name
596 :    
597 :     Name of the entity or relationship whose fields are to be
598 :     displayed.
599 :    
600 :     =item metadata
601 :    
602 :     [[ErdbPm]] metadata structure for the specified entity or
603 :     relationship.
604 :    
605 :     =item RETURN
606 :    
607 :     Returns a list of HTML lines that document the fields of the
608 :     specified object.
609 :    
610 :     =back
611 :    
612 :     =cut
613 :    
614 :     sub DocFields {
615 :     # Get the parameters.
616 :     my ($self, $name, $metadata) = @_;
617 :     # Declare the return variable.
618 :     my @retVal;
619 :     # Get the field hash.
620 :     my $fields = $metadata->{Fields};
621 :     # Create a heading for the field table. There is always at least
622 :     # one field, so the heading will never be empty.
623 :     push @retVal, $self->Heading(4, "$name Fields");
624 :     # Now we need to sort the fields. First comes the ID, then the
625 :     # primary fields and the secondary fields.
626 :     my %sorter;
627 :     for my $field (keys %$fields) {
628 :     # Get the field's descriptor.
629 :     my $fieldInfo = $fields->{$field};
630 :     # Determine whether or not we have a primary field.
631 :     my $primary;
632 :     if ($field eq 'id') {
633 :     $primary = 'A';
634 :     } elsif ($fieldInfo->{relation} eq $name) {
635 :     $primary = 'B';
636 :     } else {
637 :     $primary = 'C';
638 :     }
639 :     # Form the sort key from the flag and the name.
640 :     $sorter{$field} = "$primary$field";
641 :     }
642 :     # Create the header descriptor for the table.
643 :     my @header = (text => 'Name', text => 'Type', text => 'Notes');
644 :     # We'll stash the rows in here.
645 :     my @rows;
646 :     # Loop through the fields in their proper order.
647 :     for my $field (Tracer::SortByValue(\%sorter)) {
648 :     # Get the field's descriptor.
649 :     my $fieldInfo = $fields->{$field};
650 :     # Format its table row.
651 :     push @rows, [$field, $fieldInfo->{type}, ERDB::ObjectNotes($fieldInfo, $self)];
652 :     }
653 :     # Create the table.
654 :     push @retVal, $self->FancyTable(\@header, @rows);
655 :     # Return the result.
656 :     return @retVal;
657 :     }
658 :    
659 :    
660 :     =head3 ObjectHeading
661 :    
662 :     my $htmlLine = $self->ObjectHeading($type => $name);
663 :    
664 :     This method will generate the heading line for an object block.
665 :    
666 :     =over 4
667 :    
668 :     =item type
669 :    
670 :     Type of the object (C<entity>, C<relationship>, or C<shape>).
671 :    
672 :     =item name
673 :    
674 :     Name of the object whose heading is to be generated.
675 :    
676 :     =item RETURN
677 :    
678 :     Returns an HTML heading line for the named object.
679 :    
680 :     =back
681 :    
682 :     =cut
683 :    
684 :     sub ObjectHeading {
685 :     # Get the parameters.
686 :     my ($self, $type, $name) = @_;
687 :     # Compute the heading. Note we capitalize the type.
688 :     my $retVal = $self->Heading(3, "$name " . ucfirst($type));
689 :     # Return the result.
690 :     return $retVal;
691 :     }
692 :    
693 :     =head3 FancyTable
694 :    
695 :     my $html = $self->FancyTable(\@cols, @rows);
696 :    
697 :     Create a fancy html table. The first parameter is a hash-looking
698 :     thing that lists column styles and names, for example
699 :    
700 :     [text => 'User Name', text => 'Job Title', num => 'Salary']
701 :    
702 :     The table rows should all be HTML-formatted.
703 :    
704 :     =over 4
705 :    
706 :     =item cols
707 :    
708 :     Reference to a list of column names and styles. For each column,
709 :     the list should contain the column style (C<num>, C<text>, C<code>,
710 :     or C<center>) followed by the column title.
711 :    
712 :     =item rows
713 :    
714 :     List of table rows. Each row is a reference to a list of cells.
715 :    
716 :     =item RETURN
717 :    
718 :     Returns the html for the table. The first row will be headings, and
719 :     the rest will be odd-even colored.
720 :    
721 :     =back
722 :    
723 :     =cut
724 :    
725 :     sub FancyTable {
726 :     # Get the parameters.
727 :     my ($self, $cols, @rows) = @_;
728 :     # This will be a list of the column styles.
729 :     my @styles;
730 :     # This will be a list of the column headings.
731 :     my @headings;
732 :     # Create the column headings.
733 :     for (my $i = 0; $i < scalar(@$cols); $i += 2) {
734 :     push @styles, $cols->[$i];
735 :     push @headings, $cols->[$i+1];
736 :     }
737 :     # Compute the number of columsn.
738 :     my $colCount = scalar @styles;
739 :     # We'll stash table heading cells in here.
740 :     my @headCells;
741 :     # Create the header row.
742 :     for (my $i = 0; $i < $colCount; $i++) {
743 :     push @headCells, CGI::th({ class => $styles[$i] }, $headings[$i]);
744 :     }
745 :     # Prime the table lines with the heading row.
746 :     my @lines = (CGI::start_table({ class => 'fancy' }), CGI::Tr(@headCells));
747 :     # This will be 1 for odd rows and 0 for even rows. The first row is odd.
748 :     my $arity = 1;
749 :     # Loop through the table rows.
750 :     for my $row (@rows) {
751 :     # Create a list of table cells for this row.
752 :     my @cells;
753 :     for (my $i = 0; $i < $colCount; $i++) {
754 :     push @cells, CGI::td({ class => $styles[$i]}, $row->[$i]);
755 :     }
756 :     # Compute this row's style.
757 :     my $class = ($arity ? 'odd' : 'even');
758 :     $arity = 1 - $arity;
759 :     # Form it into HTML and push it into the line list.
760 :     push @lines, CGI::Tr({ class => $class }, @cells);
761 :     }
762 :     # Close the table.
763 :     push @lines, CGI::end_table();
764 :     # Return the result.
765 :     my $retVal = join("\n", @lines);
766 :     return $retVal;
767 :     }
768 :    
769 :     =head3 Linked
770 :    
771 :     my $html = $self->Linked($objectName, $alias);
772 :    
773 :     Generate a JavaScript link to the specified object. If an alias is
774 :     specified, it will be used in lieu of the object name as the link text.
775 :    
776 :     =over 4
777 :    
778 :     =item objectName
779 :    
780 :     Name of the object to which a link is desired.
781 :    
782 :     =item alias (optional)
783 :    
784 :     Text to use for the link.
785 :    
786 :     =item RETURN
787 :    
788 :     Returns the HTML for an active object name.
789 :    
790 :     =back
791 :    
792 :     =cut
793 :    
794 :     sub Linked {
795 :     # Get the parameters.
796 :     my ($self, $objectName, $alias) = @_;
797 :     # Compute the link text.
798 :     my $text = $alias || $objectName;
799 :     # Compute the DIV identifier for the object.
800 :     my $id = $self->_DivID($objectName);
801 :     # Format the link.
802 :     my $href = "javascript:ShowNewBlock($self->{javaThing}, '$id')";
803 :     my $retVal = CGI::a({ href => $href }, $text);
804 :     # Return the result.
805 :     return $retVal;
806 :     }
807 :    
808 :     =head2 Wiki Markup Methods
809 :    
810 :     The methods in this section create the appropriate HTML markup for ERDB
811 :     object notes. It allows this object to be used as a drop-in replacement
812 :     for [[WikiToolsPm]] when using the [[ErdbPm]] documentation methods.
813 :    
814 :     =head3 Heading
815 :    
816 :     my $line = $wiki->Heading($level, $text);
817 :    
818 :     Return the code for a heading line at the specified level.
819 :    
820 :     =over 4
821 :    
822 :     =item level
823 :    
824 :     Desired heading level.
825 :    
826 :     =item text
827 :    
828 :     Title for the heading's section.
829 :    
830 :     =item RETURN
831 :    
832 :     Returns a formatted heading line.
833 :    
834 :     =back
835 :    
836 :     =cut
837 :    
838 :     sub Heading {
839 :     # Get the parameters.
840 :     my ($self, $level, $text) = @_;
841 :     # Create the heading line.
842 :     my $retVal = "<h$level>$text</h$level>";
843 :     # Return the result.
844 :     return $retVal;
845 :     }
846 :    
847 :     =head3 Bold
848 :    
849 :     my $markup = $wiki->Bold($text);
850 :    
851 :     Bold the specified text.
852 :    
853 :     =cut
854 :    
855 :     sub Bold {
856 :     my ($self, $text) = @_;
857 :     return CGI::strong($text);
858 :     }
859 :    
860 :     =head3 Italic
861 :    
862 :     my $markup = $wiki->Italic($text);
863 :    
864 :     Italicize the specified text.
865 :    
866 :     =cut
867 :    
868 :     sub Italic {
869 :     my ($self, $text) = @_;
870 :     return CGI::em($text);
871 :     }
872 :    
873 :     =head3 LinkMarkup
874 :    
875 :     my $boldCode = $wiki->LinkMarkup($link, $text);
876 :    
877 :     Returns the Wiki code for a link.
878 :    
879 :     =over 4
880 :    
881 :     =item link
882 :    
883 :     URL or topic name referenced by the link.
884 :    
885 :     =item text (optional)
886 :    
887 :     Text of the link.
888 :    
889 :     =back
890 :    
891 :     =cut
892 :    
893 :     sub LinkMarkup {
894 :     # Get the parameters.
895 :     my ($self, $link, $text) = @_;
896 :     # Declare the return variable.
897 :     my $retVal;
898 :     # Check to see if we have text. If we don't, the URL is also
899 :     # the text.
900 :     my $actualText = (defined $text ? $text : $link);
901 :     # Is this an internal link?
902 :     if ($link =~ /^#(.+)/) {
903 :     # Yes. Use our special format.
904 :     $retVal = $self->Linked($1, $actualText);
905 :     } else {
906 :     # Form a normal link.
907 :     $retVal = CGI::a({ href => $link }, $actualText);
908 :     }
909 :     # Return the result.
910 :     return $retVal;
911 :     }
912 :    
913 :     =head3 Table
914 :    
915 :     my $wikiText = $wiki->Table(@rows);
916 :    
917 :     Create a Wiki table. The parameters are all list references. The first
918 :     describes the header row, and the remaining rows are presented
919 :     sequentially. This is a very simple table, using only default settings
920 :     and with everything left-aligned.
921 :    
922 :     =over 4
923 :    
924 :     =item rows
925 :    
926 :     List of table rows. Each table row is a list reference containing the
927 :     cells of the row in column order. The first row is used as the header.
928 :    
929 :     =item RETURN
930 :    
931 :     Returns a string that will generate a Wiki table.
932 :    
933 :     =back
934 :    
935 :     =cut
936 :    
937 :     sub Table {
938 :     # Note that we treat the first row as column headers.
939 :     my ($self, $headers, @rows) = @_;
940 :     # Put the headers in the odd format expected by FancyTable.
941 :     my @headList = map { (text => $_) } @$headers;
942 :     # Format the table.
943 :     my $retVal = $self->FancyTable(\@headList, @rows);
944 :     # Return the result.
945 :     return $retVal;
946 :     }
947 :    
948 :    
949 :     =head3 List
950 :    
951 :     my $wikiText = $wiki->List(@items);
952 :    
953 :     Create a Wiki list. The parameters are all strings that are put into the
954 :     list sequentially.
955 :    
956 :     =over 4
957 :    
958 :     =item items
959 :    
960 :     List of items to be formatted into a wiki list.
961 :    
962 :     =item RETURN
963 :    
964 :     Returns wiki markup text that will display as an unordered list.
965 :    
966 :     =back
967 :    
968 :     =cut
969 :    
970 :     sub List {
971 :     # Get the parameters.
972 :     my ($self, @items) = @_;
973 :     # Format the list.
974 :     my $retVal = CGI::ul(map { CGI::li($_) } @items);
975 :     # Return the result.
976 :     return $retVal;
977 :     }
978 :    
979 :     =head3 Para
980 :    
981 :     my $markup = $wiki->Para($text);
982 :    
983 :     Create a paragraph from the specified text.
984 :    
985 :     =over 4
986 :    
987 :     =item text
988 :    
989 :     Text to format as a paragraph.
990 :    
991 :     =item RETURN
992 :    
993 :     Returns the text formatted as a paragraph.
994 :    
995 :     =back
996 :    
997 :     =cut
998 :    
999 :     sub Para {
1000 :     my ($self, $text) = @_;
1001 :     return CGI::p($text);
1002 :     }
1003 :    
1004 :     =head2 Internal Utility Methods
1005 :    
1006 :     =head3 _DivID
1007 :    
1008 :     my $id = $html->_DivID($objectName);
1009 :    
1010 :     Return the DIV identifier for the specified entity, relationship, or
1011 :     shape.
1012 :    
1013 :     =over 4
1014 :    
1015 :     =item objectName
1016 :    
1017 :     Name of the object whose DIV block identifier is desired.
1018 :    
1019 :     =item RETURN
1020 :    
1021 :     Returns the identifier for the named object's DIV block.
1022 :    
1023 :     =back
1024 :    
1025 :     =cut
1026 :    
1027 :     sub _DivID {
1028 :     # Get the parameters.
1029 :     my ($self, $objectName) = @_;
1030 :     # Declare the return variable.
1031 :     my $retVal = $self->{idString} . $objectName;
1032 :     # Return the result.
1033 :     return $retVal;
1034 :     }
1035 :    
1036 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3