#!/usr/bin/perl # KDOC -- C++ and CORBA IDL interface documentation tool. # Sirtaj Singh Kang , Jan 1999. # $Id$ # All files in this project are distributed under the GNU General # Public License. This is Free Software. require 5.000; use Carp; use Getopt::Long; use File::Basename; use strict; # allow to use local modules use lib dirname (__FILE__); use Ast; use kdocUtil; use kdocAstUtil; use kdocParseDoc; use vars qw/ %rootNodes $declNodeType @includes_list %options @formats_wanted $allow_k_dcop_accessors @includeclasses $includeclasses $skipInternal %defines $defines $match_qt_defines $libdir $libname $outputdir @libs $parse_global_space $qt_embedded $qt4 $striphpath $doPrivate $readstdin $Version $quiet $debug $debuggen $parseonly $currentfile $cSourceNode $exe %formats %flagnames @allowed_k_dcop_accesors $allowed_k_dcop_accesors_re $rootNode @classStack $cNode $globalSpaceClassName $lastLine $docNode @includes $cpp $defcppcmd $cppcmd $docincluded $inExtern $inNamespace %stats %definitions @inputqueue @codeqobject @qt4_codeqobject @qte_codeqobject /; ## globals %rootNodes = (); # root nodes for each file type $declNodeType = undef; # last declaration type @includes_list = (); # list of files included from the parsed .h # All options %options = (); # hash of options (set getopt below) @formats_wanted = (); $libdir = $ENV{KDOCLIBS}; $libname = ""; $outputdir = "."; @libs = (); # list of includes $striphpath = 0; @includeclasses = (); # names of classes to include $includeclasses = ""; $doPrivate = 0; $Version = "0.9"; $quiet = 0; $debug = 0; $debuggen = 0; $parseonly = 0; $globalSpaceClassName = "TQGlobalSpace"; $currentfile = ""; $cpp = 0; $defcppcmd = "g++ -Wp,-C -E"; $cppcmd = ""; $exe = basename $0; @inputqueue = (); @codeqobject = split "\n", < "kalyptusCxxToJava", "jni" => "kalyptusCxxToJNI", "dcopidl" => "kalyptusCxxToDcopIDL", "smoke" => "kalyptusCxxToSmoke", "csharp" => "kalyptusCxxToCSharp", "kimono" => "kalyptusCxxToKimono", "ECMA" => "kalyptusCxxToECMA", "swig" => "kalyptusCxxToSwig", "KDOMECMA" => "kalyptusKDOMEcma"); # these are for expansion of method flags %flagnames = ( v => 'virtual', 's' => 'static', p => 'pure', c => 'const', l => 'slot', i => 'inline', n => 'signal', d => 'k_dcop', z => 'k_dcop_signals', y => 'k_dcop_hidden' ); @allowed_k_dcop_accesors = qw(k_dcop k_dcop_hidden k_dcop_signals); $allowed_k_dcop_accesors_re = join("|", @allowed_k_dcop_accesors); %definitions = { _STYLE_CDE => '', _STYLE_MOTIF => '', _STYLE_MOTIF_PLUS => '', PLUS => '', _STYLE_PLATINUM => '', _STYLE_SGI => '', _STYLE_WINDOWS => '', QT_STATIC_CONST => 'static const', Q_EXPORT => '', Q_EXPORT_CODECS_BIG5 => '', Q_REFCOUNT => '', TQM_EXPORT_CANVAS => '', TQM_EXPORT_DNS => '', TQM_EXPORT_ICONVIEW => '', TQM_EXPORT_NETWORK => '', TQM_EXPORT_SQL => '', TQM_EXPORT_WORKSPACE => '', TQT_NO_REMOTE => 'TQT_NO_REMOTE', QT_ACCESSIBILITY_SUPPORT => 'QT_ACCESSIBILITY_SUPPORT', Q_WS_X11 => 'Q_WS_X11', TQ_DISABLE_COPY => 'TQ_DISABLE_COPY', Q_WS_QWS => 'undef', Q_WS_MAC => 'undef', Q_OBJECT => <<'CODE', public: virtual TQMetaObject *metaObject() const; virtual const char *className() const; virtual bool tqt_invoke( int, TQUObject* ); virtual bool tqt_emit( int, TQUObject* ); static TQString tr( const char *, const char * = 0 ); static TQString trUtf8( const char *, const char * = 0 ); private: CODE }; =head1 KDOC -- Source documentation tool Sirtaj Singh Kang , Dec 1998. =cut # read options Getopt::Long::config qw( no_ignore_case permute bundling auto_abbrev ); GetOptions( \%options, "format|f=s", \@formats_wanted, "url|u=s", "skip-internal", \$skipInternal, "skip-deprecated|e", "document-all|a", "compress|z", "no-cache", # do not create $HOME/.kalyptus cache # HTML options "html-cols=i", "html-logo=s", "strip-h-path", \$striphpath, "outputdir|d=s", \$outputdir, "stdin|i", \$readstdin, "name|n=s", \$libname, "help|h", \&show_usage, "version|v|V", \&show_version, "private|p", \$doPrivate, "libdir|L=s", \$libdir, "xref|l=s", \@libs, "classes|c=s", \@includeclasses, "globspace", \$parse_global_space, "qte", \$qt_embedded, "qt4", \$qt4, "allow_k_dcop_accessors", \$allow_k_dcop_accessors, "cpp|P", \$cpp, "docincluded", \$docincluded, "cppcmd|C=s", \$cppcmd, "includedir|I=s", \@includes, "define=s", \%defines, # define a single preprocessing symbol "defines=s", \$defines, # file containing preprocessing symbols, one per line "quiet|q", \$quiet, "debug|D", \$debug, # debug the parsing "debuggen", \$debuggen, # debug the file generation "parse-only", \$parseonly ) || exit 1; $| = 1 if $debug or $debuggen; # preprocessor settings if ( $cppcmd eq "" ) { $cppcmd = $defcppcmd; } else { $cpp = 1; } if ($#includeclasses>=0) { $includeclasses = join (" ", @includeclasses); print "Using Classes: $includeclasses\n" unless $quiet; } if ( $#includes >= 0 && !$cpp ) { die "$exe: --includedir requires --cpp\n"; } # Check output formats. HTML is the default if( $#formats_wanted < 0 ) { push @formats_wanted, "java"; } foreach my $format ( @formats_wanted ) { die "$exe: unsupported format '$format'.\n" if !defined $formats{$format}; } if( $defines ) { open( DEFS, $defines ) or die "Couldn't open $defines: $!\n"; my @defs = ; chomp @defs; close DEFS; foreach (@defs) { $defines{ $_ } = 1 unless exists $defines{ $_ }; } } # Check the %defines hash for QT_* symbols and compile the corresponding RE # Otherwise, compile the default ones. Used for filtering in readCxxLine. if ( my @qt_defines = map { ($_=~m/^QT_(.*)/)[0] } keys %defines) { my $regexp = "m/^#\\s*ifn?def\\s+QT_(?:" . join('|', map { "\$qt_defines[$_]" } 0..$#qt_defines).")/o"; $match_qt_defines = eval "sub { my \$s=shift; \$s=~/^#\\s*if(n)?def\\s+QT_/ || return 0; if(!\$1) { return \$s=~$regexp ? 0:1 } else { return \$s=~$regexp ? 1:0 } }"; die if $@; } else { $match_qt_defines = eval q{ sub { my $s = shift; $s =~ m/^\#\s*ifndef\s+TQT_NO_(?:REMOTE| # not in the default compile options NIS| # ... XINERAMA| IMAGEIO_(?:MNG|JPEG)| STYLE_(?:MAC|INTERLACE|COMPACT) )/x; } }; die if $@; } # Check if there any files to process. # We do it here to prevent the libraries being loaded up first. checkFileArgs(); # work out libdir. This is created by kdocLib:writeDoc when # required. $libdir = $ENV{HOME}."/.kalyptus" unless $libdir ne ""; ###### ###### main program ###### readLibraries(); parseFiles(); if ( $parseonly ) { print "\n\tParse Tree\n\t------------\n\n"; kdocAstUtil::dumpAst( $rootNode ); } else { writeDocumentation(); writeLibrary() unless $libname eq ""; } kdocAstUtil::printDebugStats() if $debug; exit 0; ###### sub checkFileArgs { return unless $#ARGV < 0; die "$exe: no input files.\n" unless $readstdin; # read filenames from standard input while () { chop; $_ =~ s,\\,/,g; # back to fwd slash (for Windows) foreach my $file ( split( /\s+/, $_ ) ) { push @ARGV, $file; } } } sub readLibraries { return if $#libs < 0; require kdocLib; foreach my $lib ( @libs ) { print "$exe: reading lib: $lib\n" unless $quiet; my $relpath = exists $options{url} ? $options{url} : $outputdir; kdocLib::readLibrary( \&getRoot, $lib, $libdir, $relpath ); } } sub parseFiles { foreach $currentfile ( @ARGV ) { my $lang = "CXX"; if ( $currentfile =~ /\.idl\s*$/ ) { # IDL file $lang = "IDL"; } # assume cxx file if( $cpp ) { # pass through preprocessor my $cmd = $cppcmd; foreach my $dir ( @includes ) { $cmd .= " -I $dir "; } $cmd .= " -DTQOBJECTDEFS_H $currentfile"; open( INPUT, "$cmd |" ) || croak "Can't preprocess $currentfile"; } else { open( INPUT, "tqt-replace-stream $currentfile |" ) || croak "Can't read from $currentfile"; } print STDERR "$exe: processing $currentfile\n" unless $quiet; # reset vars $rootNode = getRoot( $lang ); # add to file lookup table my $showname = $striphpath ? basename( $currentfile ) : $currentfile; $cSourceNode = Ast::New( $showname ); $cSourceNode->AddProp( "NodeType", "source" ); $cSourceNode->AddProp( "Path", $currentfile ); $rootNode->AddPropList( "Sources", $cSourceNode ); # reset state @classStack = (); $cNode = $rootNode; $inExtern = 0; $inNamespace = 0; # parse my $k = undef; while ( defined ($k = readDecl()) ) { print "\nDecl: <$k>[$declNodeType]\n" if $debug; if( identifyDecl( $k ) && $k =~ /{/ ) { readCxxCodeBlock(); } } close INPUT; } } sub writeDocumentation { foreach my $node ( values %rootNodes ) { # postprocess kdocAstUtil::linkNamespaces( $node ); kdocAstUtil::makeInherit( $node, $node ); kdocAstUtil::linkReferences( $node, $node ); kdocAstUtil::calcStats( \%stats, $node, $node ); # write no strict "refs"; foreach my $format ( @formats_wanted ) { my $pack = $formats{ $format }; require $pack.".pm"; print STDERR "Generating bindings for $format ", "language...\n" unless $quiet; my $f = "$pack\::writeDoc"; &$f( $libname, $node, $outputdir, \%options ); } } } sub writeLibrary { if( $libname ne "" and !exists $options{'no-cache'} ) { require kdocLib; foreach my $lang ( keys %rootNodes ) { my $node = $rootNodes{ $lang }; kdocLib::writeDoc( $libname, $node, $lang, $libdir, $outputdir, $options{url}, exists $options{compress} ? 1 : 0 ); } } } ###### Parser routines =head2 readSourceLine Returns a raw line read from the current input file. This is used by routines outside main, since I don t know how to share fds. =cut sub readSourceLine { return ; } =head2 readCxxLine Reads a C++ source line, skipping comments, blank lines, preprocessor tokens and the Q_OBJECT macro =cut sub readCxxLine { my( $p ); my( $l ); while( 1 ) { $p = shift @inputqueue || ; return undef if !defined ($p); $p =~ s#//.*$##g; # C++ comment $p =~ s#/\*(?!\*).*?\*/##g; # C comment # join all multiline comments if( $p =~ m#/\*(?!\*)#s ) { # unterminated comment LOOP: while( defined ($l = ) ) { $l =~ s#//.*$##g; # C++ comment $p .= $l; $p =~ s#/\*(?!\*).*?\*/##sg; # C comment last LOOP unless $p =~ m#(/\*(?!\*))|(\*/)#sg; } } if ( $p =~ /^\s*Q_OBJECT/ ) { if ($qt_embedded) { push @inputqueue, @qte_codeqobject; } elsif ($qt4) { push @inputqueue, @qt4_codeqobject; } else { push @inputqueue, @codeqobject; } next; } # Hack, waiting for real handling of preprocessor defines $p =~ s/QT_MODULE\(\w+\)//; $p =~ s/QT_STATIC_CONST/static const/; $p =~ s/QT_WEAK_SYMBOL//; $p =~ s/QT_MOC_COMPAT//; $p =~ s/Q_EXPORT_CODECS_BIG5//; $p =~ s/QT_COMPAT / /; $p =~ s/TQ_DISABLE_COPY\((\w+)\)/$1(const $1 &);\n$1 &operator=(const $1 &);/; $p =~ s/TQWIDGETSIZE_MAX/32767/; # Qt/E uses this #define as an enum value - yuck! $p =~ s/Q_SIGNALS/signals/; $p =~ s/ASYNC/void/; $p =~ s/[A-Z_]*_EXPORT_DEPRECATED//; $p =~ s/[A-Z_]*_EXPORT\s/ /; $p =~ s/EXPORT_DOCKCLASS//; $p =~ s/DLL_IMP_EXP_KMDICLASS//; $p =~ s/KSVG_GET/KJS::Value get();/; $p =~ s/KSVG_BASECLASS_GET/KJS::Value get();/; $p =~ s/KSVG_BRIDGE/KJS::ObjectImp *bridge();/; $p =~ s/KSVG_FORWARDGET/KJS::Value getforward();/; $p =~ s/KSVG_PUT/bool put();/; $p =~ s/KSVG_FORWARDPUT/bool putforward();/; $p =~ s/KSVG_BASECLASS/virtual KJS::Value cache();/; if ( $p =~ m/KSVG_DEFINE_PROTOTYPE\((\w+)\)/ ) { push @inputqueue, split('\n',"namespace KSVG {\nclass $1 {\n};\n};"); } # Bother the same again for KDOM :/ $p =~ s/KDOM_GET/KJS::Value get();/; $p =~ s/KDOM_BASECLASS_GET/KJS::Value get();/; $p =~ s/KDOM_FORWARDGET/KJS::Value getforward();/; $p =~ s/KDOM_PUT/bool put();/; $p =~ s/KDOM_FORWARDPUT/bool putforward();/; $p =~ s/KDOM_BASECLASS/virtual KJS::Value cache();/; $p =~ s/KDOM_CAST/KJS::Value cast();/; if ( $p =~ m/KDOM_DEFINE_PROTOTYPE\((\w+)\)/ ) { push @inputqueue, split('\n',"namespace KDOM {\nclass $1 {\n};\n};"); } next if ( $p =~ /^\s*$/s ); # blank lines # || $p =~ /^\s*Q_OBJECT/ # TQObject macro # ); # next if ( $p =~ /^\s*TQ_ENUMS/ # ignore TQ_ENUMS || $p =~ /^\s*TQ_OBJECT/ # and TQ_OBJECT || $p =~ /^\s*Q_FLAGS/ # and Q_FLAGS || $p =~ /^\s*Q_DECLARE_FLAGS/ # and Q_DECLARE_FLAGS || ( !$qt4 && $p =~ /^\s*TQ_PROPERTY/ ) # and TQ_PROPERTY || $p =~ /^\s*TQDOC_PROPERTY/ || $p =~ /^\s*Q_GADGET/ || $p =~ /^\s*TQ_OVERRIDE/ # and TQ_OVERRIDE || $p =~ /^\s*TQ_SETS/ || $p =~ /^\s*Q_DUMMY_COMPARISON_OPERATOR/ || $p =~ /^\s*K_SYCOCATYPE/ # and K_SYCOCA stuff || $p =~ /^\s*K_SYCOCAFACTORY/ # || $p =~ /^\s*KSVG_/ # and KSVG stuff ;) || $p =~ /^\s*KDOM_/ # and KDOM stuff :( || $p =~ /^\s*Q_DECLARE_FLAGS/ || $p =~ /^\s*Q_DECLARE_OPERATORS_FOR_FLAGS/ || $p =~ /^\s*Q_DECLARE_PRIVATE/ || $p =~ /^\s*Q_DECLARE_TYPEINFO/ || $p =~ /^\s*Q_PRIVATE_SLOT/ || $p =~ /^\s*Q_DECLARE_SHARED/ ); push @includes_list, $1 if $p =~ /^#include\s+?\s*$/; # remove all preprocessor macros if( $p =~ /^\s*#\s*(\w+)/ ) { # Handling of preprocessed sources: skip anything included from # other files, unless --docincluded was passed. if (!$docincluded && $p =~ /^\s*#\s*[0-9]+\s*\".*$/ && not($p =~ /\"$currentfile\"/)) { # include file markers while( ) { last if(/\"$currentfile\"/); print "Overread $_" if $debug; }; print "Cont: $_" if $debug; } else { # Skip platform-specific stuff, or #if 0 stuff # or #else of something we parsed (e.g. for TQKeySequence) if ( $p =~ m/^#\s*ifdef\s*Q_WS_/ or $p =~ m/^#\s*if\s+defined\(Q_WS_/ or ($p =~ m/^#\s*ifdef\s+_WS_QWS_/ and $qt_embedded) or ($p =~ m/^#\s*ifndef\s+TQT_NO_MIMECLIPBOARD/ and $qt_embedded) or ($p =~ m/^#\s*if\s+defined\(_WS_X11_/ and $qt_embedded) or ($p =~ m/^#\s*if\s+defined\(Q_WS_X11_/ and $qt_embedded) or ($p =~ m/^#\s*if\s+defined\(Q_WS_WIN_/ and $qt_embedded) or ($p =~ m/^#\s*if\s+defined\(_WS_MAC_/ and $qt_embedded) or ($p =~ m/^#\s*if\s+defined\(Q_INCOMPATIBLE_3_0_ADDONS/ and $qt_embedded) or $p =~ m/^#\s*ifndef\s+TQT_NO_STL/ or $p =~ m/^#\s*if\s+defined\s*\(Q_OS_/ or $p =~ m/^#\s*if\s+defined\(Q_CC_/ or $p =~ m/^#\s*if\s+defined\(TQT_THREAD_SUPPORT/ or $p =~ m/^#\s*else/ or $p =~ m/^#\s*if\s+defined\(Q_FULL_TEMPLATE_INSTANTIATION/ or $p =~ m/^#\s*ifdef\s+QT_WORKSPACE_WINDOWMODE/ or $p =~ m/^#\s*ifdef\s+QT_COMPAT/ or $p =~ m/^#\s*if\s+defined\s*\(?QT_COMPAT/ or $p =~ m/^#\s*ifdef\s+CONTAINER_CUSTOM_WIDGETS/ or $p =~ m/^#\s*ifdef\s+QT3_SUPPORT/ or $p =~ m/^#\s*ifdef\s+Q_MOC_RUN/ or $p =~ m/^#\s*if\s+defined\s*\(QT3_SUPPORT/ or $p =~ m/^#\s*if\s+defined\s*\(qdoc/ or $p =~ m/^#\s*ifndef\s+TQT_NO_MEMBER_TEMPLATES/ or $p =~ m/^#if\s*!defined\(Q_NO_USING_KEYWORD\)/ or &$match_qt_defines( $p ) or $p =~ m/^#\s*if\s+0\s+/ ) { my $if_depth = 1; while ( defined $p && $if_depth > 0 ) { $p = ; last if !defined $p; $if_depth++ if $p =~ m/^#\s*if/; $if_depth-- if $p =~ m/^#\s*endif/; # Exit at #else in the #ifdef TQT_NO_ACCEL/#else/#endif case last if $if_depth == 1 && $p =~ m/^#\s*else\s/; #ignore elif for now print "Skipping ifdef'ed line: $p" if $debug; } } # multiline macros while ( defined $p && $p =~ m#\\\s*$# ) { $p = ; } } next; } $lastLine = $p; return $p; } } =head2 readCxxCodeBlock Reads a C++ code block (recursive curlies), returning the last line or undef on error. Parameters: none =cut sub readCxxCodeBlock { # Code: begins in a {, ends in }\s*;? # In between: cxx source, including {} my ( $count ) = 0; my $l = undef; if ( defined $lastLine ) { print "lastLine: '$lastLine'" if $debug; my $open = kdocUtil::countReg( $lastLine, "{" ); my $close = kdocUtil::countReg( $lastLine, "}" ); $count = $open - $close; return $lastLine if ( $open || $close) && $count == 0; } # find opening brace if ( $count == 0 ) { while( $count == 0 ) { $l = readCxxLine(); return undef if !defined $l; $l =~ s/\\.//g; $l =~ s/'.?'//g; $l =~ s/".*?"//g; $count += kdocUtil::countReg( $l, "{" ); print "c ", $count, " at '$l'" if $debug; } $count -= kdocUtil::countReg( $l, "}" ); } # find associated closing brace while ( $count > 0 ) { $l = readCxxLine(); croak "Confused by unmatched braces" if !defined $l; $l =~ s/\\.//g; $l =~ s/'.?'//g; $l =~ s/".*?"//g; my $add = kdocUtil::countReg( $l, "{" ); my $sub = kdocUtil::countReg( $l, "}" ); $count += $add - $sub; print "o ", $add, " c ", $sub, " at '$l'" if $debug; } undef $lastLine; return $l; } =head2 readDecl Returns a declaration and sets the $declNodeType variable. A decl starts with a type or keyword and ends with [{};] The entire decl is returned in a single line, sans newlines. declNodeType values: undef for error, "a" for access specifier, "c" for doc comment, "d" for other decls. readCxxLine is used to read the declaration. =cut sub readDecl { undef $declNodeType; my $l = readCxxLine(); my ( $decl ) = ""; my $allowed_accesors = "private|public|protected|signals"; $allowed_accesors .= "|$allowed_k_dcop_accesors_re" if $allow_k_dcop_accessors; if( !defined $l ) { return undef; } elsif ( $l =~ /^\s*($allowed_accesors) (\s+\w+)?\s*:/x) { # access specifier $declNodeType = "a"; return $l; } elsif ( $l =~ /K_DCOP/ ) { $declNodeType = "k"; return $l; } elsif ( $l =~ m#^\s*/\*\*# ) { # doc comment $declNodeType = "c"; return $l; } elsif ( $l =~ /TQ_PROPERTY/ ) { # property return $l; } do { $decl .= $l; if ( $l =~ /[{};]/ ) { $decl =~ s/\n/ /gs; $declNodeType = "d"; return $decl; } return undef if !defined ($l = readCxxLine()); } while ( 1 ); } #### AST Generator Routines =head2 getRoot Return a root node for the given type of input file. =cut sub getRoot { my $type = shift; carp "getRoot called without type" unless defined $type; if ( !exists $rootNodes{ $type } ) { my $node = Ast::New( "Global" ); # parent of all nodes $node->AddProp( "NodeType", "root" ); $node->AddProp( "RootType", $type ); $node->AddProp( "Compound", 1 ); $node->AddProp( "KidAccess", "public" ); $rootNodes{ $type } = $node; } print "getRoot: call for $type\n" if $debug; return $rootNodes{ $type }; } =head2 identifyDecl Parameters: decl Identifies a declaration returned by readDecl. If a code block needs to be skipped, this subroutine returns a 1, or 0 otherwise. =cut sub identifyDecl { my( $decl ) = @_; my $newNode = undef; my $skipBlock = 0; my $isDeprecated = 0; if ( $decl =~ s/KDE_DEPRECATED// ) { $isDeprecated = 1; } # Doc comment if ( $declNodeType eq "c" ) { $docNode = kdocParseDoc::newDocComment( $decl ); # if it's the main doc, it is attached to the root node if ( defined $docNode->{LibDoc} ) { kdocParseDoc::attachDoc( $rootNode, $docNode, $rootNode ); undef $docNode; } } elsif ( $declNodeType eq "a" ) { newAccess( $decl ); } elsif ( $declNodeType eq "k" ) { $cNode->AddProp( "DcopExported", 1 ); } # properties elsif ( $decl =~ s/TQ_PROPERTY// ) { print "Property: <$1>\n" if $debug; $newNode = newProperty( $decl ); } # Typedef struct/class elsif ( $decl =~ /^\s*typedef \s+(struct|union|class|enum) \s*([_\w\:]*) \s*([;{]) /xs ) { my ($type, $name, $endtag, $rest ) = ($1, $2, $3, $' ); $name = "--" if $name eq ""; warn "typedef '$type' n:'$name'\n" if $debug; if ( $rest =~ /}\s*([\w_]+(?:::[\w_])*)\s*;/ ) { # TODO: Doesn't parse members yet! $endtag = ";"; $name = $1; } $newNode = newTypedefComp( $type, $name, $endtag ); } # Typedef elsif ( $decl =~ /^\s*typedef\s+ (?:typename\s+)? # `typename' keyword (.*?\s*[\*&>]?) # type \s*([-\w_\:]+) # name \s*((?:\[[-\w_\:<>\s]*\])*) # array \s*[{;]\s*$/xs ) { print "Typedef: <$1 $3> <$2>\n" if $debug; $newNode = newTypedef( $1." ".$3, $2 ); } # Enum elsif ( $decl =~ /^\s*enum\s+([-\w_:]*)?\s*\{(.*)/s ) { print "Enum: <$1>\n" if $debug; my $enumname = defined $2 ? $1 : ""; $newNode = newEnum( $enumname ); } # Class/Struct elsif ( $decl =~ /^\s*((?:template\s*<.*>)?) # 1 template \s*(class|struct|union|namespace) # 2 struct type (?:\s*TQ[A-Z_]*EXPORT[A-Z_]*)? (?:\s*Q[A-Z_]*EXPORT[A-Z_]*)? (?:\s*TQ_PACKED)? (?:\s*Q_REFCOUNT)? \s+([\w_]+ # 3 name (?:<[\w_ :,]+?>)? # maybe explicit template # (eat chars between <> non-hungry) (?:::[\w_]+)* # maybe nested ) ([^\(]*?) # 4 inheritance ([;{])/xs ) { # 5 rest print "Class: [$1]\n\t[$2]\n\t[$3]\n\t[$4]\n\t[$5]\n" if $debug; my ( $tmpl, $ntype, $name, $rest, $endtag ) = ( $1, $2, $3, $4, $5 ); if ($includeclasses) { if (! ($includeclasses =~ /$name/) ) { return 1; } } if ($ntype eq 'namespace') { if ($decl =~ /}/) { return 0; } # Set a flag to indicate we're in a multi-line namespace declaration $inNamespace = 1; } my @inherits = (); $tmpl =~ s/<(.*)>/$1/ if $tmpl ne ""; if( $rest =~ /^\s*:\s*/ ) { # inheritance $rest = $'; @inherits = parseInheritance( $rest ); } $newNode = newClass( $tmpl, $ntype, $name, $endtag, $isDeprecated, @inherits ); if ($decl =~ /};/) { # If the declaration was all on one line ending with a '};', # then pop the new node $cNode = pop @classStack; print "end decl: popped $cNode->{astNodeName}\n" if $debug; } } # IDL compound node elsif( $decl =~ /^\s*(module|interface|exception) # struct type \s+([-\w_]+) # name (.*?) # inheritance? ([;{])/xs ) { my ( $type, $name, $rest, $fwd, $complete ) = ( $1, $2, $3, $4 eq ";" ? 1 : 0, 0 ); my @in = (); print "IDL: [$type] [$name] [$rest] [$fwd]\n" if $debug; if( $rest =~ /^\s*:\s*/ ) { $rest = $'; $rest =~ s/\s+//g; @in = split ",", $rest; } if( $decl =~ /}\s*;/ ) { $complete = 1; } $newNode = newIDLstruct( $type, $name, $fwd, $complete, @in ); } # Method elsif ( $decl =~ /^\s*(?:(?:class|struct)\s*)?([^=]+?(?:operator\s*(?:\(\)|.?=)\s*)?) # ret+nm \( (.*?) \) # parameters \s*((?:const)?)\s* (?:throw\s*\(.*?\))? \s*((?:=\s*0(?:L?))?)\s* # Pureness. is "0L" allowed? \s*[;{]+/xs ) { # rest my $tpn = $1; # type + name my $params = $2; # Remove constructor initializer, that's not in the params if ( $params =~ /\s*\)\s*:\s*/ ) { # Hack: first .* made non-greedy for TQSizePolicy using a?(b):c in ctor init $params =~ s/(.*?)\s*\)\s*:\s*.*$/$1/; } my $const = $3 eq "" ? 0 : 1; my $pure = $4 eq "" ? 0 : 1; $tpn =~ s/\s+/ /g; $tpn =~ s/operator\s+([^\w])/operator$1/g; $params =~ s/\s+/ /g; print "Method: R+N:[$tpn]\n\tP:[$params]\n\t[$const]\n" if $debug; if ( $tpn =~ /((?:\w+\s*::\s*)?operator.*?)\s*$/ # operator || $tpn =~ /((?:\w*\s*::\s*~?)?[-\w:]+)\s*$/ ) { # normal my $name = $1; $tpn = $`; $newNode = newMethod( $tpn, $name, $params, $const, $pure, $isDeprecated ); } $skipBlock = 1; # FIXME check end token before doing this! } # Using: import namespace elsif ( $decl =~ /^\s*using\s+namespace\s+(\w+)/ ) { newNamespace( $1 ); } # extern block elsif ( $decl =~ /^\s*extern\s*"(.*)"\s*{/ ) { $inExtern = 1 unless $decl =~ /}/; } # Single variable elsif ( $decl =~ /^ \s*( (?:[\w_:]+(?:\s+[\w_:]+)*? )# type \s*(?:<.+>)? # template \s*(?:[\&\*])? # ptr or ref (?:\s*(?:const|volatile))* ) \s*([\w_:]+) # name \s*( (?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? ) # array \s*((?:=.*)?) # value \s*([;{])\s*$/xs ) { my $type = $1; my $name = $2; my $arr = $3; my $val = $4; my $end = $5; $type =~ s/\s+/ /g; if ( $type !~ /^friend\s+class\s*/ && $type.$name ne "struct" ) { print "Var: [$name] type: [$type$arr] val: [$val]\n" if $debug; $newNode = newVar( $type.$arr, $name, $val ); } $skipBlock = 1 if $end eq '{'; } # Multi variables elsif ( $decl =~ m/^ \s*( (?:[\w_:]+(?:\s+[\w_:]+)*? ) # type \s*(?:<.+>)?) # template \s*( (?:\s*(?: [\&\*][\&\*\s]*)? # ptr or ref [\w_:]+) # name \s*(?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? # array \s*(?:, # extra vars \s*(?: [\&\*][\&\*\s]*)? # ptr or ref \s*(?:[\w_:]+) # name \s*(?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? # array )* \s*(?:=.*)?) # value \s*[;]/xs ) { my $type = $1; my $names = $2; my $end = $3; my $doc = $docNode; print "Multivar: type: [$type] names: [$names] \n" if $debug; foreach my $vardecl ( split( /\s*,\s*/, $names ) ) { next unless $vardecl =~ m/ \s*((?: [\&\*][\&\*\s]*)?) # ptr or ref \s*([\w_:]+) # name \s*( (?:\[[^\[\]]*\] (?:\s*\[[^\[\]]*\])*)? ) # array \s*((?:=.*)?) # value /xs; my ($ptr, $name, $arr, $val) = ($1, $2, $3, $4); print "Split: type: [$type$ptr$arr] ", " name: [$name] val: [$val] \n" if $debug; my $node = newVar( $type.$ptr.$arr, $name, $val ); $docNode = $doc; # reuse docNode for each postInitNode( $node ) unless !defined $node; } $skipBlock = 1 if $end eq '{'; } # end of an "extern" block elsif ( $decl =~ /^\s*}\s*$/ && $inExtern ) { $inExtern = 0; } # end of an in-block declaration elsif ( $decl =~ /^\s*}\s*(.*?)\s*;\s*$/ || ($decl =~ /^\s*}\s*$/ && $inNamespace) ) { if ( $cNode->{astNodeName} eq "--" ) { # structure typedefs should have no name preassigned. # If they do, then the name in # "typedef struct { ..." is kept instead. # TODO: Buglet. You should fix YOUR code dammit. ;) $cNode->{astNodeName} = $1; my $siblings = $cNode->{Parent}->{KidHash}; undef $siblings->{"--"}; $siblings->{ $1 } = $cNode; } # C++ namespaces end with a '}', and not '};' like classes if ($decl =~ /^\s*}\s*$/ ) { $inNamespace = 0; } if ( $#classStack < 0 ) { confess "close decl found, but no class in stack!" ; $cNode = $rootNode; } else { $cNode = pop @classStack; print "end decl: popped $cNode->{astNodeName}\n" if $debug; } } # unidentified block start elsif ( $decl =~ /{/ ) { print "Unidentified block start: $decl\n" if $debug; $skipBlock = 1; } # explicit template instantiation, or friend template elsif ( $decl =~ /(template|friend)\s+class\s+(?:TQ[A-Z_]*EXPORT[A-Z_]*\s*)?\w+\s*<.*>\s*;/x ) { # Nothing to be done with those. } # explicit template instantiation, or friend template elsif ( $decl =~ /(template|friend)\s+class\s+(?:Q[A-Z_]*EXPORT[A-Z_]*\s*)?\w+\s*<.*>\s*;/x ) { # Nothing to be done with those (same as above, but for QT not TQT). } else { ## decl is unidentified. warn "Unidentified decl: $decl\n"; } # once we get here, the last doc node is already used. # postInitNode should NOT be called for forward decls postInitNode( $newNode ) unless !defined $newNode; return $skipBlock; } sub postInitNode { my $newNode = shift; carp "Cannot postinit undef node." if !defined $newNode; # The reasoning here: # Forward decls never get a source node. # Once a source node is defined, don't assign another one. if ( $newNode->{NodeType} ne "Forward" && !defined $newNode->{Source}) { $newNode->AddProp( "Source", $cSourceNode ); } elsif ( $newNode->{NodeType} eq "Forward" ) { if ($debug) { print "postInit: skipping fwd: $newNode->{astNodeName}\n"; } undef $docNode; return; } if( defined $docNode ) { kdocParseDoc::attachDoc( $newNode, $docNode, $rootNode ); undef $docNode; } } ##### Node generators =head2 newEnum Reads the parameters of an enumeration. Returns the parameters, or undef on error. =cut sub newEnum { my ( $enum ) = @_; my $k = undef; my $params = ""; $k = $lastLine if defined $lastLine; if( defined $lastLine && $lastLine =~ /{/ ) { $params = $'; if ( $lastLine =~ /}(.*?);/ ) { return initEnum( $enum, $1, $params ); } } while ( defined ( $k = readCxxLine() ) ) { $params .= $k; if ( $k =~ /}(.*?);/ ) { return initEnum( $enum, $1, $params ); } } return undef; } =head2 initEnum Parameters: name, (ref) params Returns an initialized enum node. =cut sub initEnum { my( $name, $end, $params ) = @_; ($name = $end) if $name eq "" && $end ne ""; $params =~ s#\s+# #sg; # no newlines $params =~ s#\s*/\*([^\*]/|\*[^/]|[^\*/])*\*/##g; # strip out comments $params = $1 if $params =~ /^\s*{?(.*)}/; $params =~ s/,\s*$/ /; print "$name params: [$params]\n" if $debug; my ( $node ) = Ast::New( $name ); $node->AddProp( "NodeType", "enum" ); $node->AddProp( "Params", $params ); $node->AddProp( "Source", $cSourceNode ); makeParamList( $node, $params, 1 ); # Adds the ParamList property containing the list of param nodes kdocAstUtil::attachChild( $cNode, $node ); return $node; } =head2 newIDLstruct Parameters: type, name, forward, complete, inherits... Handles an IDL structure definition (ie module, interface, exception). =cut sub newIDLstruct { my ( $type, $name, $fwd, $complete ) = @_; my $node = exists $cNode->{KidHash} ? $cNode->{KidHash}->{ $name } : undef; if( !defined $node ) { $node = Ast::New( $name ); $node->AddProp( "NodeType", $fwd ? "Forward" : $type ); $node->AddProp( "KidAccess", "public" ); $node->AddProp( "Compound", 1 ) unless $fwd; kdocAstUtil::attachChild( $cNode, $node ); } elsif ( $fwd ) { # If we have a node already, we ignore forwards. return undef; } elsif ( $node->{NodeType} eq "Forward" ) { # we are defining a previously forward node. $node->AddProp( "NodeType", $type ); $node->AddProp( "Compound", 1 ); $node->AddProp( "Source", $cSourceNode ); } # register ancestors. foreach my $ances ( splice ( @_, 4 ) ) { my $n = kdocAstUtil::newInherit( $node, $ances ); } if( !( $fwd || $complete) ) { print "newIDL: pushing $cNode->{astNodeName},", " new is $node->{astNodeName}\n" if $debug; push @classStack, $cNode; $cNode = $node; } return $node; } =head2 newClass Parameters: tmplArgs, cNodeType, name, endTag, isDeprecated, @inheritlist Handles a class declaration (also fwd decls). =cut sub newClass { my( $tmplArgs, $cNodeType, $name, $endTag, $isDeprecated ) = @_; my $access = "private"; $access = "public" if $cNodeType ne "class"; # try to find an exisiting node, or create a new one my $oldnode = kdocAstUtil::findRef( $cNode, $name ); my $node = defined $oldnode ? $oldnode : Ast::New( $name ); if ( $endTag ne "{" ) { # forward if ( !defined $oldnode ) { # new forward node $node->AddProp( "NodeType", "Forward" ); $node->AddProp( "KidAccess", $access ); kdocAstUtil::attachChild( $cNode, $node ); } # Discard any doc comment against a forward decl undef $docNode; return $node; } # this is a class declaration print "ClassName: $name\n" if $debug; $node->AddProp( "NodeType", $cNodeType ); $node->AddProp( "Compound", 1 ); $node->AddProp( "Source", $cSourceNode ); if ($cNodeType eq 'namespace') { $node->AddPropList( "Sources", $cSourceNode ); } $node->AddProp( "KidAccess", $access ); $node->AddProp( "Tmpl", $tmplArgs ) unless $tmplArgs eq ""; $node->AddProp( "Deprecated", $isDeprecated ); if ( !defined $oldnode ) { kdocAstUtil::attachChild( $cNode, $node ); } # inheritance foreach my $ances ( splice (@_, 5) ) { my $type = ""; my $name = $ances; my $intmpl = undef; WORD: foreach my $word ( split ( /([\w:]+(:?\s*<.*>)?)/, $ances ) ) { next WORD unless $word =~ /^[\w:]/; if ( $word =~ /(private|public|protected|virtual)/ ) { $type .= "$1 "; } else { if ( $word =~ /<(.*)>/ ) { # FIXME: Handle multiple tmpl args $name = $`; $intmpl = $1; } else { $name = $word; } last WORD; } } # set inheritance access specifier if none specified if ( $type eq "" ) { $type = $cNodeType eq "class" ? "private ":"public "; } chop $type; # attach inheritance information my $n = kdocAstUtil::newInherit( $node, $name ); $n->AddProp( "Type", $type ); $n->AddProp( "TmplType", $intmpl ) if defined $intmpl; print "In: $name type: $type, tmpl: $intmpl\n" if $debug; } # new current node print "newClass: Pushing $cNode->{astNodeName}\n" if $debug; push ( @classStack, $cNode ); $cNode = $node; return $node; } =head3 parseInheritance Param: inheritance decl string Returns: list of superclasses (template decls included) This will fail if < and > appear in strings in the decl. =cut sub parseInheritance { my $instring = shift; my @inherits = (); my $accum = ""; foreach $instring ( split (/\s*,\s*/, $instring) ) { $accum .= $instring.", "; next unless (kdocUtil::countReg( $accum, "<" ) - kdocUtil::countReg( $accum, ">" ) ) == 0; # matching no. of < and >, so assume the parent is # complete $accum =~ s/,\s*$//; print "Inherits: '$accum'\n" if $debug; push @inherits, $accum; $accum = ""; } return @inherits; } =head2 newNamespace Param: namespace name. Returns nothing. Imports a namespace into the current node, for ref searches etc. Triggered by "using namespace ..." =cut sub newNamespace { $cNode->AddPropList( "ImpNames", shift ); } =head2 newTypedef Parameters: realtype, name Handles a type definition. =cut sub newTypedef { my ( $realtype, $name ) = @_; my ( $node ) = Ast::New( $name ); $node->AddProp( "NodeType", "typedef" ); $node->AddProp( "Type", $realtype ); kdocAstUtil::attachChild( $cNode, $node ); return $node; } =head2 newTypedefComp Params: realtype, name endtoken Creates a new compound type definition. =cut sub newTypedefComp { my ( $realtype, $name, $endtag ) = @_; my ( $node ) = Ast::New( $name ); $node->AddProp( "NodeType", "typedef" ); $node->AddProp( "Type", $realtype ); kdocAstUtil::attachChild( $cNode, $node ); if ( $endtag eq '{' ) { print "newTypedefComp: Pushing $cNode->{astNodeName}\n" if $debug; push ( @classStack, $cNode ); $cNode = $node; } return $node; } =head2 newMethod Parameters: retType, name, params, const, pure?, deprecated? Handles a new method declaration or definition. =cut BEGIN { my $theSourceNode = $cSourceNode; sub newMethod { my ( $retType, $name, $params, $const, $pure, $deprecated ) = @_; my $parent = $cNode; my $class; print "Cracked: [$retType] [$name]\n\t[$params]\n\t[$const]\n" if $debug; if ( $retType =~ /([\w\s_<>,]+)\s*::\s*$/ ) { # check if stuff before :: got into rettype by mistake. $retType = $`; ($name = $1."::".$name); $name =~ s/\s+/ /g; print "New name = \"$name\" and type = '$retType'\n" if $debug; } # A 'friend method' declaration isn't a real method declaration return undef if ( $retType =~ /^friend\s+/ || $retType =~ /^friend\s+class\s+/ ); my $isGlobalSpace = 0; if( $name =~ /^\s*(.*?)\s*::\s*(.*?)\s*$/ ) { # Fully qualified method name. $name = $2; $class = $1; if( $class =~ /^\s*$/ ) { $parent = $rootNode; } elsif ( $class eq $cNode->{astNodeName} ) { $parent = $cNode; } else { # ALWAYS IGNORE... return undef; my $node = kdocAstUtil::findRef( $cNode, $class ); if ( !defined $node ) { # if we couldn't find the name, try again with # all template parameters stripped off: my $strippedClass = $class; $strippedClass =~ s/<[^<>]*>//g; $node = kdocAstUtil::findRef( $cNode, $strippedClass ); # if still not found: give up if ( !defined $node ) { warn "$exe: Unidentified class: $class ". "in $currentfile\:$.\n"; return undef; } } $parent = $node; } } # TODO fix for $retType =~ /template<.*?>/ elsif( $parse_global_space && $parent->{NodeType} eq "root" && $name !~ /\s*qt_/ && $retType !~ /template\s*<.*?>/ ) { $class = $globalSpaceClassName; # FIXME - sanitize the naming system? $isGlobalSpace = 1; my $opsNode = kdocAstUtil::findRef( $cNode, $class ); if (!$opsNode) { # manually create a "GlobalSpace" class $opsNode = Ast::New( $class ); $opsNode->AddProp( "NodeType", "class" ); $opsNode->AddProp( "Compound", 1 ); $opsNode->AddProp( "Source", $cSourceNode ); # dummy $opsNode->AddProp( "KidAccess", "public" ); kdocAstUtil::attachChild( $cNode, $opsNode ); } # Add a special 'Source' property for methods in global space $cNode->AddProp( "Source", $theSourceNode ); unless( $theSourceNode == $cSourceNode ) { $theSourceNode = $cSourceNode; $opsNode->AddPropList( "Sources", $theSourceNode ); # sources are scattered across Qt } $parent = $opsNode; } # flags my $flags = ""; if( $retType =~ /static/ || $isGlobalSpace ) { $flags .= "s"; $retType =~ s/static//g; } if( $const && !$isGlobalSpace ) { $flags .= "c"; } if( $pure ) { $flags .= "p"; } if( $retType =~ /virtual/ ) { $flags .= "v"; $retType =~ s/virtual//g; } if( $retType =~ /explicit\s*/ ) { $flags .= "t"; $retType =~ s/explicit\s*//g; } print "\n" if $flags ne "" && $debug; if ( !defined $parent->{KidAccess} ) { warn "'", $parent->{astNodeName}, "' has no KidAccess ", exists $parent->{Forward} ? "(forward)\n" :"\n"; } # NB, these are =~, so make sure they are listed in correct order if ( $parent->{KidAccess} =~ /slot/ ) { $flags .= "l"; } elsif ( $parent->{KidAccess} =~ /k_dcop_signals/ ) { $flags .= "z"; } elsif ( $parent->{KidAccess} =~ /k_dcop_hidden/ ) { $flags .= "y"; } elsif ( $parent->{KidAccess} =~ /k_dcop/ ) { $flags .= "d"; } elsif ( $parent->{KidAccess} =~ /signal/ ) { $flags .= "n"; } $retType =~ s/TQM?_EXPORT[_A-Z]*\s*//; $retType =~ s/QM?_EXPORT[_A-Z]*\s*//; $retType =~ s/inline\s+//; $retType =~ s/extern\s+//; $retType =~ s/^\s*//g; $retType =~ s/\s*$//g; $retType =~ s/^class\s/ /; # Remove redundant class forward decln's $retType =~ s/AddProp( "NodeType", "method" ); $node->AddProp( "Flags", $flags ); $node->AddProp( "ReturnType", $retType ); $node->AddProp( "Params", $params ); # The raw string with the whole param list makeParamList( $node, $params, 0 ); # Adds the ParamList property containing the list of param nodes $node->AddProp( "Deprecated", $deprecated ); $parent->AddProp( "Pure", 1 ) if $pure; kdocAstUtil::attachChild( $parent, $node ); return $node; } } =head2 makeParamList Parameters: * method (or enum) node * string containing the whole param list * 1 for enums Adds a property "ParamList" to the method node. This property contains a list of nodes, one for each parameter. Each parameter node has the following properties: * ArgType the type of the argument, e.g. const TQString& * ArgName the name of the argument - optionnal * DefaultValue the default value of the argument - optionnal For enum values, ArgType is unset, ArgName is the name, DefaultValue its value. Author: David Faure =cut sub makeParamList($$$) { my ( $methodNode, $params, $isEnum ) = @_; $params =~ s/\s+/ /g; # normalize multiple spaces/tabs into a single one $params =~ s/\s*([\*\&])\s*/$1 /g; # normalize spaces before and after *, & $params =~ s/\s*(,)([^'\s])\s*/$1 $2/g; # And after ',', but not if inside single quotes $params =~ s/^\s*void\s*$//; # foo(void) ==> foo() $params =~ s/^\s*$//; # Make sure the property always exists, makes iteration over it easier $methodNode->AddProp( "ParamList", [] ); my @args = kdocUtil::splitUnnested( ',', $params); my $argId = 0; foreach my $arg ( @args ) { my $argType; my $argName; my $defaultparam; $arg =~ s/\s*([^\s].*[^\s])\s*/$1/; # stripWhiteSpace $arg =~ s/(\w+)\[\]/\* $1/; # Turn [] array into * $arg =~ s/^class //; # Remove any redundant 'class' forward decln's # The RE below reads as: = ( string constant or char or cast to numeric literal # or some word/number, with optional bitwise shifts, OR'ed or +'ed flags, and/or function call ). if ( $arg =~ s/\s*=\s*(("[^\"]*")|\([^)]*\)\s*[\+-]?\s*[0-9]+|(\'.\')|(([-\w:~]*)\s*([<>\|\+-]*\s*[\w:._]*\s*)*(\([^(]*\))?))// ) { $defaultparam = $1; } if (defined $defaultparam && $isEnum) { # Remove any casts in enum values, for example this in tdefileitem.h: # 'enum { Unknown = (mode_t) - 1 };' $defaultparam =~ s/\([^\)]+\)(.*[0-9].*)/$1/; } # Separate arg type from arg name, if the latter is specified if ( $arg =~ /(.*)\s+([\w_]+)\s*$/ || $arg =~ /(.*)\(\s*\*\s([\w_]+)\)\s*\((.*)\)\s*$/ ) { if ( defined $3 ) { # function pointer $argType = $1."(*)($3)"; $argName = $2; } else { $argType = $1; $argName = $2; } } else { # unnamed arg - or enum value $argType = $arg if (!$isEnum); $argName = $arg if ($isEnum); } $argId++; my $node = Ast::New( $argId ); # let's make the arg index the node "name" $node->AddProp( "NodeType", "param" ); $node->AddProp( "ArgType", $argType ); $node->AddProp( "ArgName", $argName ) if (defined $argName); $node->AddProp( "DefaultValue", $defaultparam ) if (defined $defaultparam); $methodNode->AddPropList( "ParamList", $node ); print STDERR "ArgType: $argType ArgName: $argName\n" if ($debug); } } =head2 newAccess Parameters: access Sets the default "Access" specifier for the current class node. If the access is a "slot" type, "_slots" is appended to the access string. =cut sub newAccess { my ( $access ) = @_; return undef unless ($access =~ /^\s*(\w+)\s*(slots|$allowed_k_dcop_accesors_re)?/); print "Access: [$1] [$2]\n" if $debug; $access = $1; if ( defined $2 && $2 ne "" ) { $access .= "_" . $2; } $cNode->AddProp( "KidAccess", $access ); return $cNode; } =head2 newVar Parameters: type, name, value New variable. Value is ignored if undef =cut sub newVar { my ( $type, $name, $val ) = @_; my $node = Ast::New( $name ); $node->AddProp( "NodeType", "var" ); my $static = 0; if ( $type =~ /static/ ) { # $type =~ s/static//; $static = 1; } $node->AddProp( "Type", $type ); $node->AddProp( "Flags", 's' ) if $static; $node->AddProp( "Value", $val ) if defined $val; kdocAstUtil::attachChild( $cNode, $node ); return $node; } =head2 newProperty Parameters: property Handles a property =cut sub newProperty { my ( $property ) = @_; $property =~ s/^\s+|\s+$//g; my @items = split(/ /,$property); do { my ( $node ) = Ast::New( $items[1] ); $node->AddProp( "NodeType", "property" ); $node->AddProp( "type", $items[0] ); $node->AddProp( "READ", $items[3] ); $node->AddProp( "WRITE", $items[5] ); $node->AddProp( "NOTIFY", $items[7] ); $cNode->{KidAccess} = "public"; kdocAstUtil::attachChild( $cNode, $node ); return $node; } if defined $items[1]; } =head2 show_usage Display usage information and quit. =cut sub show_usage { print<\n"; }