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

Annotation of /Sprout/ERDBPDocPage.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (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 : parrello 1.4 use ERDBExtras;
27 : parrello 1.1
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 : parrello 1.5 L<ERDB> object describing the database.
50 : parrello 1.1
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 : parrello 1.5 L<ERDB> object for the databasse. If this option is specified, it
101 : parrello 1.1 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 : parrello 1.8 my $retVal = {
133 : parrello 1.1 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 : parrello 1.5 the document needs to have C<ERDB.js> included for scripting and C<ERDB.css>
153 : parrello 1.1 for styles. The parameter is a hash of options. The permissible options are given
154 :     below.
155 :    
156 :     =over 4
157 :    
158 :     =item boxHeight
159 :    
160 :     The height for the display area, in pixels. The default is 450.
161 :    
162 :     =item padding
163 :    
164 :     The padding to use around the display elements, in pixels. The default is 5.
165 :    
166 :     =item buttonWidth
167 :    
168 :     The width of the navigation buttons, in pixels. The default is 50.
169 :    
170 :     =item selectWidth
171 :    
172 : parrello 1.2 The width of the selection area, in pixels. The default is 150.
173 : parrello 1.1
174 : parrello 1.3 =item displayWidth
175 :    
176 :     The width of the display area, in pixels. The default is the diagram
177 :     width (if any) or 600 if there is no diagram.
178 :    
179 : parrello 1.1 =item
180 :    
181 :     =back
182 :    
183 :     =cut
184 :    
185 :     sub DocPage {
186 :     # Get the parameters.
187 :     my ($self, %options) = @_;
188 :     # Extract the options.
189 :     my $boxHeight = $options{boxHeight} || 450;
190 :     my $padding = $options{padding} || 5;
191 :     my $buttonWidth = $options{buttonWidth} || 50;
192 : parrello 1.2 my $selectWidth = $options{selectWidth} || 150;
193 : parrello 1.1 # Compute the width for the popup menu thing.
194 :     my $menuWidth = $selectWidth - 2 * $padding;
195 : parrello 1.3 my $menuHeight = $boxHeight;
196 :     # Get the ERDB object.
197 :     my $erdb = $self->{erdb};
198 :     # Get the diagram options (if any).
199 :     my $diagramData = $erdb->GetDiagramOptions();
200 :     # Compute the width for the display area.
201 :     my $displayWidth = $options{displayWidth};
202 :     # If there is no explicit width, we need to apply a default width.
203 :     if (! $displayWidth) {
204 :     # Check for a diagram. If we have one, its width takes precedence.
205 :     if (defined $diagramData) {
206 :     $displayWidth = $diagramData->{width};
207 :     }
208 :     # If there's no diagram, or the diagram does not have a width,
209 :     # we apply a default.
210 :     if (! defined $displayWidth) {
211 :     $displayWidth = 600;
212 :     }
213 :     }
214 :     # Add room for padding.
215 :     $displayWidth += 4 * $padding;
216 : parrello 1.1 # Convert all the numbers to measurements.
217 : parrello 1.4 for my $measurement (qw(boxHeight padding buttonWidth selectWidth
218 : parrello 1.3 menuHeight menuWidth displayWidth)) {
219 : parrello 1.1 eval("\$$measurement .= 'px'");
220 :     }
221 :     # We'll format our HTML in here.
222 :     my @lines;
223 :     # First and foremost, we need a list of the object types in documentation
224 :     # order.
225 :     my @types = qw(entity relationship shape);
226 :     # We need a list of the DIV block names, a list of the DIV blocks themselves,
227 :     # and a list of object names for each object type.
228 :     my (@divBlocks, @divNames);
229 :     my %optGroups = map { $_ => [] } @types;
230 :     # Loop through the three object types.
231 :     for my $type (@types) {
232 :     # Get the option group list for this type.
233 :     my $optGroup = $optGroups{$type};
234 :     # Get the table of objects of this type.
235 :     my $groupObjectsTable = $erdb->GetObjectsTable($type);
236 :     # Loop through them in lexical order.
237 :     for my $name (sort keys %$groupObjectsTable) {
238 :     # Put this object in the current option group.
239 :     push @$optGroup, $name;
240 :     # Put its DIV identifier in the name list.
241 :     my $divID = $self->_DivID($name);
242 :     push @divNames, $divID;
243 :     # Generate its block.
244 :     my $divBlockHtml = $self->DocObject($type => $name,
245 :     $groupObjectsTable->{$name});
246 : parrello 1.3 my $divBlock = CGI::div({ id => $divID,
247 :     style => "display: none;" },
248 :     $divBlockHtml);
249 : parrello 1.1 # Save the block with the DIV ID.
250 :     push @divBlocks, $divBlock;
251 :     }
252 :     }
253 : parrello 1.2 # Now we set up the diagram. The next two values are used to determine
254 :     # the functionality and name of the reset button. If there's no diagram,
255 :     # the button clears the display. If there is, the button shows the diagram.
256 :     my $diagramName = '';
257 :     my $clearButton = 'CLEAR';
258 :     # A diagram is only going to be applicable if we have diagram options.
259 :     if ($diagramData) {
260 :     # Here we can do a diagram. Create a DIV for it.
261 :     $diagramName = 'DBDiagram';
262 :     my $divID = $self->_DivID($diagramName);
263 :     push @divNames, $divID;
264 :     # Generate its block.
265 :     my $diagramHTML = $self->BuildDiagram($diagramData);
266 : parrello 1.3 my $divBlock = CGI::div({ id => $divID,
267 :     style => "display: block;" },
268 :     $diagramHTML);
269 : parrello 1.2 # Change the name of the reset button.
270 :     $clearButton = 'IMAGE';
271 :     # Save the block with the DIV ID.
272 :     push @divBlocks, $divBlock;
273 :     }
274 : parrello 1.1 # Now we create the script to set this all up.
275 :     my $initCall = "new ErdbStatusThing(\"$self->{selectBox}\", \"" .
276 :     join(" ", @divNames) . "\")";
277 :     push @lines, "<script type=\"text/javascript\">",
278 :     " var $self->{javaThing} = $initCall;",
279 :     "</script>";
280 : parrello 1.2 # Next we create the menu box. First, we need a list of the nonempty
281 : parrello 1.1 # option groups.
282 :     my @optGroupList;
283 :     for my $type (@types) {
284 :     my $thisGroup = $optGroups{$type};
285 :     if (scalar @$thisGroup) {
286 :     push @optGroupList, CGI::optgroup(-name => ERDB::Plurals($type),
287 :     -values => $thisGroup);
288 :     }
289 :     }
290 :     # This is the event string we want when the menu box value changes.
291 :     my $event = "ShowBlockReset($self->{javaThing}, '$self->{idString}' + this.value)";
292 : parrello 1.4 # Note that the size parameter doesn't really matter. It has to be something
293 :     # greater than 1, but the real size is determined by the style.
294 : parrello 1.1 my $menuBox = CGI::popup_menu(-id => $self->{selectBox},
295 : parrello 1.4 -values => \@optGroupList, -size => 99,
296 : parrello 1.3 -style => "width: $menuWidth; height: $menuHeight;",
297 :     -onChange => $event);
298 : parrello 1.1 # Next we have the DIV blocks themselves.
299 :     my $divBlocks = join("\n", @divBlocks);
300 :     # Now we have the buttons.
301 :     my $buttonStyle = "width: $buttonWidth; text-align: center;";
302 :     my @buttons = (CGI::button(-value => 'BACK', -style => $buttonStyle,
303 : parrello 1.3 -class => 'button',
304 : parrello 1.1 -onClick => "ShowPrevious($self->{javaThing})"),
305 : parrello 1.2 CGI::button(-value => $clearButton, -style => $buttonStyle,
306 : parrello 1.3 -class => 'button',
307 : parrello 1.2 -onClick => "ShowBlockReset($self->{javaThing}, '$diagramName')"),
308 : parrello 1.1 );
309 :     # Create the style for the documentation display area.
310 : parrello 1.3 my $divStyle = "width: $displayWidth; overflow-x: display; " .
311 :     "overflow-y: auto; height: $boxHeight";
312 : parrello 1.1 # Assemble the menu and the div blocks.
313 : parrello 1.3 push @lines, CGI::table({ border => 0, valign => 'top' },
314 :     CGI::Tr(CGI::td(join(" ", @buttons))),
315 : parrello 1.1 CGI::Tr(
316 :     CGI::td({ style => "padding: $padding; width: $selectWidth" },
317 : parrello 1.3 $menuBox),
318 : parrello 1.1 CGI::td({ style => "padding: $padding"},
319 :     CGI::div({ style => $divStyle }, $divBlocks)),
320 :     ));
321 :     # Return the result.
322 :     my $retVal = join("\n", @lines, "");
323 :     return $retVal;
324 :     }
325 :    
326 :    
327 :     =head3 DocObject
328 :    
329 :     my $html = $html->DocObject($type => $name, $metadata);
330 :    
331 :     Create a documentation block for the specified entity, relationship, or
332 :     shape. The documentation block will contain a title, but will not be
333 :     wrapped in a DIV block or anything fancy.
334 :    
335 :     =over 4
336 :    
337 :     =item type
338 :    
339 :     Type of object: C<entity>, C<relationship>, or C<shape>. The types are
340 :     case-insensitive, and plurals work.
341 :    
342 :     =item name
343 :    
344 :     Name of the entity, relationship, or shape.
345 :    
346 :     =item metadata
347 :    
348 : parrello 1.5 L<ERDB> metadata object describing the entity, relationship, or shape.
349 : parrello 1.1
350 :     =item RETURN
351 :    
352 :     Returns a documentation block for the specified object.
353 :    
354 :     =back
355 :    
356 :     =cut
357 :    
358 :     sub DocObject {
359 :     # Get the parameters.
360 :     my ($self, $type, $name, $metadata) = @_;
361 :     # Declare the return variable.
362 :     my $retVal;
363 :     # Process according to the type of thing.
364 :     if ($type =~ /^entit(y|ies)/i) {
365 :     $retVal = $self->DocEntity($name => $metadata);
366 :     } elsif ($type =~ /^relationship/i) {
367 :     $retVal = $self->DocRelationship($name => $metadata);
368 :     } elsif ($type =~ /^shape/i) {
369 :     $retVal = $self->DocShape($name => $metadata);
370 :     } else {
371 :     Confess("Invalid object type \"$type\" in documentation handler.");
372 :     }
373 :     # Return the result.
374 :     return $retVal;
375 :     }
376 :    
377 :     =head3 DocEntity
378 :    
379 :     my $htmlBlock = $html->DocEntity($name => $metadata);
380 :    
381 :     Return the documentation block for the specified entity.
382 :    
383 :     =over 4
384 :    
385 :     =item name
386 :    
387 :     Name of the entity whose documentation block is desired.
388 :    
389 :     =item metadata
390 :    
391 : parrello 1.5 L<ERDB> metatada structure for the specified entity.
392 : parrello 1.1
393 :     =item RETURN
394 :    
395 :     Returns a documentation block for the specified entity.
396 :    
397 :     =back
398 :    
399 :     =cut
400 :    
401 :     sub DocEntity {
402 :     # Get the parameters.
403 :     my ($self, $name, $metadata) = @_;
404 :     # Get the database object.
405 :     my $erdb = $self->{erdb};
406 :     # We'll build the documentation block in here.
407 :     my @lines;
408 :     # Start with the heading.
409 :     push @lines, $self->ObjectHeading(entity => $name);
410 :     # Create the notes and asides.
411 :     push @lines, ERDB::ObjectNotes($metadata, $self);
412 :     # Get the connecting relationships.
413 :     my ($from, $to) = $erdb->GetConnectingRelationshipData($name);
414 :     # We'll accumulate relationship sentences in here.
415 :     my @relationships;
416 :     # First we do the forward relationships.
417 :     for my $fromRel (sort keys %$from) {
418 :     my $relData = $from->{$fromRel};
419 :     my $line = join(" ", $name, CGI::strong($self->Linked($fromRel)),
420 :     $self->Linked($relData->{to}),
421 :     "(" . ARITY_FROM->{$relData->{arity}} . ")");
422 :     push @relationships, $line;
423 :     }
424 :     # Now the backward relationships.
425 :     for my $toRel (sort keys %$to) {
426 :     my $relData = $to->{$toRel};
427 :     # This is tricky, because we want to use the converse name,
428 :     # and we may not have one. We'll assemble our components in here.
429 :     my @words;
430 :     # Get the entity on the other side.
431 :     my $from = $self->Linked($relData->{from});
432 :     # Create the sentence.
433 :     if ($relData->{converse}) {
434 :     push @words, $name,
435 :     CGI::strong($self->Linked($toRel, $relData->{converse})),
436 :     $from, "(" . ARITY_TO->{$relData->{arity}} . ")";
437 :     } else {
438 :     push @words, $from, CGI::strong($self->Linked($toRel)),
439 :     $name, "(" . ARITY_FROM->{$relData->{arity}} .")";
440 :     }
441 :     # Join the pieces together and put them in the list.
442 :     push @relationships, join(" ", @words);
443 :     }
444 :     # If there are any relationships at all, we render them as a bullet list.
445 :     if (scalar @relationships) {
446 :     # Create a heading.
447 :     push @lines, $self->Heading(4, "Relationships");
448 :     # Convert the relationship sentences to list items.
449 :     my @sentences = map { CGI::li($_) } @relationships;
450 :     # Form them into a bullet list if there's only one, a numbered list
451 :     # otherwise.
452 :     if (scalar @relationships == 1) {
453 :     push @lines, CGI::start_ul(), @sentences, CGI::end_ul();
454 :     } else {
455 :     push @lines, CGI::start_ol(), @sentences, CGI::end_ol();
456 :     }
457 :     }
458 :     # Display the fields.
459 :     push @lines, $self->DocFields($name, $metadata);
460 :     # Display the indexes.
461 :     push @lines, $self->DocIndexes($name, $metadata);
462 :     # Return the result.
463 :     my $retVal = join("\n", @lines);
464 :     return $retVal;
465 :     }
466 :    
467 :     =head3 DocRelationship
468 :    
469 :     my $htmlBlock = $html->DocRelationship($name => $metadata);
470 :    
471 :     Create a documentation block for the specified relationship. The
472 :     documentation block will contain a title, but will not be wrapped in a
473 :     DIV block or anything fancy.
474 :    
475 :     =over 4
476 :    
477 :     =item name
478 :    
479 :     Name of the relationship to document.
480 :    
481 :     =item metadata
482 :    
483 : parrello 1.5 L<ERDB> metadata structure for the relationship.
484 : parrello 1.1
485 :     =item RETURN
486 :    
487 :     Returns an HTML string describing the relationship.
488 :    
489 :     =back
490 :    
491 :     =cut
492 :    
493 :     sub DocRelationship {
494 :     # Get the parametrs.
495 :     my ($self, $name, $metadata) = @_;
496 :     # We'll build the documentation block in here.
497 :     my @lines;
498 :     # Start with the heading.
499 :     push @lines, $self->ObjectHeading(relationship => $name);
500 :     # Create the notes and asides.
501 :     push @lines, ERDB::ObjectNotes($metadata, $self);
502 :     # Create linked-up versions of the entity names.
503 :     my $fromEntity = $self->Linked($metadata->{from});
504 :     my $toEntity = $self->Linked($metadata->{to});
505 :     # Get the arities.
506 :     my $fromArity = ARITY_FROM->{$metadata->{arity}};
507 :     my $toArity = ARITY_TO->{$metadata->{arity}};
508 :     # Create the from-sentence.
509 :     my $fromLine = join(" ", $fromEntity, $name, $toEntity,
510 :     "($fromArity)");
511 :     # Determine whether or not we have a converse.
512 :     my $converseName = $metadata->{converse} || "[$name]";
513 :     # Create the to-sentence.
514 :     my $toLine = join(" ", $toEntity, $converseName, $fromEntity,
515 :     "($toArity)");
516 :     # Generate the relationship sentences.
517 :     push @lines, CGI::ul(CGI::li([$fromLine, $toLine]));
518 :     # Display the fields.
519 :     push @lines, $self->DocFields($name, $metadata);
520 :     # Display the indexes.
521 :     push @lines, $self->DocIndexes($name, $metadata);
522 :     # Return the result.
523 :     my $retVal = join("\n", @lines);
524 :     return $retVal;
525 :     }
526 :    
527 :     =head3 DocShape
528 :    
529 :     my @lines = $html->DocShape($name => $metadata);
530 :    
531 :     Create a documentation block for the specified shape. The documentation
532 :     block will contain a title, but will not be wrapped in a DIV block or
533 :     anything fancy.
534 :    
535 :     =over 4
536 :    
537 :     =item name
538 :    
539 :     Name of the shape to document.
540 :    
541 :     =item metadata
542 :    
543 : parrello 1.5 L<ERDB> metadata structure for the shape.
544 : parrello 1.1
545 :     =item RETURN
546 :    
547 :     Returns an HTML string describing the shape.
548 :    
549 :     =back
550 :    
551 :     =cut
552 :    
553 :     sub DocShape {
554 :     # Get the parameters.
555 :     my ($self, $name, $metadata) = @_;
556 :     # We'll build the documentation block in here.
557 :     my @lines;
558 :     # Start with the heading.
559 :     push @lines, $self->ObjectHeading(shape => $name);
560 :     # Create the notes and asides.
561 :     push @lines, ERDB::ObjectNotes($metadata, $self);
562 :     # Return the result.
563 :     my $retVal = join("\n", @lines);
564 :     return $retVal;
565 :     }
566 :    
567 :     =head3 DocIndexes
568 :    
569 :     my @lines = $html->DocIndexes($name, $metadata);
570 :    
571 :     Display the indexes associated with the specified object.
572 :    
573 :     =over 4
574 :    
575 :     =item name
576 :    
577 :     Name of the entity or relationship whose indexes are to be documented.
578 :    
579 :     =item metadata
580 :    
581 : parrello 1.5 L<ERDB> metadata structure for the specified entity or relationship.
582 : parrello 1.1
583 :     =item RETURN
584 :    
585 :     Returns a list of HTML lines that describe the indexes of the specified
586 :     object.
587 :    
588 :     =back
589 :    
590 :     =cut
591 :    
592 :     sub DocIndexes {
593 :     # Get the parameters.
594 :     my ($self, $name, $metadata) = @_;
595 :     # Declare the return variable.
596 :     my @retVal;
597 :     # Get the list of relations for this object.
598 :     my $relations = $metadata->{Relations};
599 :     # Create a heading for the index table. There is always at least
600 :     # one index, so the heading will never be empty.
601 :     push @retVal, $self->Heading(4, "$name Indexes");
602 :     # Compute the column headers.
603 :     my @headers = (text => 'Table', text => 'Name', text => 'Type',
604 :     text => 'Fields', text => 'Notes');
605 :     # We'll put the table rows in here.
606 :     my @rows;
607 :     # Loop through the relations.
608 :     for my $relation (sort keys %$relations) {
609 :     # Get this relation's index list.
610 :     my $indexes = $relations->{$relation}{Indexes};
611 :     # Loop through the indexes. For each index, we generate a table row.
612 :     for my $index (sort keys %$indexes) {
613 :     # Get this index's descriptor.
614 :     my $indexData = $indexes->{$index};
615 :     # Compute its notes.
616 :     my $notes = join("\n", ERDB::ObjectNotes($indexData, $self));
617 :     # Compute its type.
618 : parrello 1.8 my $type = ($indexData->{unique} ? 'unique' : '');
619 : parrello 1.1 # Compute its field list.
620 :     my $fields = join(", ", @{$indexData->{IndexFields}});
621 :     # Only list the index if it is noteworthy.
622 :     if ($fields ne 'id' || $notes) {
623 :     # Create the table row.
624 :     push @rows, [$relation, $index, $type, $fields, $notes];
625 :     }
626 :     }
627 :     }
628 :     # Emit the table.
629 : parrello 1.4 push @retVal, FancyTable(\@headers, @rows);
630 : parrello 1.1 # Return the result.
631 :     return @retVal;
632 :     }
633 :    
634 :     =head3 DocFields
635 :    
636 :     my @lines = $html->DocFields($name, $metadata);
637 :    
638 :     Display the table of fields for the specified object.
639 :    
640 :     =over 4
641 :    
642 :     =item name
643 :    
644 :     Name of the entity or relationship whose fields are to be
645 :     displayed.
646 :    
647 :     =item metadata
648 :    
649 : parrello 1.5 L<ERDB> metadata structure for the specified entity or
650 : parrello 1.1 relationship.
651 :    
652 :     =item RETURN
653 :    
654 :     Returns a list of HTML lines that document the fields of the
655 :     specified object.
656 :    
657 :     =back
658 :    
659 :     =cut
660 :    
661 :     sub DocFields {
662 :     # Get the parameters.
663 :     my ($self, $name, $metadata) = @_;
664 :     # Declare the return variable.
665 :     my @retVal;
666 :     # Get the field hash.
667 :     my $fields = $metadata->{Fields};
668 :     # Create a heading for the field table. There is always at least
669 :     # one field, so the heading will never be empty.
670 :     push @retVal, $self->Heading(4, "$name Fields");
671 : parrello 1.2 # Generate the field table data.
672 :     my ($header, $rows) = ERDB::ComputeFieldTable($self, $name, $fields);
673 :     # Set up the header styles. They are all text.
674 :     my @headerRow;
675 :     for my $caption (@$header) {
676 :     push @headerRow, text => $caption;
677 : parrello 1.1 }
678 :     # Create the table.
679 : parrello 1.4 push @retVal, FancyTable(\@headerRow, @$rows);
680 : parrello 1.1 # Return the result.
681 :     return @retVal;
682 :     }
683 :    
684 :    
685 :     =head3 ObjectHeading
686 :    
687 :     my $htmlLine = $self->ObjectHeading($type => $name);
688 :    
689 :     This method will generate the heading line for an object block.
690 :    
691 :     =over 4
692 :    
693 :     =item type
694 :    
695 :     Type of the object (C<entity>, C<relationship>, or C<shape>).
696 :    
697 :     =item name
698 :    
699 :     Name of the object whose heading is to be generated.
700 :    
701 :     =item RETURN
702 :    
703 :     Returns an HTML heading line for the named object.
704 :    
705 :     =back
706 :    
707 :     =cut
708 :    
709 :     sub ObjectHeading {
710 :     # Get the parameters.
711 :     my ($self, $type, $name) = @_;
712 :     # Compute the heading. Note we capitalize the type.
713 :     my $retVal = $self->Heading(3, "$name " . ucfirst($type));
714 :     # Return the result.
715 :     return $retVal;
716 :     }
717 :    
718 :     =head3 FancyTable
719 :    
720 : parrello 1.4 my $html = ERDBPDocPage::FancyTable(\@cols, @rows);
721 : parrello 1.1
722 :     Create a fancy html table. The first parameter is a hash-looking
723 :     thing that lists column styles and names, for example
724 :    
725 :     [text => 'User Name', text => 'Job Title', num => 'Salary']
726 :    
727 :     The table rows should all be HTML-formatted.
728 :    
729 :     =over 4
730 :    
731 :     =item cols
732 :    
733 :     Reference to a list of column names and styles. For each column,
734 :     the list should contain the column style (C<num>, C<text>, C<code>,
735 :     or C<center>) followed by the column title.
736 :    
737 :     =item rows
738 :    
739 :     List of table rows. Each row is a reference to a list of cells.
740 :    
741 :     =item RETURN
742 :    
743 :     Returns the html for the table. The first row will be headings, and
744 :     the rest will be odd-even colored.
745 :    
746 :     =back
747 :    
748 :     =cut
749 :    
750 :     sub FancyTable {
751 :     # Get the parameters.
752 : parrello 1.4 my ($cols, @rows) = @_;
753 : parrello 1.1 # This will be a list of the column styles.
754 :     my @styles;
755 :     # This will be a list of the column headings.
756 :     my @headings;
757 :     # Create the column headings.
758 :     for (my $i = 0; $i < scalar(@$cols); $i += 2) {
759 :     push @styles, $cols->[$i];
760 :     push @headings, $cols->[$i+1];
761 :     }
762 :     # Compute the number of columsn.
763 :     my $colCount = scalar @styles;
764 :     # We'll stash table heading cells in here.
765 :     my @headCells;
766 :     # Create the header row.
767 :     for (my $i = 0; $i < $colCount; $i++) {
768 :     push @headCells, CGI::th({ class => $styles[$i] }, $headings[$i]);
769 :     }
770 :     # Prime the table lines with the heading row.
771 :     my @lines = (CGI::start_table({ class => 'fancy' }), CGI::Tr(@headCells));
772 :     # This will be 1 for odd rows and 0 for even rows. The first row is odd.
773 :     my $arity = 1;
774 :     # Loop through the table rows.
775 :     for my $row (@rows) {
776 :     # Create a list of table cells for this row.
777 :     my @cells;
778 :     for (my $i = 0; $i < $colCount; $i++) {
779 :     push @cells, CGI::td({ class => $styles[$i]}, $row->[$i]);
780 :     }
781 :     # Compute this row's style.
782 :     my $class = ($arity ? 'odd' : 'even');
783 :     $arity = 1 - $arity;
784 :     # Form it into HTML and push it into the line list.
785 :     push @lines, CGI::Tr({ class => $class }, @cells);
786 :     }
787 :     # Close the table.
788 :     push @lines, CGI::end_table();
789 :     # Return the result.
790 :     my $retVal = join("\n", @lines);
791 :     return $retVal;
792 :     }
793 :    
794 :     =head3 Linked
795 :    
796 :     my $html = $self->Linked($objectName, $alias);
797 :    
798 :     Generate a JavaScript link to the specified object. If an alias is
799 :     specified, it will be used in lieu of the object name as the link text.
800 :    
801 :     =over 4
802 :    
803 :     =item objectName
804 :    
805 :     Name of the object to which a link is desired.
806 :    
807 :     =item alias (optional)
808 :    
809 :     Text to use for the link.
810 :    
811 :     =item RETURN
812 :    
813 :     Returns the HTML for an active object name.
814 :    
815 :     =back
816 :    
817 :     =cut
818 :    
819 :     sub Linked {
820 :     # Get the parameters.
821 :     my ($self, $objectName, $alias) = @_;
822 :     # Compute the link text.
823 :     my $text = $alias || $objectName;
824 :     # Compute the DIV identifier for the object.
825 :     my $id = $self->_DivID($objectName);
826 :     # Format the link.
827 :     my $href = "javascript:ShowNewBlock($self->{javaThing}, '$id')";
828 :     my $retVal = CGI::a({ href => $href }, $text);
829 :     # Return the result.
830 :     return $retVal;
831 :     }
832 :    
833 : parrello 1.2 =head3 BuildDiagram
834 :    
835 :     my $diagramHTML = $html->BuildDiagram($diagramData);
836 :    
837 :     Create the HTML to display a database diagram. The incoming data object
838 :     contains the diagram width, height, and options. The data therein will be
839 :     used to generate a Flash movie of the database.
840 :    
841 :     =over 4
842 :    
843 :     =item diagramData
844 :    
845 :     Hash containing the width (C<width>), height (C<height>), and other options
846 :     for displaying the diagram.
847 :    
848 :     =item RETURN
849 :    
850 :     Returns the HTML to display the database diagram.
851 :    
852 :     =back
853 :    
854 :     =cut
855 :    
856 :     sub BuildDiagram {
857 :     # Get the parameters.
858 :     my ($self, $diagramData) = @_;
859 :     # Declare the return variable.
860 :     my @retVal;
861 : parrello 1.7 # We need a to create a script that outputs the DBD so that Flash
862 :     # can read it.
863 : parrello 1.2 my $erdb = $self->{erdb};
864 : parrello 1.7 my $dbdFileName = $erdb->GetMetaFileName();
865 :     # Compute the URL of the DBD.
866 :     my $dbdURL = "$ERDBExtras::cgi_url/ErdbDbdPrint.cgi?xmlFileName=$dbdFileName";
867 :     # Compute the height and width for the diagram.
868 :     my $height = $diagramData->{height} || 800;
869 :     my $width = $diagramData->{width} || 750;
870 :     # Compute the option string. We remove height and width, and we explicitly
871 :     # specify the link format.
872 :     my @options;
873 :     for my $key (keys %$diagramData) {
874 :     if ($key ne 'height' && $key ne 'width') {
875 :     push @options, qq($key="$diagramData->{$key}");
876 : parrello 1.2 }
877 :     }
878 : parrello 1.7 push @options, 'links="javascript"';
879 :     my $options = join(" ", @options);
880 :     # Compute the base URL.
881 :     my $base = "$ERDBExtras::cgi_url/ErdbDocWidget.cgi";
882 :     # Compute the output string to be written by the script.
883 :     my $dwriter = qq(<object classid="clsid:d27cdb6e-ae6d-11cf-96b8-444553540000" ) .
884 :     qq(codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=9,0,0,0" ) .
885 :     qq(width="$width" height="$height" id="Diagrammer.swf" align=""> <param name="allowScriptAccess" ) .
886 :     qq(value="sameDomain" /> <param name="allowFullScreen" value="false" /> ) .
887 :     qq(<param name="movie" value="$ERDBExtras::diagramURL" /> <param name="quality" value="high" /> ) .
888 :     qq(<param name="bgcolor" value="" /> <param name="base" value="$base" /> <param name="swliveconnect" value="" /> ) .
889 :     qq(<embed src="$ERDBExtras::diagramURL" quality="high" bgcolor="" width="$width" ) .
890 :     qq(height="$height" name="Diagrammer.swf" align="" base="$base" swliveconnect="" allowScriptAccess="sameDomain" ) .
891 :     qq(allowFullScreen="false" type="application/x-shockwave-flash" pluginspage="http://www.macromedia.com/go/getflashplayer" />) .
892 :     qq(</object>);
893 :     # Generate the HTML for the flash movie. We have a method to pass in the
894 :     # parameters and another the diagram can call to jump to a new location.
895 :     push @retVal, '<script type="text/javascript">',
896 :     ' var stuff = "";',
897 :     ' function GetDiagramData() {',
898 :     ' return stuff;',
899 :     ' }',
900 :     ' function JavaJump(name) {',
901 :     " var objectID = '$self->{idString}' + name;",
902 :     " ShowNewBlock($self->{javaThing}, objectID);",
903 :     ' }',
904 :     "document.write('$dwriter');",
905 :     "stuff = '$base, $dbdURL, $options';",
906 :     '</script>';
907 :     # Add the database notes below the diagram.
908 :     push @retVal, ERDB::ObjectNotes($erdb->{_metaData}, $self);
909 : parrello 1.2 # Return the result.
910 :     return join("\n", @retVal);
911 :     }
912 :    
913 :    
914 : parrello 1.1 =head2 Wiki Markup Methods
915 :    
916 :     The methods in this section create the appropriate HTML markup for ERDB
917 :     object notes. It allows this object to be used as a drop-in replacement
918 : parrello 1.5 for L<WikiTools> when using the L<ERDB> documentation methods.
919 : parrello 1.1
920 :     =head3 Heading
921 :    
922 :     my $line = $wiki->Heading($level, $text);
923 :    
924 :     Return the code for a heading line at the specified level.
925 :    
926 :     =over 4
927 :    
928 :     =item level
929 :    
930 :     Desired heading level.
931 :    
932 :     =item text
933 :    
934 :     Title for the heading's section.
935 :    
936 :     =item RETURN
937 :    
938 :     Returns a formatted heading line.
939 :    
940 :     =back
941 :    
942 :     =cut
943 :    
944 :     sub Heading {
945 :     # Get the parameters.
946 :     my ($self, $level, $text) = @_;
947 :     # Create the heading line.
948 :     my $retVal = "<h$level>$text</h$level>";
949 :     # Return the result.
950 :     return $retVal;
951 :     }
952 :    
953 :     =head3 Bold
954 :    
955 :     my $markup = $wiki->Bold($text);
956 :    
957 :     Bold the specified text.
958 :    
959 :     =cut
960 :    
961 :     sub Bold {
962 :     my ($self, $text) = @_;
963 :     return CGI::strong($text);
964 :     }
965 :    
966 :     =head3 Italic
967 :    
968 :     my $markup = $wiki->Italic($text);
969 :    
970 :     Italicize the specified text.
971 :    
972 :     =cut
973 :    
974 :     sub Italic {
975 :     my ($self, $text) = @_;
976 :     return CGI::em($text);
977 :     }
978 :    
979 :     =head3 LinkMarkup
980 :    
981 :     my $boldCode = $wiki->LinkMarkup($link, $text);
982 :    
983 :     Returns the Wiki code for a link.
984 :    
985 :     =over 4
986 :    
987 :     =item link
988 :    
989 :     URL or topic name referenced by the link.
990 :    
991 :     =item text (optional)
992 :    
993 :     Text of the link.
994 :    
995 :     =back
996 :    
997 :     =cut
998 :    
999 :     sub LinkMarkup {
1000 :     # Get the parameters.
1001 :     my ($self, $link, $text) = @_;
1002 :     # Declare the return variable.
1003 :     my $retVal;
1004 :     # Check to see if we have text. If we don't, the URL is also
1005 :     # the text.
1006 :     my $actualText = (defined $text ? $text : $link);
1007 :     # Is this an internal link?
1008 :     if ($link =~ /^#(.+)/) {
1009 :     # Yes. Use our special format.
1010 :     $retVal = $self->Linked($1, $actualText);
1011 :     } else {
1012 :     # Form a normal link.
1013 :     $retVal = CGI::a({ href => $link }, $actualText);
1014 :     }
1015 :     # Return the result.
1016 :     return $retVal;
1017 :     }
1018 :    
1019 :     =head3 Table
1020 :    
1021 :     my $wikiText = $wiki->Table(@rows);
1022 :    
1023 :     Create a Wiki table. The parameters are all list references. The first
1024 :     describes the header row, and the remaining rows are presented
1025 :     sequentially. This is a very simple table, using only default settings
1026 :     and with everything left-aligned.
1027 :    
1028 :     =over 4
1029 :    
1030 :     =item rows
1031 :    
1032 :     List of table rows. Each table row is a list reference containing the
1033 :     cells of the row in column order. The first row is used as the header.
1034 :    
1035 :     =item RETURN
1036 :    
1037 :     Returns a string that will generate a Wiki table.
1038 :    
1039 :     =back
1040 :    
1041 :     =cut
1042 :    
1043 :     sub Table {
1044 :     # Note that we treat the first row as column headers.
1045 :     my ($self, $headers, @rows) = @_;
1046 :     # Put the headers in the odd format expected by FancyTable.
1047 :     my @headList = map { (text => $_) } @$headers;
1048 :     # Format the table.
1049 : parrello 1.4 my $retVal = FancyTable(\@headList, @rows);
1050 : parrello 1.1 # Return the result.
1051 :     return $retVal;
1052 :     }
1053 :    
1054 :    
1055 :     =head3 List
1056 :    
1057 :     my $wikiText = $wiki->List(@items);
1058 :    
1059 :     Create a Wiki list. The parameters are all strings that are put into the
1060 :     list sequentially.
1061 :    
1062 :     =over 4
1063 :    
1064 :     =item items
1065 :    
1066 :     List of items to be formatted into a wiki list.
1067 :    
1068 :     =item RETURN
1069 :    
1070 :     Returns wiki markup text that will display as an unordered list.
1071 :    
1072 :     =back
1073 :    
1074 :     =cut
1075 :    
1076 :     sub List {
1077 :     # Get the parameters.
1078 :     my ($self, @items) = @_;
1079 :     # Format the list.
1080 :     my $retVal = CGI::ul(map { CGI::li($_) } @items);
1081 :     # Return the result.
1082 :     return $retVal;
1083 :     }
1084 :    
1085 :     =head3 Para
1086 :    
1087 :     my $markup = $wiki->Para($text);
1088 :    
1089 :     Create a paragraph from the specified text.
1090 :    
1091 :     =over 4
1092 :    
1093 :     =item text
1094 :    
1095 :     Text to format as a paragraph.
1096 :    
1097 :     =item RETURN
1098 :    
1099 :     Returns the text formatted as a paragraph.
1100 :    
1101 :     =back
1102 :    
1103 :     =cut
1104 :    
1105 :     sub Para {
1106 :     my ($self, $text) = @_;
1107 :     return CGI::p($text);
1108 :     }
1109 :    
1110 :     =head2 Internal Utility Methods
1111 :    
1112 :     =head3 _DivID
1113 :    
1114 :     my $id = $html->_DivID($objectName);
1115 :    
1116 :     Return the DIV identifier for the specified entity, relationship, or
1117 :     shape.
1118 :    
1119 : parrello 1.2 There is tension between this method and L</BuildDiagram>, because
1120 :     the latter method must generate javascript to turn an object name
1121 :     into an ID string.
1122 :    
1123 : parrello 1.1 =over 4
1124 :    
1125 :     =item objectName
1126 :    
1127 :     Name of the object whose DIV block identifier is desired.
1128 :    
1129 :     =item RETURN
1130 :    
1131 :     Returns the identifier for the named object's DIV block.
1132 :    
1133 :     =back
1134 :    
1135 :     =cut
1136 :    
1137 :     sub _DivID {
1138 :     # Get the parameters.
1139 :     my ($self, $objectName) = @_;
1140 :     # Declare the return variable.
1141 :     my $retVal = $self->{idString} . $objectName;
1142 :     # Return the result.
1143 :     return $retVal;
1144 :     }
1145 :    
1146 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3