1package Autodia::Handler::CSharp;
2require Exporter;
3use strict;
4
5use vars qw($VERSION @ISA @EXPORT $DEBUG $FILENAME $LINENO);
6use Autodia::Handler;
7@ISA = qw(Autodia::Handler Exporter);
8
9use Autodia::Diagram;
10
11our $PARAM_REGEX = qr/[\[\]<>\w\,\.\s\*=\"\']*/;
12our $METHOD_TYPES = qr/static|virtual|override|const|event/;
13our $PRIVACY = qr/public|private|protected/;
14our $CLASS = qr/class|interface/;
15our $TYPE = qr/[\w,<>]+/;
16
17
18#---------------------------------------------------------------
19
20#####################
21# Constructor Methods
22
23# new inherited from Autodia::Handler
24
25#------------------------------------------------------------------------
26# Access Methods
27
28# parse_file inherited from Autodia::Handler
29
30#-----------------------------------------------------------------------------
31# Internal Methods
32
33# _initialise inherited from Autodia::Handler
34
35sub debug {
36    print "$FILENAME:$LINENO - @_\n";
37}
38
39sub _parse {
40    my $self     = shift;
41    my $fh       = shift;
42    my $filename = shift;
43    $FILENAME = $filename;
44    $FILENAME =~ s{.*/}{};
45    $LINENO = 0;
46
47    my $Diagram = $self->{Diagram};
48
49    my $Class;
50
51    $self->{current_package} = $filename;
52    $self->{namespace}       = "";
53    $self->{privacy}         = 0;
54    $self->{comment}         = 0;
55    $self->{in_class}        = 0;
56    $self->{in_declaration}  = 0;
57    $self->{in_method}       = 0;
58    $self->{brace_depth}     = 0;
59
60    debug("processing file");
61
62    # parse through file looking for stuff
63    while (<$fh>) {
64      LINE: {
65            $LINENO++;
66
67            chomp( my $line = $_ );
68            last LINE if ( $self->_discard_line($line) );
69
70            # This strips out all the template spaces, which makes it easier to parse
71            while($line =~ s/(<[^>]*)\s+([^>]*>)/$1$2/g) {
72                debug("Stripping templates: $line");
73                next;
74            }
75
76            # we've entered a top level namespace
77            if ( $line =~ m/^\s*namespace\s+([\w\.]+)/ ) {
78                $self->{namespace} = $1;
79                debug("Namespace: $1");
80                last LINE;
81            }
82
83            # check for class declaration
84            if ( $line =~ m/^\s*($PRIVACY)?\s*($CLASS)\s+(\w+)/ ) {
85                my $classname = ($3) ? $3 : $2;
86
87                $self->{in_class}   = 1;
88                $self->{privacy}    = "private";
89                $self->{visibility} = 1;
90                $classname =~ s/[\{\}]//g;
91
92		last if ($self->skip($classname));
93                # we want to add on namespace
94                #if ($self->{namespace}) {
95                #    $classname = "$self->{namespace}.$classname";
96                #}
97                debug("Class: $classname");
98
99                $Class = Autodia::Diagram::Class->new($classname);
100		my $exists = $Diagram->add_class($Class);
101		$Class = $exists if ($exists);
102
103                # handle superclass(es)
104                if ( $line =~ m/^\s*($PRIVACY)?\s*($CLASS)\s+\w+\s*\:\s*(.+)\s*/ )
105                {
106                    my @superclasses = split( /\s*,\s*/, $3 );
107                    foreach my $super (@superclasses) {
108                        $super =~ s/^\s*(\w+\s+)?([A-Za-z0-9\_]+)\s*$/$2/;
109                        debug("Super Class: $super");
110                        my $Superclass =
111                          Autodia::Diagram::Superclass->new($super);
112                        my $exists_already =
113                          $Diagram->add_superclass($Superclass);
114                        if ( ref $exists_already ) {
115                            $Superclass = $exists_already;
116                        }
117                        my $Inheritance =
118                          Autodia::Diagram::Inheritance->new( $Class,
119                            $Superclass );
120                        $Superclass->add_inheritance($Inheritance);
121                        $Class->add_inheritance($Inheritance);
122                        $Diagram->add_inheritance($Inheritance);
123                    }
124                }
125                last LINE;
126            }
127
128# check for end of class declaration
129# TODO: this won't ever trigger with C#, not sure the best way to close things here.
130            if ( $self->{in_class} && ( $line =~ m|^\s*\}\;| ) ) {
131
132                #	      print "found end of class\n";
133                $self->{in_class} = 0;
134                $self->{privacy}  = 0;
135                last LINE;
136            }
137
138            # because the rest of this requires that we are in a class
139            last LINE if ( not $self->{in_class} );
140
141            if ( $line =~ m/^\s*protected\s*/ ) {
142                debug("protected variables/classes");
143                $self->{privacy}    = "protected";
144                $self->{visibility} = 2;
145                $self->_parse_private_things( $line, $Class );
146                last LINE;
147            }
148            elsif ( $line =~ m/^\s*private\s*\w*/ ) {
149                debug("private variables/classes");
150                $self->{privacy}    = "private";
151                $self->{visibility} = 1;
152
153                # check for attributes and methods
154                $self->_parse_private_things( $line, $Class );
155
156                last LINE;
157            }
158            elsif ( $line =~ m/^\s*public\s*\w*/ ) {
159                debug("public variables/classes");
160
161                #		  print "found public variables/classes\n";
162                $self->{privacy}    = "public";
163                $self->{visibility} = 0;
164                $self->_parse_private_things( $line, $Class );
165                last LINE;
166            }
167
168            # if inside a class method then discard line
169            if ( $self->{in_method} ) {
170
171              # count number of braces and increment decrement depth accordingly
172              # if depth = 0 then reset in_method and next;
173              # else next;
174                my $start_brace_cnt = $line =~ tr/{/{/;
175                my $end_brace_cnt   = $line =~ tr/}/}/;
176
177                $self->{brace_depth} =
178                  $self->{brace_depth} + $start_brace_cnt - $end_brace_cnt;
179                $self->{in_method} = $self->{brace_depth} == 0 ? 0 : 1;
180
181#		  print "In method: ",$start_brace_cnt, $end_brace_cnt, $self->{brace_depth}, $self->{in_method} ,"\n";
182                last LINE;
183            }
184
185# check for simple declarations
186# space* const? space+ (namespace::)* type space* modifier? space+ name;
187#             if ($line =~ m/^\s*\w*?\s*((\w+\s*::\s*)*\w+\s*[\*&]?)\s*(\w+)\s*\;.*$/) # Added support for pointers/refs/namespaces
188#               {
189#                   my $name = $3;
190#                   my $type = $1;
191#                   #		  print "found simple variable declaration : name = $name, type = $type\n";
192
193            #                   #my $visibility = ( $name =~ m/^\_/ ) ? 1 : 0;
194
195#                   $Class->add_attribute({
196#                                          name => $name,
197#                                          visibility => $self->{visibility}, #was: $visibility,
198#                                          type => $type,
199#                                         });
200
201            #                   last LINE;
202            #               }
203
204# # check for simple sub
205#             if ($line =~ m/^                       # start of line
206#                            \s*                      # whitespace
207#                            (\w*?\s*?(\w+\s*::\s*)*\w*?\s*[\*&]?) # type of the method: $1. Added support for namespaces
208#                            \s*                      # whitespace
209#                            (\w+)                  # name of the method: $2
210#                            \s*                      # whitespace
211#                            \(\s*                    # start of parameter list
212#                            ([:\w\,\s\*=&,<>\"]*)        # all parameters: $3
213#                            (\)?)                    # may be an ending bracket: $4
214#                            [\w\s=]*(;?)             # possibly end of signature $5
215#                            .*$/x
216#                ) {
217#                 my $name = $3;
218#                 my $type = $1 || "void";
219#                 my $params = $4;
220#                 my $end_bracket = $5;
221#                 my $end_semicolon = $6;
222
223            #                 debug("simple sub: $name");
224            #                 my $have_continuation = 0;
225            #                 my $have_end_semicolon= 0;
226
227#                 if ($name eq $Class->{"name"}) {
228#                     #		      print "found constructor declaration : name = $name\n";
229#                     $type = "";
230
231#                 } else {
232#                     #			  print "found simple function declaration : name = $name, type = $type\n";
233#                 }
234
235        #                 $have_continuation  = 1 unless $end_bracket    eq ")";
236        #                 $have_end_semicolon = 1 if     $end_semicolon  eq ";";
237
238#                 #		  print $have_continuation  ? "no ":"with " ,"end bracket : $end_bracket\n";
239#                 #		  print $have_end_semicolon ? "with ":"no " ,"end semicolon : $end_semicolon\n";
240
241            #                 $params    =~ s|\s+$||;
242            #                 my @params = split(",",$params);
243            #                 my $pc = 0;     # parameter count
244
245          #                 my %subroutine = (
246          #                                   name       => $name,
247          #                                   type       => $type,
248          #                                   visibility => $self->{visibility},
249          #                                  );
250
251#                 # If we have continuation lines for the parameters get them all
252#                 while ($have_continuation) {
253#                     my $line = <$fh>;
254#                     last unless ($line);
255#                     chomp $line;
256
257#                     if ($line =~ m/^                        # start of line
258#                                    \s*                      # whitespace
259#                                    ([:\w\,\|\s\*=&\"]*)      # all parameters: $1
260#                                    (\)?)                    # may be an ending bracket: $2
261#                                    [\w\s=]*(;?)             # possibly end of signature $3
262#                                    .*$/x) {
263#                         my $cparams     = $1;
264#                         $end_bracket    = $2;
265#                         $end_semicolon  = $3;
266
267            #                         $cparams =~ s|\s+$||;
268            #                         my @cparams = split(",",$cparams);
269            #                         push @params, @cparams;
270
271          #                         #			  print "More parameters: >$cparams<\n";
272
273   #                         $have_continuation  = 0 if ($end_bracket   eq ")");
274   #                         $have_end_semicolon = 1 if ($end_semicolon eq ";");
275
276#                         #			  print $have_continuation ? "no ":"with " ,"end bracket : $end_bracket\n";
277#                         #			  print $have_end_semicolon ? "with ":"no " ,"end semicolon : $end_semicolon\n";
278#                     }
279#                 }
280
281    #                 # then get parameters and types
282    #                 my @parameters = ();
283    #                 #		  print "All parameters: ",join(';',@params),"\n";
284    #                 foreach my $parameter (@params) {
285    #                     $parameter =~ s/const\s+//;
286    #                     $parameter =~ m/\s*((\w+::)*\w+\s*[\*|\&]?)\s*(\w+)/ ;
287    #                     my ($type, $name) = ($1,$3);
288
289            #                     $type =~ s/\s//g;
290            #                     $name =~ s/\s//g;
291
292            #                     $parameters[$pc] = {
293            #                                         Name => $name,
294            #                                         Type => $type,
295            #                                        };
296            #                     $pc++;
297            #                 }
298
299            #                 $subroutine{"Params"} = \@parameters;
300            #                 $Class->add_operation(\%subroutine);
301
302   #                 # Now finished with parameters.  If there was no end
303   #                 # semicolon we have an inline method: we read on until we
304   #                 # see the start of the method. This deals with (multi-line)
305   #                 # constructor initialization lists as well.
306   #                 last LINE if $have_end_semicolon;
307
308#                 while (defined $line and $line !~ /{/) {
309#                     $line = <$fh>;
310#                     print "$filename: waiting for start of method def: $line\n";
311#                 }
312#                 my $start_brace_cnt = $line =~ tr/{/{/ ;
313#                 my $end_brace_cnt   = $line =~ tr/}/}/ ;
314
315#                 $self->{brace_depth} = $start_brace_cnt - $end_brace_cnt;
316#                 $self->{in_method}   = 1 unless $self->{brace_depth}  == 0;
317#                 #		  print "Start: ",$start_brace_cnt, $end_brace_cnt, $self->{brace_depth}, $self->{in_method} ,"\n";
318
319            #                 last LINE;
320            #             }
321
322        # if line starts with word,space,word then its a declaration (probably)
323        # Broken.
324        #  if ($line =~ m/\s*\w+\s+(\w+\s*::\s*)*\w+/i) {
325        #                 #		  print " probably found a declaration : $line\n";
326        #                 my @words = m/^(\w+)\s*[\(\,\;].*$/g;
327        #                 my $name = $&;
328        #                 my $rest = $';  #' to placate some syntax highlighters
329        #                 my $type = '';
330
331          #                 my $pc = 0;     # point count (ie location in array)
332          #                 foreach my $start_point (@-) {
333          #                     my $start = $start_point;
334          #                     my $end = $+[$pc];
335          #                     $type .= substr($line, $start, ($end - $start));
336          #                     $pc++;
337          #                 }
338
339#                 # if next character is a ( then the line is a function declaration
340#                 if ($rest =~ m|^\((\w+)\(.*(\;?)\s*$|) {
341#                                 #		      print "probably found a function : $line \n";
342#                     my $params = $1;
343#                     my @params = split(",",$params);
344
345#                     my $declaration = 0;
346#                     if (defined $2) # if line ends with ";" then its a declaration
347#                       {
348#                           $declaration = 1;
349#                           my @parameters = ();
350#                           my $pc = 0; # parameter count
351#                           my %subroutine = (
352#                                             name       => $name,
353#                                             type       => $type,
354#                                             visibility => $self->visibility,
355#                                            );
356
357      #                           # then get parameters and types
358      #                           foreach my $parameter (@params) {
359      #                               my ($type, $name) = split(" ",$parameter);
360
361            #                               $type =~ s/\s//g;
362            #                               $name =~ s/\s//g;
363
364            #                               $parameters[$pc] = {
365            #                                                   name => $name,
366            #                                                   type => $type,
367            #                                                  };
368            #                               $pc++;
369            #                           }
370
371#                           $subroutine{param} = \@parameters;
372#                           $Class->add_operation(\%subroutine);
373#                       } else {
374#                           my @attributes = ();
375#                           # else next character is , or ;
376#                           # the line's a variable declaration
377#                           $Class->add_attribute ({
378#                                                   name       => $name,
379#                                                   type       => $type,
380#                                                   visibility => $self->{visibility},
381#                                                  });
382#                           my %attribute = { name => $name , type => $type };
383#                           $attributes[0] = \%attribute;
384#                           if ($rest =~ m/^\,.*\;/) {
385#                               my @atts = split (",");
386#                               foreach my $attribute (@atts) {
387#                                   my @attribute_parts = split(" ", $attribute);
388#                                   my $n = scalar @attribute_parts;
389#                                   my $name = $attribute_parts[$n];
390#                                   my $type = join(" ",$attribute_parts[0...$n-1]);
391#                                   $Class->add_attribute ( {
392#                                                            name       => $name,
393#                                                            type       => $type,
394#                                                            visibility => $self->{visibility},
395#                                                           });
396# 				#
397#                               }
398#                                 #
399#                           }
400#                           #
401#                       }
402#                                 #
403#                 }
404#                 #
405#             }
406#
407        }
408    }
409
410    $self->{Diagram} = $Diagram;
411    close $fh;
412    return;
413}
414
415sub _discard_line {
416    my $self    = shift;
417    my $line    = shift;
418    my $discard = 0;
419
420  SWITCH: {
421        if ( $line =~ m/^\s*$/ ) {    # if line is blank or white space discard
422            $discard = 1;
423            last SWITCH;
424        }
425
426        if ( $line =~ /^\s*\/\// ) {    # if line is a comment discard
427            $discard = 1;
428            last SWITCH;
429        }
430
431        # if line is a comment discard
432        if ( $line =~ m!^\s*/\*.*\*/! ) {
433            $discard = 1;
434            last SWITCH;
435        }
436
437        # if line starts with multiline comment syntax discard and set flag
438        if ( $line =~ /^\s*\/\*/ ) {
439            $self->{comment} = 1;
440            $discard = 1;
441            last SWITCH;
442        }
443
444        if ( $line =~ /^.*\*\/\s*$/ ) {
445            $self->{comment} = 0;
446        }
447        if ( $self->{comment} == 1 ) { # if currently inside a multiline comment
448                # if line starts with comment end syntax then unflag and discard
449            if ( $line =~ /^.*\*\/\s*$/ ) {
450                $self->{comment} = 0;
451                $discard = 1;
452                last SWITCH;
453            }
454
455            $discard = 1;
456            last SWITCH;
457        }
458    }
459    return $discard;
460}
461
462####-----
463
464sub _parse_private_things {
465    my $self  = shift;
466    my $line  = shift;
467    my $Class = shift;
468
469    return unless ( $line =~ m/^\s*($PRIVACY)\s*(\w.*)$/ );
470    my @private_things = split( ";", $2 );
471    foreach my $thing (@private_things) {
472
473# print "- private/public thing : $private_thing\n";
474# FIXME : Next line type definition seems erroneous. Any C++ hackers care to check it?
475# strip off comments
476        $thing =~ s{//.*}{};
477
478        debug("private thing = $thing");
479
480        if ( $thing =~ m/^\s*($METHOD_TYPES)?\s*($TYPE)\s+(\w+\(?$PARAM_REGEX*\)?)\s*\w*\s*\w*.*$/ )
481        {
482            my $name = $3;
483            my $type = ($1) ? "$1 $2" : "$2";
484            my $vis  = $self->{visibility};
485
486            #    print "- found declaration : name = $name, type = $type\n";
487            debug("private - name = $name, type = $type");
488            if ( $name =~ /\(/ ) {
489                debug("declaration is a method");
490
491                #      print "-- declaration is a method \n";
492                # check for simple sub
493                if ( $name =~ /^\s*(\w+)\s*\(\s*($PARAM_REGEX*)(\)?)/ ) {
494                    $name = $1;
495                    my $params      = $2;
496                    my $end_bracket = $3;
497
498                    my $have_continuation  = 0;
499                    my $have_end_semicolon = 1;
500
501                    $params =~ s|\s+$||;
502                    my @params = split( ",", $params );
503                    my $pc = 0;    # parameter count
504
505                    my %subroutine = (
506                        name       => $name,
507                        type       => $type,
508                        visibility => $self->{visibility},
509                    );
510
511                    # then get parameters and types
512                    my @parameters = ();
513                    debug( "All parameters: ", join( ';', @params ) );
514                    foreach my $parameter (@params) {
515                        $parameter =~ s/const\s+//;
516
517                        my ( $type, $name ) = split( " ", $parameter );
518
519                        $type =~ s/\s//g;
520                        $name =~ s/\s//g;
521
522                        $parameters[$pc] = {
523                            name => $name,
524                            type => $type,
525                        };
526                        $pc++;
527                    }
528
529                    $subroutine{param} = \@parameters;
530                    $Class->add_operation( \%subroutine );
531                }
532            }
533            else {
534                debug("attribute: $name - $type");
535
536                #     print "-- declaration is an attribute \n";
537                $Class->add_attribute(
538                    {
539                        name       => $name,
540                        visibility => $vis,
541                        type       => $type,
542                    }
543                );
544            }
545        }
546    }
547
548}
549
550sub _is_package {
551    my $self    = shift;
552    my $package = shift;
553    my $Diagram = $self->{Diagram};
554
555    unless ( ref $$package ) {
556        my $filename = shift;
557
558        # create new class with name
559        $$package = Autodia::Diagram::Class->new($filename);
560
561        # add class to diagram
562        $Diagram->add_class($$package);
563    }
564
565    return;
566}
567
568
569###############################################################################
570
571=head1 NAME
572
573Autodia::Handler::CSharp - AutoDia handler for C#
574
575=head1 INTRODUCTION
576
577This module parses files into a Diagram Object, which all handlers use. The role of the handler is to parse through the file extracting information such as Class names, attributes, methods and properties.
578
579=head1 CONSTRUCTION METHOD
580
581use Autodia::Handler::CSharp;
582
583my $handler = Autodia::Handler::CSharp->New(\%Config);
584
585This creates a new handler using the Configuration hash to provide rules selected at the command line.
586
587=head1 ACCESS METHODS
588
589This parses the named file and returns 1 if successful or 0 if the file could not be opened.
590
591$handler->output_xml(); # interpolates values into an xml or html template
592
593$handler->output_graphviz(); # generates a gif file via graphviz
594
595=head1 AUTHOR
596
597Sean Dague <sean@dague.net>
598
599=head1 MAINTAINER
600
601Aaron Trevena
602
603=head1 COPYRIGHT
604
605Copyright 2007 Sean Dague
606Copyright 2001 - 2006 Aaron Trevena
607
608=cut
609
6101;
611