GPL_bin_fullset/NaturalDocs/Modules/NaturalDocs/SymbolString.pm

   1 ###############################################################################
   2 #
   3 #   Package: NaturalDocs::SymbolString
   4 #
   5 ###############################################################################
   6 #
   7 #   A package to manage <SymbolString> handling throughout the program.
   8 #
   9 ###############################################################################
  10
  11 # This file is part of Natural Docs, which is Copyright © 2003-2010 Greg Valure
  12 # Natural Docs is licensed under version 3 of the GNU Affero General Public License (AGPL)
  13 # Refer to License.txt for the complete details
  14
  15 use strict;
  16 use integer;
  17
  18 package NaturalDocs::SymbolString;
  19
  20 use Encode qw(encode_utf8 decode_utf8);
  21
  22
  23 #
  24 #   Function: FromText
  25 #
  26 #   Extracts and returns a <SymbolString> from plain text.
  27 #
  28 #   This should be the only way to get a <SymbolString> from plain text, as the splitting and normalization must be consistent
  29 #   throughout the application.
  30 #
  31 sub FromText #(string textSymbol)
  32     {
  33     my ($self, $textSymbol) = @_;
  34
  35     # The internal format of a symbol is all the normalized identifiers separated by 0x1F characters.
  36
  37     # Convert whitespace and reserved characters to spaces, and condense multiple consecutive ones.
  38     $textSymbol =~ tr/ \t\r\n\x1C\x1D\x1E\x1F/ /s;
  39
  40     # DEPENDENCY: ReferenceString->MakeFrom() assumes all 0x1E characters were removed.
  41     # DEPENDENCY: ReferenceString->MakeFrom() assumes this encoding doesn't use 0x1E characters.
  42
  43     # Remove spaces unless they're separating two alphanumeric/underscore characters.
  44     $textSymbol =~ s/^ //;
  45     $textSymbol =~ s/ $//;
  46     $textSymbol =~ s/(\W) /$1/g;
  47     $textSymbol =~ s/ (\W)/$1/g;
  48
  49     # Remove trailing empty parenthesis, so Function and Function() are equivalent.
  50     $textSymbol =~ s/\(\)$//;
  51
  52     # Split the string into pieces.
  53     my @pieces = split(/(\.|::|->)/, $textSymbol);
  54     my $symbolString;
  55
  56     my $lastWasSeparator = 1;
  57
  58     foreach my $piece (@pieces)
  59         {
  60         if ($piece =~ /^(?:\.|::|->)$/)
  61             {
  62             if (!$lastWasSeparator)
  63                 {
  64                 $symbolString .= "\x1F";
  65                 $lastWasSeparator = 1;
  66                 };
  67             }
  68         elsif (length $piece)
  69             {
  70             $symbolString .= $piece;
  71             $lastWasSeparator = 0;
  72             };
  73         # Ignore empty pieces
  74         };
  75
  76     $symbolString =~ s/\x1F$//;
  77
  78     return $symbolString;
  79     };
  80
  81
  82 #
  83 #   Function: ToText
  84 #
  85 #   Converts a <SymbolString> to text, using the passed separator.
  86 #
  87 sub ToText #(SymbolString symbolString, string separator)
  88     {
  89     my ($self, $symbolString, $separator) = @_;
  90
  91     my @identifiers = $self->IdentifiersOf($symbolString);
  92     return join($separator, @identifiers);
  93     };
  94
  95
  96 #
  97 #   Function: ToBinaryFile
  98 #
  99 #   Writes a <SymbolString> to the passed filehandle.  Can also encode an undef.
 100 #
 101 #   Parameters:
 102 #
 103 #       fileHandle - The filehandle to write to.
 104 #       symbol - The <SymbolString> to write, or undef.
 105 #
 106 #   Format:
 107 #
 108 #       > [UInt8: number of identifiers]
 109 #       >    [UString16: identifier] [UString16: identifier] ...
 110 #
 111 #       Undef is represented by a zero for the number of identifiers.
 112 #
 113 sub ToBinaryFile #(FileHandle fileHandle, SymbolString symbol)
 114     {
 115     my ($self, $fileHandle, $symbol) = @_;
 116
 117     my @identifiers;
 118     if (defined $symbol)
 119         {  @identifiers = $self->IdentifiersOf($symbol);  };
 120
 121     print $fileHandle pack('C', scalar @identifiers);
 122
 123     foreach my $identifier (@identifiers)
 124         {
 125         my $uIdentifier = encode_utf8($identifier);
 126         print $fileHandle pack('na*', length($uIdentifier), $uIdentifier);
 127         };
 128     };
 129
 130
 131 #
 132 #   Function: FromBinaryFile
 133 #
 134 #   Loads a <SymbolString> or undef from the filehandle and returns it.
 135 #
 136 #   Parameters:
 137 #
 138 #       fileHandle - The filehandle to read from.
 139 #
 140 #   Returns:
 141 #
 142 #       The <SymbolString> or undef.
 143 #
 144 #   See also:
 145 #
 146 #       See <ToBinaryFile()> for format and dependencies.
 147 #
 148 sub FromBinaryFile #(FileHandle fileHandle)
 149     {
 150     my ($self, $fileHandle) = @_;
 151
 152     my $raw;
 153
 154     # [UInt8: number of identifiers or 0 if none]
 155
 156     read($fileHandle, $raw, 1);
 157     my $identifierCount = unpack('C', $raw);
 158
 159     my @identifiers;
 160
 161     while ($identifierCount)
 162         {
 163         # [UString16: identifier] [UString16: identifier] ...
 164
 165         read($fileHandle, $raw, 2);
 166         my $identifierLength = unpack('n', $raw);
 167
 168         my $identifier;
 169         read($fileHandle, $identifier, $identifierLength);
 170         $identifier = decode_utf8($identifier);
 171
 172         push @identifiers, $identifier;
 173
 174         $identifierCount--;
 175         };
 176
 177     if (scalar @identifiers)
 178         {  return $self->Join(@identifiers);  }
 179     else
 180         {  return undef;  };
 181     };
 182
 183
 184 #
 185 #   Function: IdentifiersOf
 186 #
 187 #   Returns the <SymbolString> as an array of identifiers.
 188 #
 189 sub IdentifiersOf #(SymbolString symbol)
 190     {
 191     my ($self, $symbol) = @_;
 192     return split(/\x1F/, $symbol);
 193     };
 194
 195
 196 #
 197 #   Function: Join
 198 #
 199 #   Takes a list of identifiers and/or <SymbolStrings> and returns it as a new <SymbolString>.
 200 #
 201 sub Join #(string/SymbolString identifier/symbol, string/SymolString identifier/symbol, ...)
 202     {
 203     my ($self, @pieces) = @_;
 204
 205     # Can't have undefs screwing everything up.
 206     while (scalar @pieces && !defined $pieces[0])
 207         {  shift @pieces;  };
 208
 209     # We need to test @pieces first because joining on an empty array returns an empty string rather than undef.
 210     if (scalar @pieces)
 211        {  return join("\x1F", @pieces);  }
 212     else
 213         {  return undef;  };
 214     };
 215
 216
 217 1;