File Coverage

blib/lib/UML/Sequence/SimpleSeq.pm
Criterion Covered Total %
statement 51 55 92.7
branch 16 30 53.3
condition 2 3 66.6
subroutine 5 5 100.0
pod 0 3 0.0
total 74 96 77.0


line stmt bran cond sub pod time code
1             package UML::Sequence::SimpleSeq;
2 7     7   159176 use strict;
  7         20  
  7         249  
3 7     7   39 use warnings;
  7         12  
  7         7003  
4              
5             our $VERSION = '0.02';
6              
7             =head1 NAME
8              
9             UML::Sequence::SimpleSeq - turns simple outlines (see below) into UML sequence diagrams
10              
11             =head1 SYNOPSIS
12              
13             genericseq.pl UML::Sequence::SimpleSeq outline_file > sequence.xml
14             seq2svg.pl sequence.xml > sequence.svg
15              
16             OR
17              
18             genericseq.pl UML::Sequence::SimpleSeq outline_file | seq2svg.pl > sequence.svg
19              
20             OR
21              
22             genericseq.pl UML::Sequence::SimpleSeq outline_file | seq2rast.pl > sequence.png
23              
24             =head1 DESCRIPTION
25              
26             This file may be used directly by a script (as shown above) or as a base class
27             for other sequencers (see UML::Sequence::JavaSeq). It supplies routines for
28             handling simple outlines like a user could be expected to type by hand. Such
29             outlines look like this:
30              
31             At Home.Wash Car
32             /*
33             this is an annotation
34             the next line shows how to specify return values
35             */
36             Garage.retrieve bucket -> bucket
37             Kitchen.prepare bucket
38             Kitchen.pour soap in bucket
39             Kitchen.fill bucket
40             Garage.get sponge -> sponge
41             /*
42             the next line specifies an external async event
43             */
44             -> clickerSignal
45             /*
46             the next line specifies a conditional, urgent method call
47             */
48             [garageDoorClosed] ! Garage.open door
49             /*
50             the next line specifies an iterative method call
51             */
52             * Driveway.apply soapy water
53             Driveway.rinse
54             Driveway.empty bucket
55             -> clickerSignal
56             Garage.close door
57             Garage.replace sponge
58             /*
59             the next line specifies a class/static method call
60             */
61             Garage::replace bucket
62              
63             The "class" name and "method" name are separated by a dot. If there are
64             multiple dots, the method name is everything after the last dot. Classes
65             and methods in this context are elements of a UML sequence diagram. Classes
66             get boxes at the top of the page. Method calls are labeled lines from one
67             class to another. If you want two classes with the same name, you must
68             append a suffix or prefix (try instanceName:ClassName).
69              
70             Static (aka class) methods are assumed if there is not dot separator, but
71             only double colon '::' separators, in which case the last text segment
72             preceded by '::' is assumed to be the method name, and is displayed
73             in italics in the output.
74              
75             Return values may be specified by the '->' marker; everything to the
76             right of the marker will be used as a label on a dashed line returning from
77             the called object back to the caller object.
78              
79             External events can be indicated by the '->' marker without any preceding
80             object/method name. These are rendered as lines originating
81             from the far right of the image, terminated by a half-arrow, with text to the
82             right of the marker displayed as the label on a line.
83              
84             Iterations are denoted by an introductory asterisk '*', which is preserved
85             in the output label. Conditional statements can be added by introducing
86             an entry with text enclosed by brackets '[]'.
87              
88             For L applications, urgent methods are introduced
89             by an exclamation point '!', which is preserved in the output text label.
90              
91             Annotations may be specified using C style comment delimiters,
92             '/* */'. Everything between the delimiters will be tagged as annotation on the next
93             directive line, which the renderer may convert to e.g., tooltips
94             or text in a margin. NOTE: no escape is provided for closing delimiters
95             within an annotation.
96              
97             Finally, in order to properly position return values for nested
98             method calls, whitespace characters (tabs, spaces) are used to delimit
99             the scope of nested method calls.
100              
101             =head1 grab_outline_text
102              
103             Call this first with the outline file (in the format described above).
104             Pass it the name of the file to read.
105             Returns a reference to an array whose elements are lines from the outline
106             with spacing preserved.
107              
108             =cut
109              
110             sub grab_outline_text {
111 6     6 0 73 shift; # discard class
112 6         16 my $file = shift;
113 6         13 my @outline;
114 6         13 my $in_annot = undef;
115 6         13 my $annot = '';
116              
117 6 50       286 open FILE, "$file" or die "Couldn't open $file\n";
118 6         176 while () {
119             #
120             # aggregate annotations into a single line
121             # NOTE: execution order is important to support single line annotations
122             # NOTE2: trim leading tabs/spaces
123             #
124 87         102 chomp;
125              
126 87 100 66     609 push(@outline, "$_ $annot"),
127             $annot = '',
128             next
129             unless $in_annot || /^\s*\/\*/;
130             #
131             # in annotation, trim leading and trailing whitespace
132             #
133 3         18 s/^\s+//;
134 3         15 s/\s+$//;
135 3 50       24 if ($in_annot) {
    50          
136 0         0 $annot .= ' ' . $_;
137             }
138             elsif (/^\s*\/\*/) {
139 3         8 $annot = $_;
140 3         7 $in_annot = 1;
141             }
142              
143             $in_annot = undef
144 3 50       22 if /\*\/\s*$/;
145             }
146 6         64 close FILE;
147              
148             #print STDERR "\n\n", join("\n", @outline), "\n";
149              
150 6         27 return \@outline;
151             }
152              
153             =head1 grab_methods
154              
155             Call this with an outline (possibly generated by grab_outline). It will return
156             a hash reference. Each method mentioned in the outline will appear as a key
157             in the hash (the values are less important, they count the occurances of
158             the method).
159              
160             =cut
161              
162             sub grab_methods {
163 16     16 0 1040 shift; # discard class
164 16         25 my $outline = shift;
165 16         20 my %methods;
166              
167 16         41 foreach (@$outline) {
168 84         180 my $line = $_;
169 84         248 $line =~ s/^\s+//; # trim leading space
170              
171             # trim annotations
172 84         140 $line=~s/\s*\/\*.*\*\/\s*$//;
173              
174 84 50       256 next if ($line=~/^\s*$/);
175              
176 84         104 $line =~ s/^[^:]+://; # trim class info
177              
178             # trim leading iterator, conditionals, or urgents
179 84         704 $line =~ s/^(((\[[^\]]+\])|[\*!])\s*)+//;
180             #
181             # trim any following returnvalue list
182             #
183 84         629 $line =~ s/\s*->.*$//;
184 84 100       159 $line = 'EXTERNAL' if ($line eq '');
185 84         1272 $methods{$line}++;
186             }
187 16         80 return \%methods;
188             }
189              
190             =head1 parse_signature
191              
192             This method is a call back used by the UML::Sequence constructor. It accepts
193             a signature and returns the "class" name (in scalar context) or, in list context,
194             the "class", "method", "returnvalue", iterator, urgent, conditional, indicators,
195             and any annotation. It splits the signature on the
196             last dot it sees after removing any argument list and associated parentheses.
197             It also looks for the '->' marker in order to collect a return values list.
198             NOTE: BE SURE TO PRESERVE INTRO WHITESPACE FOR NESTED METHOD SCOPING!!
199              
200             =cut
201              
202             sub parse_signature {
203 29     29 0 63 chomp(my $line = shift);
204             #
205             # external event: add External class to list, and collect
206             # rest of the line as event label
207             #
208             #print STDERR $line, "\n";
209 29 0       74 return wantarray ? ('_EXTERNAL', $1) : '_EXTERNAL'
    50          
210             if ($line=~/^\s*->\s*(.+)$/);
211              
212 29         30 my ($iterator, $conditional, $urgent, $annot);
213              
214 29 50       72 $annot = $1
215             if ($line =~ s/\s*\/\*\s*(.*)\s*\*\/\s*$//);
216              
217 29         104 while ($line =~ s/^((\[[^\]]+\])|[\*!])\s*//) {
218 0 0       0 $iterator = '*', next
219             if ($1 eq '*');
220 0 0       0 $urgent = '!', next
221             if ($1 eq '!');
222 0         0 $conditional = $1;
223             }
224              
225 29         39 $line =~ s/\(.*\)//; # rely on greedy eval...tho I may decide to include the args
226              
227 29         30 my $returns;
228              
229 29 50       66 $returns = $1
230             if ($line=~s/->\s*(.*)$//);
231              
232 29         115 $line =~ s/[\.:]([^\.:]*)\s*$//;
233              
234 29         64 my $method = $1;
235 29 100       67 if (defined $method) {
236 28         86 $method =~ s/
237 28         40 $method =~ s/>/>/g;
238             }
239             return wantarray ?
240 29 100       146 ($line, $method, $returns, $iterator, $urgent, $conditional, $annot) :
241             $line;
242             }
243              
244             1;
245              
246             =head1 AUTHORS
247              
248             Original versions by Phil Crow,
249             Version 0.02 by Dean Arnold,
250              
251             =head1 COPYRIGHT
252              
253             Copyright 2003-2006, Philip Crow, all rights reserved.
254              
255             You may modify and/or redistribute this code in the same manner as Perl itself.
256              
257             =cut