kalyptus/kdocLib.pm

   1
   2 =head1 kdocLib
   3
   4 Writes out a library file.
   5
   6 NOTES ON THE NEW FORMAT
   7
   8         Stores: class name, members, hierarchy
   9         node types are not stored
  10
  11
  12         File Format Spec
  13         ----------------
  14
  15         header
  16         zero or more members, each of
  17                 method
  18                 member
  19                 class, each of
  20                         inheritance
  21                         zero or more members
  22
  23
  24
  25         Unrecognized lines  ignored.
  26
  27         Sample
  28         ------
  29
  30         <! KDOC Library HTML Reference File>
  31         <VERSION="2.0">
  32         <BASE URL="http://www.kde.org/API/kdecore/">
  33
  34         <C NAME="KApplication" REF="KApplication.html">
  35                 <IN NAME="QObject">
  36                 <ME NAME="getConfig" REF="KApplication.html#getConfig">
  37                 <M NAME="" REF="">
  38         </C>
  39
  40 =cut
  41
  42 package kdocLib;
  43 use strict;
  44
  45 use Carp;
  46 use File::Path;
  47 use File::Basename;
  48
  49 use Ast;
  50 use kdocAstUtil;
  51 use kdocUtil;
  52
  53
  54 use vars qw/ $exe $lib $root $plang $outputdir $docpath $url $compress /;
  55
  56 BEGIN {
  57         $exe = basename $0;
  58 }
  59
  60 sub writeDoc
  61 {
  62         ( $lib, $root, $plang, $outputdir, $docpath, $url,
  63                 $compress ) = @_;
  64         my $outfile = "$outputdir/$lib.kalyptus";
  65         $url = $docpath unless defined $url;
  66
  67         mkpath( $outputdir ) unless -f $outputdir;
  68
  69         if( $compress ) {
  70                 open( LIB, "| gzip -9 > \"$outfile.gz\"" )
  71                         || die "$exe: couldn't write to $outfile.gz\n";
  72
  73         }
  74         else {
  75                 open( LIB, ">$outfile" )
  76                         || die "$exe: couldn't write to $outfile\n";
  77         }
  78
  79         my $libdesc = "";
  80         if ( defined $root->{LibDoc} ) {
  81                         $libdesc="<LIBDESC>".$root->{LibDoc}->{astNodeName}."</LIBDESC>";
  82         }
  83
  84         print LIB<<LTEXT;
  85 <! KDOC Library HTML Reference File>
  86 <VERSION="$main::Version">
  87 <BASE URL="$url">
  88 <PLANG="$plang">
  89 <LIBNAME>$lib</LIBNAME>
  90 $libdesc
  91
  92 LTEXT
  93
  94         writeNode( $root, "" );
  95         close LIB;
  96 }
  97
  98 sub writeNode
  99 {
 100         my ( $n, $prefix ) = @_;
 101         return if !exists $n->{Compound};
 102         return if exists $n->{Forward} && !exists $n->{KidAccess};
 103
 104         if( $n != $root ) {
 105                 $prefix .= $n->{astNodeName};
 106                 print LIB "<C NAME=\"", $n->{astNodeName},
 107                         "\" REF=\"$prefix.html\">\n";
 108         }
 109         else {
 110                 print LIB "<STATS>\n";
 111                 my $stats = $root->{Stats};
 112                 foreach my $stat ( keys %$stats ) {
 113                         print LIB "<STAT NAME=\"$stat\">",
 114                                 $stats->{$stat},"</STAT>\n";
 115                 }
 116                 print LIB "</STATS>\n";
 117         }
 118
 119         if( exists $n->{Ancestors} ) {
 120                 my $in;
 121                 foreach $in ( @{$n->{Ancestors}} ) {
 122                         $in =~ s/\s+//g;
 123                         print LIB "<IN NAME=\"",$in,"\">\n";
 124                 }
 125         }
 126
 127         return if !exists $n->{Kids};
 128         my $kid;
 129         my $type;
 130
 131         foreach $kid ( @{$n->{Kids}} ) {
 132                 next if exists $kid->{ExtSource}
 133                         || $kid->{Access} eq "private";
 134
 135                 if ( exists $kid->{Compound} ) {
 136                         if( $n != $root ) {
 137                                 writeNode( $kid, $prefix."::" );
 138                         }
 139                         else {
 140                                 writeNode( $kid, "" );
 141                         }
 142                         next;
 143                 }
 144
 145                 $type = $kid->{NodeType} eq "method" ?
 146                         "ME" : "M";
 147
 148                 print LIB "<$type NAME=\"", $kid->{astNodeName},
 149                         "\" REF=\"$prefix.html#", $kid->{astNodeName}, "\">\n";
 150         }
 151
 152         if( $n != $root ) {
 153                 print LIB "</C>\n";
 154         }
 155 }
 156
 157 sub readLibrary
 158 {
 159         my( $rootsub, $name, $path, $relurl ) = @_;
 160         $path = "." unless defined $path;
 161         my $real = $path."/".$name.".kalyptus";
 162         my $url = ".";
 163         my @stack = ();
 164         my $version = "2.0";
 165         my $new;
 166         my $root = undef;
 167         my $n = undef;
 168         my $havecomp = -r "$real.gz";
 169         my $haveuncomp = -r "$real";
 170
 171         if ( $haveuncomp ) {
 172                 open( LIB, "$real" ) || die "Can't read lib $real\n";
 173         }
 174
 175         if( $havecomp ) {
 176                 if ( $haveuncomp ) {
 177                         warn "$exe: two libs exist: $real and $real.gz. "
 178                                 ."Using $real\n";
 179                 }
 180                 else {
 181                         open( LIB, "gunzip < \"$real.gz\"|" )
 182                         || die "Can't read pipe gunzip < \"$real.gz\": $?\n";
 183                 }
 184         }
 185
 186         while( <LIB> ) {
 187                 next if /^\s*$/;
 188                 if ( !/^\s*</ ) {
 189                         close LIB;
 190                         #readOldLibrary( $root, $name, $path );
 191                         return;
 192                 }
 193
 194                 if( /<VER\w+\s+([\d\.]+)>/ ) {
 195                         # TODO: what do we do with the version number?
 196                         $version = $1;
 197                 }
 198                 elsif ( /<BASE\s*URL\s*=\s*"(.*?)"/ ) {
 199                         $url = $1;
 200                         $url .= "/" unless $url =~ m:/$:;
 201
 202                         my $test = kdocUtil::makeRelativePath( $relurl, $url );
 203                         $url = $test;
 204                 }
 205                 elsif( /<PLANG\s*=\s*"(.*?)">/ ) {
 206                         $root = $rootsub->( $1 );
 207                         $n = $root;
 208                 }
 209                 elsif ( /<C\s*NAME="(.*?)"\s*REF="(.*?)"\s*>/  ) {
 210                         # class
 211                         $new = Ast::New( $1 );
 212                         $new->AddProp( "NodeType", "class" );
 213                         $new->AddProp( "Compound", 1 );
 214                         $new->AddProp( "ExtSource", $name );
 215
 216                         # already escaped at this point!
 217                         $new->AddProp( "Ref", $url.$2 );
 218
 219                         $root = $n = $rootsub->( "CXX" ) unless defined $root;
 220                         kdocAstUtil::attachChild( $n, $new );
 221                         push @stack, $n;
 222                         $n = $new;
 223                 }
 224                 elsif ( m#<IN\s*NAME\s*=\s*"(.*?)"\s*># ) {
 225                         # ancestor
 226                         kdocAstUtil::newInherit( $n, $1 );
 227                 }
 228                 elsif ( m#</C># ) {
 229                         # end class
 230                         $n = pop @stack;
 231                 }
 232                 elsif ( m#<(M\w*)\s+NAME="(.*?)"\s+REF="(.*?)"\s*># ) {
 233                         # member
 234                         $new = Ast::New( $2 );
 235                         $new->AddProp( "NodeType", $1 eq "ME" ? "method" : "var" );
 236                         $new->AddProp( "ExtSource", $name );
 237                         $new->AddProp( "Flags", "" );
 238                         $new->AddProp( "Ref", $url.$3 );
 239
 240                         kdocAstUtil::attachChild( $n, $new );
 241                 }
 242         }
 243 }
 244
 245 1;