Project

General

Profile

Statistics
| Branch: | Revision:

root / src / nedxml / opp_msgc @ 79bb12dc

History | View | Annotate | Download (84 KB)

1 01873262 Georg Kunz
#!/usr/bin/env perl
2
#
3
# opp_msgc: translates MSG files into C++ code.
4
#
5
6
$MSGC_VERSION = "4.1";
7
$MSGC_VERSION_HEX = "0x0401";
8
9
sub processFile($);
10
sub quote($);
11
sub unquote($);
12
sub canonicalizeQName($$);
13
sub prefixWithNamespace($$);
14
sub lookupExistingClassName($$);
15
sub lookupExistingEnumName($$);
16
17
18
#
19
# If no args, print usage
20
#
21
$Usage = 'opp_msgc - part of OMNeT++. (c) 2002-2009 Andras Varga
22
Translates .msg files into C++
23
24
Usage: opp_msgc [-s <cc-file-suffix>] [-t <h-file-suffix>]
25
                [-I <dir> -I ...] [-h] [-Xnc] [-Xnd]
26
                <msgfilenamepatterns-and-directories>
27
  -v          verbose
28
  -I <dir>    add directory to include path
29
  -s <suffix> output C++ file suffix (defaults to: _m.cc)
30
  -t <suffix> output C++ header file suffix (defaults to: _m.h)
31
  -P <symbol> add dllexport/dllimport symbol to class declarations; if symbol
32
              name ends in _API, boilerplate code to conditionally define
33
              it as OPP_DLLEXPORT/OPP_DLLIMPORT is also generated
34
  -h          output in current directory
35
  -A          no timestamp check, always overwrite output files.
36
              (by default, opp_msgc only overwrites output files if they
37
              appear to be out-of-date, according to file time/date)
38
  -Xnc        do not generate the classes, only object descriptions
39
  -Xnd        do not generate object descriptions
40
  -Xns        do not generate setters in object descriptions
41
';
42
43
if ($#ARGV == -1)
44
{
45
    print $Usage;
46
    exit(0);
47
}
48
49
#
50
#  Parse the command line for options and files.
51
#
52
@filenames = ();
53
$here = 0;
54
$checktimestamps = 1;
55
$ccsuffix = '_m.cc';
56
$hsuffix = '_m.h';
57
$exportdef = '';
58
$generate_classes = 1;
59
$generate_descriptors = 1;
60
$generate_setters_in_descriptors = 1;
61
$verbose = 0;
62
while (@ARGV)
63
{
64
    $arg = shift @ARGV;
65
66
    if ($arg eq "-s")
67
    {
68
        $ccsuffix = shift @ARGV;
69
    }
70
    elsif ($arg eq "-t")
71
    {
72
        $hsuffix = shift @ARGV;
73
    }
74
    elsif ($arg eq "-I")
75
    {
76
        # import not supported: just ignore -I <dir> for now
77
        shift @ARGV;
78
    }
79
    elsif ($arg =~ /^-I/)
80
    {
81
        # import not supported: just ignore -I<dir> for now
82
    }
83
    elsif ($arg eq "-P")
84
    {
85
        $exportdef = shift @ARGV;
86
        $exportdef =~ s/[ \t]//g;
87
        $exportdef .= " ";
88
    }
89
    elsif ($arg =~ /^-P/)
90
    {
91
        $exportdef = $arg;
92
        $exportdef =~ s/^-P//;
93
        $exportdef =~ s/[ \t]//g;
94
        $exportdef .= " ";
95
    }
96
    elsif ($arg eq "-h")
97
    {
98
        $here = 1;
99
    }
100
    elsif ($arg eq "-A")
101
    {
102
        $checktimestamps = 0;
103
    }
104
    elsif ($arg eq "-v")
105
    {
106
        $verbose = 1;
107
    }
108
    elsif ($arg eq "-Xnc")
109
    {
110
        $generate_classes = 0;
111
    }
112
    elsif ($arg eq "-Xnd")
113
    {
114
        $generate_descriptors = 0;
115
    }
116
    elsif ($arg eq "-Xns")
117
    {
118
        $generate_setters_in_descriptors = 0;
119
    }
120
    elsif (!($arg =~ /^-/))
121
    {
122
        #FIXME implement end-of-options ('--')
123
        if (-d $arg) {
124
            $arg .= '/*.msg';
125
        }
126
        # only glob if contains "*" or "?"
127
        if ($arg =~ /\*/ || $arg =~ /\?/) {
128
            foreach my $i (glob($arg)) {
129
                push(@filenames, $i);
130
            }
131
        }
132
        elsif (-f $arg) {
133
            push(@filenames, $arg);
134
        }
135
        else {
136
            die "*** Error: no such file or directory: $arg\n";
137
        }
138
    }
139
    else
140
    {
141
        die "*** Error: unrecognized argument: $arg\n";
142
    }
143
}
144
145
$ret = 0;
146
foreach my $ii (@filenames)
147
{
148
    processFile($ii);
149
}
150
151
exit $ret;
152
153
#
154
# Processes a file. Note: information gets passed to other procs
155
# (prepareForCodeGeneration, etc) in global variables
156
#
157
sub processFile($)
158
{
159
    $filename = shift;
160
    print "processing $filename...\n" if $verbose;
161
162
    #
163
    # parse file
164
    #
165
    $filename =~ /\.[^\\\/]*$/;
166
    $filename =~ s|\\|/|g;
167
    $hfile = $filename;
168
    $hfile =~ s|\.[^.]*$|$hsuffix|;
169
    if ($here)
170
    {
171
        $hfile =~ s|^.*/||;
172
    }
173
    $hfilenamewithoutdir = $hfile;
174
    $hfilenamewithoutdir =~ s|^.*/||;
175
    $hdef = $hfilenamewithoutdir;
176
    $hdef =~ s|^.*/||;
177
    $hdef =~ s|\.[^.]*$|_H_|;
178
    $hdef = '_'.$hdef;
179
    $hdef =~ tr/[a-z]/[A-Z]/;
180
    $hdef =~ s/[^a-zA-Z0-9]/_/g;
181
    $ccfile = $filename;
182
    $ccfile =~ s|\.[^.]*$|$ccsuffix|;
183
    if ($here)
184
    {
185
        $ccfile =~ s|^.*/||;
186
    }
187
188
    if ($checktimestamps)
189
    {
190
        $msgfiledate = (stat($filename))[9];
191
        $ccfiledate = (stat($ccfile))[9];
192
        $hfiledate = (stat($hfile))[9];
193
        if ($msgfiledate<$ccfiledate && $msgfiledate<$hfiledate) {
194
            print "output files up to date, skipping $filename\n" if $verbose;
195
            return;
196
        }
197
    }
198
199
    $obsoletesyntax = 0;
200
201
    $msg = "";
202
    open(IN,$filename) || die "$filename: Error: cannot open input file $filename";
203
    while (<IN>)
204
    {
205
        s|\r||;
206
        s|//.*$||;
207
        $msg .= $_;
208
    }
209
    close(IN);
210
211
    open(H,">$hfile") || die "$filename: Error: cannot open output file $hfile";
212
    open(CC,">$ccfile") || die "$filename: Error: cannot open output file $ccfile";
213
214
    print H "//\n// Generated file, do not edit! Created by opp_msgc $MSGC_VERSION from $filename.\n//\n\n";
215
    print H "#ifndef $hdef\n";
216
    print H "#define $hdef\n\n";
217
    print H "#include <omnetpp.h>\n";
218
    print H "\n";
219
    print H "// opp_msgc version check\n";
220
    print H "#define MSGC_VERSION $MSGC_VERSION_HEX\n";
221
    print H "#if (MSGC_VERSION!=OMNETPP_VERSION)\n";
222
    print H "#    error Version mismatch! Probably this file was generated by an earlier version of opp_msgc: 'make clean' should help.\n";
223
    print H "#endif\n";
224
    print H "\n";
225
226
    if ($exportdef =~ /^(.*)_API *$/) {
227
        # generate boilerplate code for dll export
228
        my $exportbase = $1;
229
        print H "// dll export symbol\n";
230
        print H "#ifndef $exportdef\n";
231
        print H "#  if defined(${exportbase}_EXPORT)\n";
232
        print H "#    define $exportdef OPP_DLLEXPORT\n";
233
        print H "#  elif defined(${exportbase}_IMPORT)\n";
234
        print H "#    define $exportdef OPP_DLLIMPORT\n";
235
        print H "#  else\n";
236
        print H "#    define $exportdef\n";
237
        print H "#  endif\n";
238
        print H "#endif\n";
239
        print H "\n";
240
    }
241
242
    print CC "//\n// Generated file, do not edit! Created by opp_msgc $MSGC_VERSION from $filename.\n//\n\n";
243
    print CC "// Disable warnings about unused variables, empty switch stmts, etc:\n";
244
    print CC "#ifdef _MSC_VER\n";
245
    print CC "#  pragma warning(disable:4101)\n";
246
    print CC "#  pragma warning(disable:4065)\n";
247
    print CC "#endif\n\n";
248
249
    print CC "#include <iostream>\n";
250
    print CC "#include <sstream>\n";
251
    print CC "#include \"$hfilenamewithoutdir\"\n\n";
252
253
    print CC "// Template rule which fires if a struct or class doesn't have operator<<\n";
254
    print CC "template<typename T>\n";
255
    print CC "std::ostream& operator<<(std::ostream& out,const T&) {return out;}\n";
256
257
    if ($generate_classes)
258
    {
259
        print CC "\n";
260
        print CC "// Another default rule (prevents compiler from choosing base class' doPacking())\n";
261
        print CC "template<typename T>\n";
262
        print CC "void doPacking(cCommBuffer *, T& t) {\n";
263
        print CC "    throw cRuntimeError(\"Parsim error: no doPacking() function for type %s or its base class (check .msg and _m.cc/h files!)\",opp_typename(typeid(t)));\n";
264
        print CC "}\n\n";
265
        print CC "template<typename T>\n";
266
        print CC "void doUnpacking(cCommBuffer *, T& t) {\n";
267
        print CC "    throw cRuntimeError(\"Parsim error: no doUnpacking() function for type %s or its base class (check .msg and _m.cc/h files!)\",opp_typename(typeid(t)));\n";
268
        print CC "}\n";
269
        print CC "\n";
270
    }
271
    print CC "\n\n";
272
273
    # pre-register some OMNeT++ classes so that one doesn't need to announce them
274
    #
275
    # @classes contains fully qualified names (ie with namespace); keys to the other hashes are fully qualified as well
276
    #
277
    # note: $classtype values:
278
    #  'cownedobject' ==> subclasses from cOwnedObject
279
    #  'cnamedobject' ==> subclasses from cNamedObject but NOT from cOwnedObject
280
    #  'cobject'      ==> subclasses from cObject but NOT from cNamedObject
281
    #  'foreign'      ==> non-cObject class (classes announced as "class noncobject" or "extends void")
282
    #  'struct'       ==> struct (no member functions)
283
    #
284
    @classes = ('cObject', 'cNamedObject', 'cOwnedObject', 'cMessage', 'cPacket');
285
    $classtype{'cObject'} = 'cobject';
286
    $classtype{'cNamedObject'} = 'cnamedobject';
287
    $classtype{'cOwnedObject'} = 'cownedobject';
288
    $classtype{'cMessage'} = 'cownedobject';
289
    $classtype{'cPacket'} = 'cownedobject';
290
291
    @enums = ();
292
293
    # some regex patterns
294
    $RESERVED_WORDS = 'namespace|cplusplus|struct|message|packet|class|noncobject|'
295
        . 'enum|extends|abstract|readonly|properties|fields|bool|char|short|'
296
        . 'int|long|double|unsigned|string|true|false'
297
        . 'float|int8|int16|int32|int64|uint8|uint16|uint32|uint64'
298
        . '|int8_t|int16_t|int32_t|int64_t|uint8_t|uint16_t|uint32_t|uint64_t'
299
        . 'for|while|if|else|do|enum|class|struct|typedef|public|private'
300
        . '|protected|auto|register|sizeof|void|new|delete|explicit|static'
301
        . '|extern|return|try|catch';
302
303
    $PRIMITIVE_TYPES = 'bool|float|double|simtime_t|string|((unsigned )?(char|short|int|long))|(u?int(8|16|32|64)(_t)?)';
304
305
    $NAME = '([A-Za-z_][A-Za-z0-9_]*)';  # 1 group
306
    $QNAME = "((::)?($NAME\:\:)*$NAME)"; # 5 groups
307
308
    $CPLUSPLUS_BLOCK = '\bcplusplus\s+{{(.*?)}};?';  # 1 group (contains body)
309
    $NAMESPACE_DECL = '\bnamespace\s+([A-Za-z0-9_:]+)\s*;'; # 1 group (contains name)
310
311
    # encode cplusplus blocks in a copy of msg, so that we don't accidentally match namespace keywords in them
312
    $tmp = $msg;
313
    %cppblocks = {};
314
    $counter = 0;
315
    $tmp =~ s/($CPLUSPLUS_BLOCK)/$cppblocks{++$counter}=$1;"cplusplus-$counter;"/gse;
316
317
    # split file to parts above and below the namespace declaration.
318
    # This is important because the namespace should only apply to cplusplus{{ }}
319
    # blocks after the namespace declaration.
320
    if ($tmp =~ /(.*)$NAMESPACE_DECL(.*)/s ) {
321
        $cpp_above_namespace = $1;
322
        $cpp_below_namespace = $3;
323
    } else {
324
        $cpp_above_namespace = $tmp;
325
        $cpp_below_namespace = '';
326
    }
327
328
    # restore cplusplus blocks in $cpp_above_namespace and $cpp_below_namespace
329
    $cpp_above_namespace =~ s/cplusplus-(\d+);/$cppblocks{$1}/gse;
330
    $cpp_below_namespace =~ s/cplusplus-(\d+);/$cppblocks{$1}/gse;
331
332
    $msg =~ s/$CPLUSPLUS_BLOCK//sg; # cplusplus blocks not needed in $msg any more, remove them
333
334
    # generate cplusplus {{...}} blocks that are above the namespace declaration
335
    while ($cpp_above_namespace =~ s/$CPLUSPLUS_BLOCK//s)
336
    {
337
        my $block = $1;
338
        $block =~ s/^\s*(.*?)\s*$/$1/s; # trim
339
        print H "// cplusplus {{\n";
340
        print H "$block\n";
341
        print H "// }}\n\n";
342
    }
343
    print H "\n";
344
345
    # parse namespace decl
346
    $namespacename = "";
347
    while ($msg =~ s/$NAMESPACE_DECL//s)
348
    {
349
        if ($namespacename ne "") {
350
            print "$filename: Error: multiple namespace declarations\n"; $ret=1;
351
        }
352
353
        $namespacename = $1;
354
355
        if (!($namespacename =~ /^$QNAME$/)) {
356
            print "$filename: Error: wrong syntax in namespace name '$namespacename'\n"; $ret=1;
357
        }
358
359
        $namespacename =~ s/^:://;
360
    }
361
    foreach my $i (split("::", $namespacename)) {
362
        if ($i =~ /^($RESERVED_WORDS)$/) {
363
            print "$filename: Error: namespace name '$i' is a reserved word\n"; $ret=1;
364
        }
365
        print H "namespace $i {\n";
366
        print CC "namespace $i {\n";
367
    }
368
    print H "\n";
369
    print CC "\n";
370
371
    # cplusplus {{...}} blocks below the namespace declaration
372
    while ($cpp_below_namespace =~ s/$CPLUSPLUS_BLOCK//s)
373
    {
374
        my $block = $1;
375
        $block =~ s/^\s*(.*?)\s*$/$1/s; # trim
376
        print H "// cplusplus {{\n";
377
        print H "$block\n";
378
        print H "// }}\n\n";
379
    }
380
381
    # parse imports
382
    while ($msg =~ s/import\s+(".*?");//s)
383
    {
384
        print "$filename: Error: imports are not supported (yet)\n"; $ret=1;
385
    }
386
387
    # parse type announcements
388
    while ($msg =~ s/(struct|class|class\s+noncobject|class\s+cpolymorphic|message|packet)\s+$QNAME(\s+extends\s+$QNAME)?\s*;//s)
389
    {
390
        my $type0 = $1;
391
        my $class = $2;
392
        my $baseclass = $8;
393
394
        my $classqname = canonicalizeQName($namespacename, $class);
395
396
        if ($type0 eq 'struct') {
397
            $type = 'struct';
398
        } elsif ($type0 eq 'message' || $type0 eq 'packet') {
399
            $type = 'cownedobject';
400
        } elsif ($type0 eq 'class') {
401
            if ($baseclass eq '') {
402
                $type = 'cownedobject';
403
            } elsif ($baseclass eq 'void') {
404
                $type = 'foreign';
405
            } else {
406
                $baseclassqname = lookupExistingClassName($namespacename, $baseclass);
407
                if ($baseclassqname eq '') {
408
                    print "$filename: Error: '$class': unknown ancestor class '$baseclass'\n"; $ret=1;
409
                    $type = 'cobject';
410
                } else {
411
                    $type = $classtype{$baseclassqname};
412
                }
413
            }
414
        } elsif ($type0 =~ /class\s+noncobject/) {
415
            $type = 'foreign';
416
            if ($baseclass) {
417
                print "$filename: Error: '$class': the keywords noncobject and extends cannot be used together\n"; $ret=1;
418
            }
419
        } elsif ($type0 =~ /class\s+cpolymorphic/) {
420
            $type = 'cobject';
421
            if ($baseclass) {
422
                 print "$filename: Error: '$class': the keywords cpolymorphic and extends cannot be used together\n"; $ret=1;
423
            }
424
        } else {
425
            die 'invalid type';
426
        }
427
428
        if ($class =~ /^($RESERVED_WORDS)$/) {
429
            print "$filename: Error: type name '$class' is a reserved word\n"; $ret=1;
430
        }
431
        if (grep(/^\Q$classqname\E$/,@classes)) {
432
            if ($classtype{$classqname} ne $type) {
433
                print "$filename: Error: different declarations for '$class' are inconsistent\n"; $ret=1;
434
            }
435
        } else {
436
            #print "DBG: classtype{$type0 $class $baseclass} = $type\n";
437
            $classtype{$classqname} = $type;
438
            push(@classes, $classqname);
439
        }
440
    }
441
442
    # parse enum announcements
443
    while ($msg =~ s/enum\s+$QNAME\s*;//s)
444
    {
445
        $enumname = $1;
446
        $enumqname = canonicalizeQName($namespacename, $enumname);
447
448
        if ($enumname =~ /^($RESERVED_WORDS)$/) {
449
            print "$filename: Error: enum name '$enumname' is a reserved word\n"; $ret=1;
450
        }
451
452
        if (grep(/^\Q$enumqname\E$/,@classes)) {
453
            print "$filename: Error: inconsistent declarations for '$enumname'\n"; $ret=1;
454
        } else {
455
            push(@enums, $enumqname);
456
        }
457
    }
458
459
    # parse enums
460
    while ($msg =~ s/enum\s+([A-Za-z0-9_: \t]+?)\s*{(.*?)};?//s)
461
    {
462
        $source = $&;
463
        $enumhdr = $1;
464
        $fields = $2;
465
466
        if ($enumhdr =~ /^$NAME\s+extends\s+$QNAME$/s)
467
        {
468
            $enumname = "???";
469
            $baseenum = '';
470
            print "$filename: Error: '$enumhdr': enum inheritance is not supported\n"; $ret=1;
471
        }
472
        elsif ($enumhdr =~ /^$NAME$/s)
473
        {
474
            $enumname = $enumhdr;
475
            $baseenum = '';
476
        }
477
        else
478
        {
479
            $enumhdr =~ s/\s+/ /sg;
480
            print "$filename: Error: invalid enum declaration syntax '$enumhdr'\n"; $ret=1;
481
            $enumname = "???";
482
            $baseenum = '';
483
        }
484
485
        if ($enumname =~ /^($RESERVED_WORDS)$/) {
486
            print "$filename: Error: enum name '$enumname' is a reserved word\n"; $ret=1;
487
        }
488
489
        @fieldlist = ();
490
        undef %fval;
491
492
        #
493
        # parse enum { ... } syntax
494
        #
495
        $scrap = '';
496
        while ($fields =~ s/^(.*?);//s)
497
        {
498
            $field = $1;
499
500
            # value
501
            if ($field =~ s/=\s*(.*?)\s*$//s) {
502
                $fieldvalue = $1;
503
            } else {
504
                $fieldvalue = '';
505
            }
506
507
            # identifier
508
            if ($field =~ /^\s*([A-Za-z0-9_]+)\s*$/s) {
509
                $fieldname = $1;
510
            } else {
511
                $scrap .= $field;
512
                print "$filename: Error: missing identifier name in enum $enumname\n"; $ret=1;
513
            }
514
515
            if ($fieldname =~ /^($RESERVED_WORDS)$/) {
516
                print "$filename: Error: enum field name '$fieldname' is a reserved word\n"; $ret=1;
517
            }
518
519
            # store field
520
            push(@fieldlist,$fieldname);
521
            $fval{$fieldname}=$fieldvalue;
522
523
        }
524
        $scrap .= $fields;
525
        if ($scrap =~ /[^ \t\n]/s) {
526
            $scrap =~ s/\n\n+/\n\n/sg;
527
            $scrap =~ s/^\n+//s;
528
            $scrap =~ s/\n+$//s;
529
            print "$filename: Error: some parts not understood in enum $enumname:\n"; $ret=1;
530
            print "'$scrap'\n";
531
        }
532
533
        #
534
        # generate code
535
        #
536
        if (grep(/^\Q$enumname\E$/,@enums)) {
537
            print "$filename: Error: enum '$enumname' already defined\n"; $ret=1;
538
        }
539
        $enumqname = prefixWithNamespace($namespacename, $enumname);
540
        push(@enums, $enumqname);
541
542
        print H "/**\n";
543
        print H " * Enum generated from <tt>$filename</tt> by opp_msgc.\n";
544
        $source =~ s/^/ * /mg;
545
        print H " * <pre>\n$source\n * </pre>\n";
546
        print H " */\n";
547
        print H "enum $enumname {\n";
548
        foreach my $fieldname (@fieldlist)
549
        {
550
            print H "    $fieldname = $fval{$fieldname}";
551
            print H "," unless ($fieldname eq $fieldlist[$#fieldlist]);
552
            print H "\n";
553
        }
554
        print H "};\n\n";
555
556
        print CC "EXECUTE_ON_STARTUP(\n";
557
        print CC "    cEnum *e = cEnum::find(\"$enumqname\");\n";
558
        print CC "    if (!e) enums.getInstance()->add(e = new cEnum(\"$enumqname\"));\n";
559
        # enum inheritance: we should add fields from base enum as well, but that could only be done when importing is in place
560
        foreach my $fieldname (@fieldlist)
561
        {
562
            print CC "    e->insert($fieldname, \"$fieldname\");\n";
563
        }
564
        print CC ");\n\n";
565
566
    }
567
568
    # parse message/packet/class/struct definitions
569
    while ($msg =~ s/(message|packet|class|struct)\s+(.+?)\s*{(.*?)};?//s)
570
    {
571
        #
572
        # parse message { ... } syntax
573
        #
574
        $source = $&;
575
        $keyword = $1;  # 'message', 'packet', 'class' or 'struct'
576
        $msghdr = $2;   # must be "<name>" or "<name> extends <name>"
577
        $body = $3;
578
579
        # reset
580
        @fieldlist = ();
581
        @baseclassfieldlist = ();
582
        undef %fprops;
583
        undef %props;
584
585
        if ($msghdr =~ /^$NAME\s+extends\s+$QNAME$/s)
586
        {
587
            $msgname = $1;
588
            $msgbase = $2;
589
        }
590
        elsif ($msghdr =~ /^$NAME$/s)
591
        {
592
            $msgname = $msghdr;
593
            $msgbase = '';
594
        }
595
        else
596
        {
597
            $msghdr =~ s/\s+/ /sg;
598
            print "$filename: Error: invalid declaration syntax for '$msghdr'\n"; $ret=1;
599
            $msgname = "???";
600
            $msgbase = '';
601
        }
602
603
        if ($msgname =~ /^($RESERVED_WORDS)$/) {
604
            print "$filename: Error: type name '$msgname' is a reserved word\n"; $ret=1;
605
        }
606
607
        $oldstyleproperties = "";
608
        $fieldsandproperties= "";
609
610
        #
611
        # match out part before "fields:" and "properties:"
612
        #
613
        $scrap = $body;
614
        $scrap =~ s/fields:(.*)$//s;
615
        $scrap =~ s/properties:(.*)$//s;
616
        if ($scrap =~ /[^ \t\n]/s)
617
        {
618
            $fieldsandproperties = $scrap;
619
        }
620
621
        #
622
        # match out "properties:" section (old 3.x syntax)
623
        #
624
        if ($body =~ /properties:(.*)$/s)
625
        {
626
            $oldstyleproperties = $1;
627
            $oldstyleproperties =~ s/fields:.*$//s;  # cut off fields section
628
            $obsoletesyntax = 1;
629
        }
630
631
        #
632
        # match out "fields:" section (old 3.x syntax)
633
        #
634
        if ($body =~ /fields:(.*)$/s)
635
        {
636
            $fieldsandproperties.= "\n" . $1;
637
            $obsoletesyntax = 1;
638
        }
639
640
        #
641
        # process $oldstyleproperties (old 3.x syntax)
642
        #
643
        $scrap = '';
644
        while ($oldstyleproperties =~ s/^(.*?);//s)
645
        {
646
            $prop = $1;
647
            if ($prop =~ /^\s*(.*?)\s*=\s*(.*?)\s*$/s)
648
            {
649
                $propname = $1;
650
                $propvalue = $2;
651
                $props{$propname} = $propvalue;
652
653
                if ($propname =~ /^($RESERVED_WORDS)$/) {
654
                    print "$filename: Error: property name '$propname' is a reserved word\n"; $ret=1;
655
                }
656
            }
657
            else {$scrap.=$prop;}
658
        }
659
        $scrap.=$oldstyleproperties;
660
        if ($scrap =~ /[^ \t\n]/s)
661
        {
662
            $scrap =~ s/\n\n+/\n\n/sg;
663
            $scrap =~ s/^\n+//s;
664
            $scrap =~ s/\n+$//s;
665
            print "$filename: Error: some parts not understood in the 'properties' section of '$msgname':\n"; $ret=1;
666
            print "'$scrap'\n";
667
        }
668
669
        #
670
        # process $fieldsandproperties
671
        #
672
        $scrap = '';
673
        while ($fieldsandproperties =~ s/^\s*(.*?)\s*;//s)
674
        {
675
            $fieldorproperty = $1;
676
677
            # is this a property? try it both as @foo(...) and @foo.
678
            # Note: foo() should be same as @foo, i.e. value=""
679
            #XXX property values cannot contain parens "(..)", because regex doesn't count parens, just stops at first ")"...
680
            if ($fieldorproperty =~ s/^\@$NAME\((.*?)\)$//s || $fieldorproperty =~ s/^\@$NAME$()//s) {
681
                # store property
682
                $propname = $1;
683
                $propvalue = $2;
684
                $props{$propname} = unquote($propvalue);
685
686
                if ($propname =~ /^($RESERVED_WORDS)$/) {
687
                    print "$filename: Error: property name '$propname' is a reserved word\n"; $ret=1;
688
                }
689
            }
690
            else {
691
                # parse as field
692
                $field = $fieldorproperty;
693
694
                # field properties, with @propertyname(value) syntax
695
                %fieldprop = ();
696
                $field =~ s|\@([_a-z0-9]+)\((.*?)\)|$fieldprop{$1}=unquote($2);""|gsei;
697
                $field =~ s|\@([_a-z0-9]+)|$fieldprop{$1}="";""|gsei;  # @props and @props() should be equivalent (value="")
698
699
                # abstract
700
                if ($field =~ s/^\s*abstract\s+//s) {
701
                    $isabstract = 1;
702
                    if ($keyword eq 'struct') {
703
                        print "$filename: Error: a struct cannot have abstract fields in '$msgname'\n"; $ret=1;
704
                    }
705
                } else {
706
                    $isabstract = 0;
707
                }
708
709
                #
710
                # NOTE: we cannot properly support 'readonly' fields in opp_msgc,
711
                # because we don't know if a field is new or it's already defined
712
                # in the base class! So we cannot decide we should put it into the
713
                # descriptor class or not.
714
                #
715
                # Implementing proper imports will solve this issue.
716
                #
717
718
                # enum() -- treat it as @enum()
719
                if ($field =~ s/enum\s*\((.*?)\)\s*//s) {
720
                    $fieldprop{"enum"} = $1;
721
                }
722
723
                # default value
724
                if ($field =~ s/=\s*(.*?)\s*$//s) {
725
                    $fieldvalue = $1;
726
                } else {
727
                    $fieldvalue = '';
728
                }
729
730
                # array
731
                if ($field =~ s/\[\s*(.*?)\s*\]\s*$//s) {
732
                    $isarray = 1;
733
                    $arraysize = $1;
734
                    if ($arraysize !~ /^[0-9]*$/ && $arraysize !~ /^[A-Za-z_][A-Za-z0-9_]*$/) {
735
                        print "$filename: Error: array size must be numeric or a symbolic constant (not '$arraysize') in '$msgname'\n"; $ret=1;
736
                    }
737
                    if ($arraysize eq '' && $keyword eq 'struct') {
738
                        print "$filename: Error: a struct cannot have dynamic array fields in '$msgname'\n"; $ret=1;
739
                    }
740
                } else {
741
                    $isarray = 0;
742
                    $arraysize = '';
743
                }
744
745
                # 'fieldtype fieldname'...
746
                if ($field =~ /^\s*([A-Za-z_:][A-Za-z0-9_:* \t\n]*[* \t\n])$NAME\s*$/s)
747
                {
748
                    $fieldtype = $1;
749
                    $fieldname = $2;
750
                    $fieldtype =~ s/\s*$//sg;
751
                    $fieldtype =~ s/\s+/ /sg;
752
753
                    # pointer?
754
                    if ($fieldtype =~ /^(.*?)\s*\*$/) {
755
                        $fieldtype = $1;
756
                        $fieldispointer = 1;
757
                    } else {
758
                        $fieldispointer = 0;
759
                    }
760
761
                    # various checks
762
                    if ($fieldname =~ /^($RESERVED_WORDS)$/) {
763
                        print "$filename: Error: field name '$fieldname' is a reserved word\n"; $ret=1;
764
                    }
765
                    if ($isabstract && $fieldvalue ne '') {
766
                        print "$filename: Error: an abstract field cannot be assigned a value in '$msgname'\n"; $ret=1;
767
                    }
768
769
                    # store
770
                    push(@fieldlist,$fieldname);
771
                    $ftype{$fieldname} = $fieldtype;
772
                    $fispointer{$fieldname} = $fieldispointer;
773
                    $fval{$fieldname} = $fieldvalue;
774
                    $fisabstract{$fieldname} = $isabstract;
775
                    $fisarray{$fieldname} = $isarray;
776
                    $farraysize{$fieldname} = $arraysize;
777
                    #print "$msgname field=$fieldname type=$ftype{$fieldname} value=$fval{$fieldname} isarray=$fisarray{$fieldname} arraysize=$farraysize{$fieldname}\n";
778
                    for $key (keys(%fieldprop)) {
779
                        $fprops{$fieldname}->{$key} = $fieldprop{$key};
780
                        #print "$key => $fprops{$fieldname}->{$key}\n";
781
                    }
782
                }
783
                # ...or just fieldname
784
                elsif ($field =~ /^\s*$NAME\s*$/s)
785
                {
786
                    $fieldname = $1;
787
788
                    # various checks
789
                    if ($fieldname =~ /^($RESERVED_WORDS)$/) {
790
                        print "$filename: Error: field name '$fieldname' is a reserved word\n"; $ret=1;
791
                    }
792
                    if ($isabstract) {
793
                        print "$filename: Error: an abstract field needs a type in '$msgname'\n"; $ret=1;
794
                    }
795
                    if ($isarray) {
796
                        print "$filename: Error: cannot set array field of the base class in '$msgname'\n"; $ret=1;
797
                    }
798
                    if ($fieldenum ne '') {
799
                        print "$filename: Error: cannot specify enum for base class field in '$msgname'\n"; $ret=1;
800
                    }
801
                    if ($fieldvalue eq '') {
802
                        print "$filename: Error: missing field type in '$msgname'\n"; $ret=1;
803
                    }
804
805
                    # store
806
                    push(@baseclassfieldlist,$fieldname);
807
                    $fval{$fieldname} = $fieldvalue;
808
                    #print "$msgname baseclassfield=$fieldname value=$fval{$fieldname}\n";
809
                }
810
                else {$scrap.=$field;}
811
            }
812
        }
813
        $scrap.=$fieldsandproperties;
814
        if ($scrap =~ /[^ \t\n]/s)
815
        {
816
            $scrap =~ s/\n\n+/\n\n/sg;
817
            $scrap =~ s/^\n+//s;
818
            $scrap =~ s/\n+$//s;
819
            print "$filename: Error: some parts not understood in '$msgname':\n"; $ret=1;
820
            print "'$scrap'\n";
821
        }
822
823
        # now generate code
824
        prepareForCodeGeneration();
825
        if ($generate_class) {
826
            if ($classtype eq 'struct') {
827
                generateStruct();
828
            } else {
829
                generateClass();
830
            }
831
        }
832
        if ($generate_descriptor) {
833
            generateDescriptorClass();
834
        }
835
    }
836
837
    if ($obsoletesyntax)
838
    {
839
        print "$filename: Warning: obsolete syntax: convert properties to the '\@' syntax (for example, change customize=true to \@customize(true)), and remove 'properties:' and 'fields:' keywords\n";
840
    }
841
842
    $scrap = $msg;
843
    if ($scrap =~ /[^ \t\n]/s)
844
    {
845
        $scrap =~ s/\n\n+/\n\n/sg;
846
        $scrap =~ s/^\n//s;
847
        $scrap =~ s/\n$//s;
848
        print "$filename: Error: following parts of the input file were not understood:\n"; $ret=1;
849
        print "'$scrap'\n";
850
    }
851
852
    foreach my $i (split("::", $namespacename)) {
853
        print H "}; // end namespace $i\n";
854
        print CC "}; // end namespace $i\n";
855
    }
856
    print H "\n";
857
    print CC "\n";
858
859
    print H "#endif // $hdef\n";
860
861
    close(H);
862
    close(CC);
863
864
    if ($ret)
865
    {
866
        unlink($hfile);
867
        unlink($ccfile);
868
    }
869
}
870
871
872
#
873
# prepare for code generation
874
#
875
# in variables:
876
#
877
#  $keyword
878
#  $classtype
879
#  $gap
880
#  $omitgetverb
881
#  $msgclass
882
#  $realmsgclass
883
#  $msgbaseclass
884
#
885
#  $msgdescclass
886
#
887
#  $fieldcount
888
#  @fieldlist
889
#  %props
890
#
891
#  %ftype{fieldname}
892
#  %ftypeqname{fieldname}
893
#  %fval{fieldname}
894
#  %fisabstract{fieldname}
895
#  %fispointer{$fieldname}
896
#  %fisarray{fieldname}
897
#  %farraysize{fieldname}
898
#  %fsizetype{fieldname}
899
#  %fprops{fieldname}->{propname}
900
#
901
#  %fkind{fieldname}
902
#  %datatype{fieldname}
903
#  %argtype{fieldname}
904
#  %rettype{fieldname}
905
#  %var{fieldname}
906
#  %varsize{fieldname}
907
#  %getter{fieldname}
908
#  %setter{fieldname}
909
#  %alloc{fieldname}
910
#  %getsize{fieldname}
911
#  %tostring{fieldname}
912
#  %fromstring{fieldname}
913
#  %maybe_c_str{fieldname}
914
#
915
916
sub prepareForCodeGeneration()
917
{
918
    $msgqname = prefixWithNamespace($namespacename, $msgname);
919
    $msgbaseqname = lookupExistingClassName($namespacename, $msgbase);
920
921
    # check base class and determine type of object
922
    if ($msgqname eq 'cObject' || $msgqname eq 'cNamedObject' || $msgqname eq 'cOwnedObject') {
923
        $classtype = $classtype{$msgqname};  # only for sim_std.msg
924
    }
925
    elsif ($msgbase eq '') {
926
        if ($keyword eq 'message' or $keyword eq 'packet') {
927
            $classtype = 'cownedobject';
928
        } elsif ($keyword eq 'class') {
929
            $classtype = 'cobject'; # Note: we never generate non-cObject classes
930
        } elsif ($keyword eq 'struct') {
931
            $classtype = 'struct';
932
        } else {
933
            die 'internal error';
934
        }
935
        # if announced earlier as noncpolymorphic, accept that.
936
        if (grep(/^\Q$msgqname\E$/,@classes)) {
937
            if ($classtype{$msgqname} eq 'foreign' && $classtype eq 'cobject') {
938
                $classtype = 'foreign';
939
            }
940
        }
941
    }
942
    elsif ($msgbase eq 'void') {
943
        $classtype = 'foreign';
944
    }
945
    elsif ($msgbaseqname ne '') {
946
        $classtype = $classtype{$msgbaseqname};
947
    }
948
    else {
949
        print "$filename: Error: unknown base class '$msgbase' for '$msgname'\n"; $ret=1;
950
        $classtype = 'cobject';
951
    }
952
953
    # check earlier declarations and register this class
954
    if (grep(/^\Q$msgqname\E$/,@classes)) {
955
        if (0) { # XXX add condition
956
            print "$filename: Error: attempt to redefine '$msgname'\n"; $ret=1;
957
        } elsif ($classtype{$msgqname} ne $classtype) {
958
            print "$filename: Error: definition of '$msgname' inconsistent with earlier declaration(s)\n"; $ret=1;
959
        }
960
    } else {
961
        push(@classes, $msgqname);
962
        $classtype{$msgqname} = $classtype;
963
    }
964
965
    #
966
    # produce all sorts of derived names
967
    #
968
    $generate_class = $generate_classes && !propertyAsBool($props{"existingClass"});
969
    $generate_descriptor = $generate_descriptors && ($props{"descriptor"} ne "false");
970
    $generate_setters_in_descriptor = $generate_setters_in_descriptors && ($props{"descriptor"} ne "readonly");
971
972
    if (propertyAsBool($props{"customize"})) {
973
        $gap = 1;
974
        $msgclass = $msgname."_Base";
975
        $realmsgclass = $msgname;
976
        $msgdescclass = $realmsgclass."Descriptor";
977
    } else {
978
        $gap = 0;
979
        $msgclass = $msgname;
980
        $realmsgclass = $msgname;
981
        $msgdescclass = $msgclass."Descriptor";
982
    }
983
    if ($msgbase eq '') {
984
        if ($msgqname eq 'cObject') {
985
            $msgbaseclass = '';
986
        } elsif ($keyword eq 'message') {
987
            $msgbaseclass = 'cMessage';
988
        } elsif ($keyword eq 'packet') {
989
            $msgbaseclass = 'cPacket';
990
        } elsif ($keyword eq 'class') {
991
            $msgbaseclass = 'cObject';  # note: all classes we generate subclass from cObject!
992
        } elsif ($keyword eq 'struct') {
993
            $msgbaseclass = '';
994
        } else {
995
            die 'internal error';
996
        }
997
    } elsif ($msgbase eq 'void') {
998
        $msgbaseclass = '';
999
    } else {
1000
        $msgbaseclass = $msgbaseqname;
1001
    }
1002
1003
    $omitgetverb = propertyAsBool($props{"omitGetVerb"});
1004
1005
    foreach my $fieldname (@fieldlist)
1006
    {
1007
        if ($fisabstract{$fieldname} && !$gap) {
1008
            print "$filename: Error: abstract fields need '\@customize(true)' property in '$msgname'\n"; $ret=1;
1009
        }
1010
1011
        if ($generate_class) {
1012
           if ($classtype{$ftype{$fieldname}} eq 'cownedobject' && ($classtype ne 'cownedobject')) {
1013
               print "$filename: Error: cannot use cOwnedObject field '$ftype{$fieldname} $fieldname' in struct or non-cOwnedObject class '$msgname'\n"; $ret=1;
1014
           }
1015
        }
1016
1017
        # resolve enum namespace
1018
        my $enumname = $fprops{$fieldname}->{"enum"};
1019
        if (defined($enumname)) {
1020
            my $enumqname = lookupExistingEnumName($namespacename, $enumname);
1021
            if ($enumname ne '' && $enumqname eq '') {
1022
                print "$filename: Error: undeclared enum '$enumname' used in '$msgname'\n"; $ret=1;
1023
            }
1024
            $fprops{$fieldname}->{"enum"} = $enumqname; # need to modify the property in place
1025
        }
1026
1027
        # variable name
1028
        if ($classtype eq 'struct') {
1029
            $var{$fieldname} = $fieldname;
1030
        } else {
1031
            $var{$fieldname} = $fieldname."_var";
1032
        }
1033
1034
        $varsize{$fieldname} = $fieldname."_arraysize";
1035
        my $sizetypeprop = $fprops{$fieldname}->{sizetype};
1036
        $fsizetype{$fieldname} = ($sizetypeprop ne '') ? $sizetypeprop : "unsigned int";
1037
1038
        # method names
1039
        if ($classtype ne 'struct') {
1040
            $capfieldname = $fieldname;
1041
            $capfieldname =~ s/(.)(.*)/uc($1).$2/e;
1042
            $setter{$fieldname} = "set".$capfieldname;
1043
            $alloc{$fieldname} = "set".$capfieldname."ArraySize";
1044
            if ($omitgetverb) {
1045
                $getter{$fieldname} = $fieldname;
1046
                $getsize{$fieldname} = $fieldname."ArraySize";
1047
            } else {
1048
                $getter{$fieldname} = "get".$capfieldname;
1049
                $getsize{$fieldname} = "get".$capfieldname."ArraySize";
1050
            }
1051
1052
            # allow customization of names
1053
            if ($fprops{$fieldname}->{setter} ne '') {
1054
                $setter{$fieldname} = $fprops{$fieldname}->{setter};
1055
            }
1056
            if ($fprops{$fieldname}->{getter} ne '') {
1057
                $getter{$fieldname} = $fprops{$fieldname}->{getter};
1058
            }
1059
            if ($fprops{$fieldname}->{sizeSetter} ne '') {
1060
                $alloc{$fieldname} = $fprops{$fieldname}->{sizeSetter};
1061
            }
1062
            if ($fprops{$fieldname}->{sizeGetter} ne '') {
1063
                $getsize{$fieldname} = $fprops{$fieldname}->{sizeGetter};
1064
            }
1065
        }
1066
1067
        $ftype = $ftype{$fieldname};
1068
1069
        # determine field data type
1070
        if ($ftype =~ /^($PRIMITIVE_TYPES)$/) {
1071
            $fkind{$fieldname} = 'basic';
1072
            $ftypeqname = '';
1073
        }
1074
        else {
1075
            $fkind{$fieldname} = 'struct';
1076
            $ftypeqname = lookupExistingClassName($namespacename, $ftype);
1077
            if ($ftypeqname eq '') {
1078
                print "$filename: Error: unknown type $ftype for field '$fieldname' in '$msgname'\n"; $ret=1;
1079
            }
1080
        }
1081
        $ftypeqname{$fieldname} = $ftypeqname;
1082
1083
        # data type, argument type, conversion to/from string...
1084
        $maybe_c_str{$fieldname} = "";
1085
        if ($fkind{$fieldname} eq 'struct') {
1086
            $datatype{$fieldname} = "\:\:$ftypeqname"; # fully qualified absolute namespace, to remove ambiguity of how we understood the type
1087
            $argtype{$fieldname} = "const $ftype&";
1088
            $rettype{$fieldname} = "$ftype&";
1089
            $tostring{$fieldname} = "";
1090
            $fromstring{$fieldname} = "";
1091
            #$fval{$fieldname} = '' unless ($fval{$fieldname} ne '');
1092
        } elsif ($fkind{$fieldname} eq 'basic') {
1093
            # defaults:
1094
            $datatype{$fieldname} = $ftype;
1095
            $argtype{$fieldname} = $ftype;
1096
            $rettype{$fieldname} = $ftype;
1097
            $fval{$fieldname} = '0' unless ($fval{$fieldname} ne '');
1098
1099
            if ($ftype eq "bool") {
1100
                # $datatype, $argtype, $rettype: default (same as $ftype)
1101
                $tostring{$fieldname} = "bool2string";
1102
                $fromstring{$fieldname} = "string2bool";
1103
                $fval{$fieldname} = 'false' unless ($fval{$fieldname} ne '');
1104
            } elsif ($ftype =~ /^(char|short|int|long|int8|int16|int32|int8_t|int16_t|int32_t)$/) {
1105
                # $datatype, $argtype, $rettype, $fval: default (same as $ftype)
1106
                $tostring{$fieldname} = "long2string";
1107
                $fromstring{$fieldname} = "string2long";
1108
            } elsif ($ftype =~ /^unsigned (char|short|int|long)$/) {
1109
                # $datatype, $argtype, $rettype, $fval: default (same as $ftype)
1110
                $tostring{$fieldname} = "ulong2string";
1111
                $fromstring{$fieldname} = "string2ulong";
1112
            } elsif ($ftype =~ /^(uint8|uint16|uint32|uint8_t|uint16_t|uint32_t)$/) {
1113
                # $datatype, $argtype, $rettype, $fval: default (same as $ftype)
1114
                $tostring{$fieldname} = "ulong2string";
1115
                $fromstring{$fieldname} = "string2ulong";
1116
            } elsif ($ftype =~ /^(int64|int64_t)$/) {
1117
                # $datatype, $argtype, $rettype, $fval: default (same as $ftype)
1118
                $tostring{$fieldname} = "int642string";
1119
                $fromstring{$fieldname} = "string2int64";
1120
            } elsif ($ftype =~ /^(uint64|uint64_t)$/) {
1121
                # $datatype, $argtype, $rettype, $fval: default (same as $ftype)
1122
                $tostring{$fieldname} = "uint642string";
1123
                $fromstring{$fieldname} = "string2uint64";
1124
            } elsif ($ftype eq "float") {
1125
                # $datatype, $argtype, $rettype, $fval: default (same as $ftype)
1126
                $tostring{$fieldname} = "double2string";
1127
                $fromstring{$fieldname} = "string2double";
1128
            } elsif ($ftype eq "double") {
1129
                # $datatype, $argtype, $rettype, $fval: default (same as $ftype)
1130
                $tostring{$fieldname} = "double2string";
1131
                $fromstring{$fieldname} = "string2double";
1132
            } elsif ($ftype eq "simtime_t") {
1133
                # $datatype, $argtype, $rettype, $fval: default (same as $ftype)
1134
                $tostring{$fieldname} = "double2string";
1135
                $fromstring{$fieldname} = "string2double";
1136
            } elsif ($ftype eq "string") {
1137
                $datatype{$fieldname} = "opp_string";
1138
                $argtype{$fieldname} = "const char *";
1139
                $rettype{$fieldname} = "const char *";
1140
                $tostring{$fieldname} = "oppstring2string";
1141
                $fromstring{$fieldname} = "";
1142
                $fval{$fieldname} = '""' unless ($fval{$fieldname} ne '');
1143
                $maybe_c_str{$fieldname} = ".c_str()";
1144
            } else {
1145
                die "internal error - unknown primitive data type '$ftype'";
1146
            }
1147
        } else {
1148
            die 'internal error';
1149
        }
1150
    }
1151
}
1152
1153
1154
#
1155
# print class
1156
#
1157
sub generateClass
1158
{
1159
    print H "/**\n";
1160
    print H " * Class generated from <tt>$filename</tt> by opp_msgc.\n";
1161
    $source =~ s/^/ * /mg;
1162
    print H " * <pre>\n$source\n * </pre>\n";
1163
1164
    if ($gap)
1165
    {
1166
        print H " *\n";
1167
        print H " * $msgclass is only useful if it gets subclassed, and $realmsgclass is derived from it.\n";
1168
        print H " * The minimum code to be written for $realmsgclass is the following:\n";
1169
        print H " *\n";
1170
        print H " * <pre>\n";
1171
        print H " * class $exportdef$realmsgclass : public $msgclass\n";
1172
        print H " * {\n";
1173
        print H " *   public:\n";
1174
        if ($classtype eq "cownedobject") {
1175
            if ($keyword eq "message" or $keyword eq "packet") {
1176
                print H " *     $realmsgclass(const char *name=NULL, int kind=0) : $msgclass(name,kind) {}\n";
1177
            } else {
1178
                print H " *     $realmsgclass(const char *name=NULL) : $msgclass(name) {}\n";
1179
            }
1180
            print H " *     $realmsgclass(const $realmsgclass& other) : $msgclass(other.getName()) {operator=(other);}\n";
1181
        } else {
1182
            print H " *     $realmsgclass() : $msgclass() {}\n";
1183
            print H " *     $realmsgclass(const $realmsgclass& other) : $msgclass() {operator=(other);}\n";
1184
        }
1185
        print H " *     $realmsgclass& operator=(const $realmsgclass& other) {$msgclass\:\:operator=(other); return *this;}\n";
1186
        if ($classtype eq "cownedobject" || $classtype eq "cnamedobject" || $classtype eq "cobject") {
1187
            print H " *     virtual $realmsgclass *dup() const {return new $realmsgclass(*this);}\n";
1188
        }
1189
        print H " *     // ADD CODE HERE to redefine and implement pure virtual functions from $msgclass\n";
1190
        print H " * };\n";
1191
        print H " * </pre>\n";
1192
        if ($classtype eq "cownedobject" || $classtype eq "cnamedobject" || $classtype eq "cobject") {
1193
            print H " *\n";
1194
            print H " * The following should go into a .cc (.cpp) file:\n";
1195
            print H " *\n";
1196
            print H " * <pre>\n";
1197
            print H " * Register_Class($realmsgclass);\n";
1198
            print H " * </pre>\n";
1199
        }
1200
    }
1201
    print H " */\n";
1202
    if ($msgbaseclass eq "") {
1203
        print H "class $exportdef$msgclass\n";
1204
    } else {
1205
        print H "class $exportdef$msgclass : public \:\:$msgbaseclass\n";  # make namespace explicit and absolute to disambiguate the way opp_msgc understood it
1206
    }
1207
    print H "{\n";
1208
    print H "  protected:\n";
1209
    foreach my $fieldname (@fieldlist)
1210
    {
1211
        if ($fispointer{$fieldname}) {
1212
            print "$filename: Error: pointers not supported yet in '$msgname'\n"; $ret=1; return;
1213
        }
1214
        if (!$fisabstract{$fieldname}) {
1215
            if ($fisarray{$fieldname} && $farraysize{$fieldname} ne '') {
1216
                print H "    $datatype{$fieldname} $var{$fieldname}\[$farraysize{$fieldname}\];\n";
1217
            } elsif ($fisarray{$fieldname} && $farraysize{$fieldname} eq '') {
1218
                print H "    $datatype{$fieldname} *$var{$fieldname}; // array ptr\n";
1219
                print H "    $fsizetype{$fieldname} $varsize{$fieldname};\n";
1220
            } else {
1221
                print H "    $datatype{$fieldname} $var{$fieldname};\n";
1222
            }
1223
        }
1224
    }
1225
    print H "\n";
1226
    print H "    // protected and unimplemented operator==(), to prevent accidental usage\n";
1227
    print H "    bool operator==(const $msgclass&);\n";
1228
    if ($gap) {
1229
        print H "    // make constructors protected to avoid instantiation\n";
1230
    } else {
1231
        print H "\n";
1232
        print H "  public:\n";
1233
    }
1234
    if ($classtype eq "cownedobject") {
1235
        if ($keyword eq "message" or $keyword eq "packet") {
1236
            print H "    $msgclass(const char *name=NULL, int kind=0);\n";
1237
        } else {
1238
            print H "    $msgclass(const char *name=NULL);\n";
1239
        }
1240
    } else {
1241
        print H "    $msgclass();\n";
1242
    }
1243
    print H "    $msgclass(const $msgclass& other);\n";
1244
    if ($gap) {
1245
        print H "    // make assignment operator protected to force the user override it\n";
1246
        print H "    $msgclass& operator=(const $msgclass& other);\n";
1247
        print H "\n";
1248
        print H "  public:\n";
1249
    }
1250
    print H "    virtual ~$msgclass();\n";
1251
    if (!$gap) {
1252
        print H "    $msgclass& operator=(const $msgclass& other);\n";
1253
    }
1254
    if ($gap) {
1255
        print H "    virtual $msgclass *dup() const {throw cRuntimeError(\"You forgot to manually add a dup() function to class $realmsgclass\");}\n";
1256
    } else {
1257
        print H "    virtual $msgclass *dup() const {return new $msgclass(*this);}\n";
1258
    }
1259
    print H "    virtual void parsimPack(cCommBuffer *b);\n";
1260
    print H "    virtual void parsimUnpack(cCommBuffer *b);\n";
1261
    print H "\n";
1262
    print H "    // field getter/setter methods\n";
1263
    foreach my $fieldname (@fieldlist)
1264
    {
1265
        if ($fisabstract{$fieldname}) {
1266
            $pure = ' = 0';
1267
        } else {
1268
            $pure = '';
1269
        }
1270
        $isstruct = ($fkind{$fieldname} eq 'struct');
1271
        $constifprimitivetype = (!$isstruct ? ' const' : '');
1272
        if ($fisarray{$fieldname} && $farraysize{$fieldname} ne '') {
1273
            print H "    virtual $fsizetype{$fieldname} $getsize{$fieldname}() const$pure;\n";
1274
            print H "    virtual $rettype{$fieldname} $getter{$fieldname}($fsizetype{$fieldname} k)$constifprimitivetype$pure;\n";
1275
            print H "    virtual const $rettype{$fieldname} $getter{$fieldname}($fsizetype{$fieldname} k) const {return const_cast<$msgclass*>(this)->$getter{$fieldname}(k);}\n" if ($isstruct);
1276
            print H "    virtual void $setter{$fieldname}($fsizetype{$fieldname} k, $argtype{$fieldname} $var{$fieldname})$pure;\n";
1277
        } elsif ($fisarray{$fieldname} && $farraysize{$fieldname} eq '') {
1278
            print H "    virtual void $alloc{$fieldname}($fsizetype{$fieldname} size)$pure;\n";
1279
            print H "    virtual $fsizetype{$fieldname} $getsize{$fieldname}() const$pure;\n";
1280
            print H "    virtual $rettype{$fieldname} $getter{$fieldname}($fsizetype{$fieldname} k)$constifprimitivetype$pure;\n";
1281
            print H "    virtual const $rettype{$fieldname} $getter{$fieldname}($fsizetype{$fieldname} k) const {return const_cast<$msgclass*>(this)->$getter{$fieldname}(k);}\n" if ($isstruct);
1282
            print H "    virtual void $setter{$fieldname}($fsizetype{$fieldname} k, $argtype{$fieldname} $var{$fieldname})$pure;\n";
1283
        } else {
1284
            print H "    virtual $rettype{$fieldname} $getter{$fieldname}()$constifprimitivetype$pure;\n";
1285
            print H "    virtual const $rettype{$fieldname} $getter{$fieldname}() const {return const_cast<$msgclass*>(this)->$getter{$fieldname}();}\n" if ($isstruct);
1286
            print H "    virtual void $setter{$fieldname}($argtype{$fieldname} $var{$fieldname})$pure;\n";
1287
        }
1288
    }
1289
    print H "};\n\n";
1290
1291
    if (!$gap) {
1292
        if ($classtype eq "cownedobject" || $classtype eq "cnamedobject" || $classtype eq "cobject") {
1293
            print CC "Register_Class($msgclass);\n\n";
1294
        }
1295
        print H "inline void doPacking(cCommBuffer *b, $realmsgclass& obj) {obj.parsimPack(b);}\n";
1296
        print H "inline void doUnpacking(cCommBuffer *b, $realmsgclass& obj) {obj.parsimUnpack(b);}\n\n";
1297
    }
1298
1299
    if ($classtype eq "cownedobject") {
1300
        if ($keyword eq "message" or $keyword eq "packet") {
1301
            # CAREFUL when assigning values to existing members gets implemented!
1302
            # The msg kind passed to the ctor should take priority!!!
1303
            print CC "$msgclass\:\:$msgclass(const char *name, int kind) : $msgbaseclass(name,kind)\n";
1304
        } else {
1305
            if ($msgbaseclass eq "") {
1306
                print CC "$msgclass\:\:$msgclass(const char *name)\n";
1307
            } else {
1308
                print CC "$msgclass\:\:$msgclass(const char *name) : $msgbaseclass(name)\n";
1309
            }
1310
        }
1311
    } else {
1312
        if ($msgbaseclass eq "") {
1313
            print CC "$msgclass\:\:$msgclass()\n";
1314
        } else {
1315
            print CC "$msgclass\:\:$msgclass() : $msgbaseclass()\n";
1316
        }
1317
    }
1318
    print CC "{\n";
1319
    #print CC "    (void)static_cast<cObject *>(this); //sanity check\n" if ($fieldclasstype eq 'cobject');
1320
    #print CC "    (void)static_cast<cNamedObject *>(this); //sanity check\n" if ($fieldclasstype eq 'cnamedobject');
1321
    #print CC "    (void)static_cast<cOwnedObject *>(this); //sanity check\n" if ($fieldclasstype eq 'cownedobject');
1322
    foreach my $fieldname (@baseclassfieldlist)
1323
    {
1324
        $capfieldname = $fieldname;
1325
        $capfieldname =~ s/(.)(.*)/uc($1).$2/e;
1326
        $setter = "set".$capfieldname;
1327
        print CC "    this->$setter($fval{$fieldname});\n";
1328
    }
1329
    print CC "\n" if (@baseclassfieldlist!=() && @fieldlist!=());
1330
    foreach my $fieldname (@fieldlist)
1331
    {
1332
        if (!$fisabstract{$fieldname}) {
1333
            if ($fisarray{$fieldname} && $farraysize{$fieldname} ne '') {
1334
                if ($fkind{$fieldname} eq 'basic') {
1335
                    print CC "    for ($fsizetype{$fieldname} i=0; i<$farraysize{$fieldname}; i++)\n";
1336
                    print CC "        this->$var{$fieldname}\[i\] = $fval{$fieldname};\n";
1337
                }
1338
                if ($classtype{$ftype{$fieldname}} eq 'cownedobject') {
1339
                  print CC "    for ($fsizetype{$fieldname} i=0; i<$farraysize{$fieldname}; i++)\n";
1340
                  print CC "        take(&(this->$var{$fieldname}\[i\]));\n";
1341
                }
1342
            } elsif ($fisarray{$fieldname} && $farraysize{$fieldname} eq '') {
1343
                print CC "    $varsize{$fieldname} = 0;\n";
1344
                print CC "    this->$var{$fieldname} = 0;\n";
1345
            } else {
1346
                if ($fval{$fieldname} ne '') {
1347
                  print CC "    this->$var{$fieldname} = $fval{$fieldname};\n";
1348
                }
1349
                if ($classtype{$ftype{$fieldname}} eq 'cownedobject') {
1350
                  print CC "    take(&(this->$var{$fieldname}));\n";
1351
                }
1352
            }
1353
        }
1354
    }
1355
    print CC "}\n\n";
1356
    if ($msgbaseclass eq "") {
1357
        print CC "$msgclass\:\:$msgclass(const $msgclass& other)\n";
1358
    } else {
1359
        print CC "$msgclass\:\:$msgclass(const $msgclass& other) : $msgbaseclass()\n";
1360
    }
1361
    print CC "{\n";
1362
    if ($classtype eq "cownedobject") {
1363
        print CC "    setName(other.getName());\n";
1364
    }
1365
    foreach my $fieldname (@fieldlist)
1366
    {
1367
      if (!$fisabstract{$fieldname}) {
1368
        if ($fisarray{$fieldname} && $farraysize{$fieldname} ne '') {
1369
          if ($classtype{$ftype{$fieldname}} eq 'cownedobject') {
1370
            print CC "    for ($fsizetype{$fieldname} i=0; i<$farraysize{$fieldname}; i++)\n";
1371
            print CC "        take(&(this->$var{$fieldname}\[i\]));\n";
1372
          }
1373
        } elsif ($fisarray{$fieldname} && $farraysize{$fieldname} eq '') {
1374
          print CC "    $varsize{$fieldname} = 0;\n";
1375
          print CC "    this->$var{$fieldname} = 0;\n";
1376
        } elsif (!$fisarray{$fieldname} && $classtype{$ftype{$fieldname}} eq 'cownedobject') {
1377
          print CC "    take(&(this->$var{$fieldname}));\n";
1378
        }
1379
      }
1380
    }
1381
    print CC "    operator=(other);\n";
1382
    print CC "}\n\n";
1383
    print CC "$msgclass\:\:~$msgclass()\n";
1384
    print CC "{\n";
1385
    foreach my $fieldname (@fieldlist)
1386
    {
1387
        if (!$fisabstract{$fieldname}) {
1388
            if ($classtype{$ftype{$fieldname}} eq 'cownedobject') {
1389
                if (!$fisarray{$fieldname}) {
1390
                    print CC "    drop(&(this->$var{$fieldname}));\n";
1391
                } elsif ($farraysize{$fieldname} ne '') {
1392
                    print CC "    for ($fsizetype{$fieldname} i=0; i<$farraysize{$fieldname}; i++)\n";
1393
                    print CC "        drop(&(this->$var{$fieldname}\[i\]));\n";
1394
                } else {
1395
                    print CC "    for ($fsizetype{$fieldname} i=0; i<$varsize{$fieldname}; i++)\n";
1396
                    print CC "        drop(&(this->$var{$fieldname}\[i\]));\n";
1397
                }
1398
            }
1399
            if ($fisarray{$fieldname} && $farraysize{$fieldname} eq '') {
1400
                print CC "    delete [] $var{$fieldname};\n";
1401
            }
1402
        }
1403
    }
1404
    print CC "}\n\n";
1405
    print CC "$msgclass& $msgclass\:\:operator=(const $msgclass& other)\n";
1406
    print CC "{\n";
1407
    print CC "    if (this==&other) return *this;\n";
1408
    if ($msgbaseclass ne "") {
1409
        print CC "    $msgbaseclass\:\:operator=(other);\n";
1410
    }
1411
    foreach my $fieldname (@fieldlist)
1412
    {
1413
        if (!$fisabstract{$fieldname}) {
1414
            if ($fisarray{$fieldname} && $farraysize{$fieldname} ne '') {
1415
                print CC "    for ($fsizetype{$fieldname} i=0; i<$farraysize{$fieldname}; i++)\n";
1416
                print CC "        this->$var{$fieldname}\[i\] = other.$var{$fieldname}\[i\];\n";
1417
                if ($classtype{$ftype{$fieldname}} eq 'cownedobject') {
1418
                    print CC "    for ($fsizetype{$fieldname} i=0; i<$farraysize{$fieldname}; i++)\n";
1419
                    print CC "        this->$var{$fieldname}\[i\].setName(other.$var{$fieldname}\[i\].getName());\n";
1420
                }
1421
            } elsif ($fisarray{$fieldname} && $farraysize{$fieldname} eq '') {
1422
                print CC "    delete [] this->$var{$fieldname};\n";
1423
                print CC "    this->$var{$fieldname} = (other.$varsize{$fieldname}==0) ? NULL : new $datatype{$fieldname}\[other.$varsize{$fieldname}\];\n";
1424
                print CC "    $varsize{$fieldname} = other.$varsize{$fieldname};\n";
1425
                print CC "    for ($fsizetype{$fieldname} i=0; i<$varsize{$fieldname}; i++)\n";
1426
                if ($classtype{$ftype{$fieldname}} eq 'cownedobject') {
1427
                    print CC "    {\n";
1428
                    print CC "        take(&(this->$var{$fieldname}\[i\]));\n";
1429
                    print CC "        this->$var{$fieldname}\[i\] = other.$var{$fieldname}\[i\];\n";
1430
                    print CC "        this->$var{$fieldname}\[i\].setName(other.$var{$fieldname}\[i\].getName());\n";
1431
                    print CC "    }\n";
1432
                } else {
1433
                    print CC "        this->$var{$fieldname}\[i\] = other.$var{$fieldname}\[i\];\n";
1434
                }
1435
            } else {
1436
                print CC "    this->$var{$fieldname} = other.$var{$fieldname};\n";
1437
                if (!$fisarray{$fieldname} && $classtype{$ftype{$fieldname}} eq 'cownedobject') {
1438
                    print CC "    this->$var{$fieldname}.setName(other.$var{$fieldname}.getName());\n";
1439
                }
1440
            }
1441
        }
1442
    }
1443
    print CC "    return *this;\n";
1444
    print CC "}\n\n";
1445
1446
    #
1447
    # Note: This class may not be derived from cOwnedObject, and then this parsimPack()/
1448
    # parsimUnpack() is NOT that of cOwnedObject. However it's still needed because a
1449
    # "friend" doPacking() function could not access protected members otherwise.
1450
    #
1451
    print CC "void $msgclass\:\:parsimPack(cCommBuffer *b)\n";
1452
    print CC "{\n";
1453
    if ($msgbaseclass ne "") {
1454
        if ($classtype eq "cownedobject" || $classtype eq "cnamedobject" || $classtype eq "cobject") {
1455
            print CC "    $msgbaseclass\:\:parsimPack(b);\n" unless ($msgbaseclass eq "cObject");
1456
        } else {
1457
            print CC "    doPacking(b,($msgbaseclass&)*this);\n"; # this would do for cOwnedObject too, but the other is nicer
1458
        }
1459
    }
1460
    foreach my $fieldname (@fieldlist)
1461
    {
1462
        if (propertyAsBool($fprops{$fieldname}->{nopack})) {
1463
            # @nopack specified
1464
        } elsif ($fisabstract{$fieldname}) {
1465
            print CC "    // field $fieldname is abstract -- please do packing in customized class\n";
1466
        } else {
1467
            if ($fisarray{$fieldname} && $farraysize{$fieldname} ne '') {
1468
                print CC "    doPacking(b,this->$var{$fieldname},$farraysize{$fieldname});\n";
1469
            } elsif ($fisarray{$fieldname} && $farraysize{$fieldname} eq '') {
1470
                print CC "    b->pack($varsize{$fieldname});\n";
1471
                print CC "    doPacking(b,this->$var{$fieldname},$varsize{$fieldname});\n";
1472
            } else {
1473
                print CC "    doPacking(b,this->$var{$fieldname});\n";
1474
            }
1475
        }
1476
    }
1477
    print CC "}\n\n";
1478
1479
    print CC "void $msgclass\:\:parsimUnpack(cCommBuffer *b)\n";
1480
    print CC "{\n";
1481
    if ($msgbaseclass ne "") {
1482
        if ($classtype eq "cownedobject" || $classtype eq "cnamedobject" || $classtype eq "cobject") {
1483
            print CC "    $msgbaseclass\:\:parsimUnpack(b);\n" unless ($msgbaseclass eq "cObject");
1484
        } else {
1485
            print CC "    doUnpacking(b,($msgbaseclass&)*this);\n"; # this would do for cOwnedObject too, but the other is nicer
1486
        }
1487
    }
1488
    foreach my $fieldname (@fieldlist)
1489
    {
1490
        if (propertyAsBool($fprops{$fieldname}->{nopack})) {
1491
            # @nopack specified
1492
        } elsif ($fisabstract{$fieldname}) {
1493
            print CC "    // field $fieldname is abstract -- please do unpacking in customized class\n";
1494
        } else {
1495
            if ($fisarray{$fieldname} && $farraysize{$fieldname} ne '') {
1496
                print CC "    doUnpacking(b,this->$var{$fieldname},$farraysize{$fieldname});\n";
1497
            } elsif ($fisarray{$fieldname} && $farraysize{$fieldname} eq '') {
1498
                print CC "    delete [] this->$var{$fieldname};\n";
1499
                print CC "    b->unpack($varsize{$fieldname});\n";
1500
                print CC "    if ($varsize{$fieldname}==0) {\n";
1501
                print CC "        this->$var{$fieldname} = 0;\n";
1502
                print CC "    } else {\n";
1503
                print CC "        this->$var{$fieldname} = new $datatype{$fieldname}\[$varsize{$fieldname}\];\n";
1504
                print CC "        doUnpacking(b,this->$var{$fieldname},$varsize{$fieldname});\n";
1505
                print CC "    }\n";
1506
            } else {
1507
                print CC "    doUnpacking(b,this->$var{$fieldname});\n";
1508
            }
1509
        }
1510
    }
1511
    print CC "}\n\n";
1512
1513
    foreach my $fieldname (@fieldlist)
1514
    {
1515
        if (!$fisabstract{$fieldname}) {
1516
            $isstruct = ($fkind{$fieldname} eq 'struct');
1517
            $constifprimitivetype = (!$isstruct ? ' const' : '');
1518
            if ($fisarray{$fieldname} && $farraysize{$fieldname} ne '') {
1519
                print CC "$fsizetype{$fieldname} $msgclass\:\:$getsize{$fieldname}() const\n";
1520
                print CC "{\n";
1521
                print CC "    return $farraysize{$fieldname};\n";
1522
                print CC "}\n\n";
1523
                print CC "$rettype{$fieldname} $msgclass\:\:$getter{$fieldname}($fsizetype{$fieldname} k)$constifprimitivetype\n";
1524
                print CC "{\n";
1525
                print CC "    if (k>=$farraysize{$fieldname}) throw cRuntimeError(\"Array of size $farraysize{$fieldname} indexed by \%lu\", (unsigned long)k);\n";
1526
                print CC "    return $var{$fieldname}\[k\]$maybe_c_str{$fieldname};\n";
1527
                print CC "}\n\n";
1528
                print CC "void $msgclass\:\:$setter{$fieldname}($fsizetype{$fieldname} k, $argtype{$fieldname} $var{$fieldname})\n";
1529
                print CC "{\n";
1530
                print CC "    if (k>=$farraysize{$fieldname}) throw cRuntimeError(\"Array of size $farraysize{$fieldname} indexed by \%lu\", (unsigned long)k);\n";
1531
                print CC "    this->$var{$fieldname}\[k\] = $var{$fieldname};\n";
1532
                print CC "}\n\n";
1533
            } elsif ($fisarray{$fieldname} && $farraysize{$fieldname} eq '') {
1534
                print CC "void $msgclass\:\:$alloc{$fieldname}($fsizetype{$fieldname} size)\n";
1535
                print CC "{\n";
1536
                print CC "    $datatype{$fieldname} *$var{$fieldname}2 = (size==0) ? NULL : new $datatype{$fieldname}\[size\];\n";
1537
                print CC "    $fsizetype{$fieldname} sz = $varsize{$fieldname} < size ? $varsize{$fieldname} : size;\n";
1538
                print CC "    for ($fsizetype{$fieldname} i=0; i<sz; i++)\n";
1539
                print CC "        $var{$fieldname}2\[i\] = this->$var{$fieldname}\[i\];\n";
1540
                if ($fkind{$fieldname} eq 'basic') {
1541
                    print CC "    for ($fsizetype{$fieldname} i=sz; i<size; i++)\n";
1542
                    print CC "        $var{$fieldname}2\[i\] = 0;\n";
1543
                }
1544
                if ($classtype{$ftype{$fieldname}} eq 'cownedobject') {
1545
                    print CC "    for ($fsizetype{$fieldname} i=sz; i<size; i++)\n";
1546
                    print CC "        take(&($var{$fieldname}2\[i\]));\n";
1547
                }
1548
                print CC "    $varsize{$fieldname} = size;\n";
1549
                print CC "    delete [] this->$var{$fieldname};\n";
1550
                print CC "    this->$var{$fieldname} = $var{$fieldname}2;\n";
1551
                print CC "}\n\n";
1552
                print CC "$fsizetype{$fieldname} $msgclass\:\:$getsize{$fieldname}() const\n";
1553
                print CC "{\n";
1554
                print CC "    return $varsize{$fieldname};\n";
1555
                print CC "}\n\n";
1556
                print CC "$rettype{$fieldname} $msgclass\:\:$getter{$fieldname}($fsizetype{$fieldname} k)$constifprimitivetype\n";
1557
                print CC "{\n";
1558
                print CC "    if (k>=$varsize{$fieldname}) throw cRuntimeError(\"Array of size \%d indexed by \%d\", $varsize{$fieldname}, k);\n";
1559
                print CC "    return $var{$fieldname}\[k\]$maybe_c_str{$fieldname};\n";
1560
                print CC "}\n\n";
1561
                print CC "void $msgclass\:\:$setter{$fieldname}($fsizetype{$fieldname} k, $argtype{$fieldname} $var{$fieldname})\n";
1562
                print CC "{\n";
1563
                print CC "    if (k>=$varsize{$fieldname}) throw cRuntimeError(\"Array of size \%d indexed by \%d\", $varsize{$fieldname}, k);\n";
1564
                print CC "    this->$var{$fieldname}\[k\]=$var{$fieldname};\n";
1565
                print CC "}\n\n";
1566
            } else {
1567
                print CC "$rettype{$fieldname} $msgclass\:\:$getter{$fieldname}()$constifprimitivetype\n";
1568
                print CC "{\n";
1569
                print CC "    return $var{$fieldname}$maybe_c_str{$fieldname};\n";
1570
                print CC "}\n\n";
1571
                print CC "void $msgclass\:\:$setter{$fieldname}($argtype{$fieldname} $var{$fieldname})\n";
1572
                print CC "{\n";
1573
                print CC "    this->$var{$fieldname} = $var{$fieldname};\n";
1574
                print CC "}\n\n";
1575
            }
1576
        }
1577
    }
1578
}
1579
1580
1581
#
1582
# print struct
1583
#
1584
sub generateStruct
1585
{
1586
    print H "/**\n";
1587
    print H " * Struct generated from $filename by opp_msgc.\n";
1588
    print H " */\n";
1589
    if ($msgbaseclass eq "") {
1590
        print H "struct $exportdef$msgclass\n";
1591
    } else {
1592
        print H "struct $exportdef$msgclass : public $msgbaseclass\n";
1593
    }
1594
    print H "{\n";
1595
    print H "    $msgclass();\n";
1596
    foreach my $fieldname (@fieldlist)
1597
    {
1598
        if ($fisarray{$fieldname}) {
1599
            print H "    $datatype{$fieldname} $var{$fieldname}\[$farraysize{$fieldname}\];\n";
1600
        } else {
1601
            print H "    $datatype{$fieldname} $var{$fieldname};\n";
1602
        }
1603
    }
1604
    print H "};\n\n";
1605
1606
    print H "void $exportdef"."doPacking(cCommBuffer *b, $msgclass& a);\n";
1607
    print H "void $exportdef"."doUnpacking(cCommBuffer *b, $msgclass& a);\n\n";
1608
1609
    print CC "$msgclass\:\:$msgclass()\n";
1610
    print CC "{\n";
1611
    foreach my $fieldname (@baseclassfieldlist)
1612
    {
1613
        print CC "    this->$fieldname = $fval{$fieldname};\n";
1614
    }
1615
    print CC "\n" if (@baseclassfieldlist!=() && @fieldlist!=());
1616
    foreach my $fieldname (@fieldlist)
1617
    {
1618
        die "abstract field not possible in struct" if ($fisabstract{$fieldname});
1619
        die "cOwnedObject field not possible in struct" if ($classtype{$ftype{$fieldname}} eq 'cownedobject');
1620
        die "dynamic array not possible in struct" if ($fisarray{$fieldname} && $farraysize{$fieldname} eq '');
1621
        if ($fisarray{$fieldname} && $farraysize{$fieldname} ne '') {
1622
            if ($fkind{$fieldname} eq 'basic') {
1623
                print CC "    for ($fsizetype{$fieldname} i=0; i<$farraysize{$fieldname}; i++)\n";
1624
                print CC "        $var{$fieldname}\[i\] = $fval{$fieldname};\n";
1625
            }
1626
        } else {
1627
            if ($fval{$fieldname} ne '') {
1628
                print CC "    $var{$fieldname} = $fval{$fieldname};\n";
1629
            }
1630
        }
1631
    }
1632
    print CC "}\n\n";
1633
    print CC "void doPacking(cCommBuffer *b, $msgclass& a)\n";
1634
    print CC "{\n";
1635
    if ($msgbaseclass ne "") {
1636
        print CC "    doPacking(b,($msgbaseclass&)a);\n";
1637
    }
1638
    foreach my $fieldname (@fieldlist)
1639
    {
1640
        if ($fisarray{$fieldname}) {
1641
            print CC "    doPacking(b,a.$var{$fieldname},$farraysize{$fieldname});\n";
1642
        } else {
1643
            print CC "    doPacking(b,a.$var{$fieldname});\n";
1644
        }
1645
    }
1646
    print CC "}\n\n";
1647
1648
    print CC "void doUnpacking(cCommBuffer *b, $msgclass& a)\n";
1649
    print CC "{\n";
1650
    if ($msgbaseclass ne "") {
1651
        print CC "    doUnpacking(b,($msgbaseclass&)a);\n";
1652
    }
1653
    foreach my $fieldname (@fieldlist)
1654
    {
1655
        if ($fisarray{$fieldname}) {
1656
            print CC "    doUnpacking(b,a.$var{$fieldname},$farraysize{$fieldname});\n";
1657
        } else {
1658
            print CC "    doUnpacking(b,a.$var{$fieldname});\n";
1659
        }
1660
    }
1661
    print CC "}\n\n";
1662
}
1663
1664
1665
#
1666
# print descriptor class
1667
#
1668
sub generateDescriptorClass
1669
{
1670
    print CC "class $msgdescclass : public cClassDescriptor\n";
1671
    print CC "{\n";
1672
    print CC "  public:\n";
1673
    print CC "    $msgdescclass();\n";
1674
    print CC "    virtual ~$msgdescclass();\n";
1675
    print CC "\n";
1676
    print CC "    virtual bool doesSupport(cObject *obj) const;\n";
1677
    print CC "    virtual const char *getProperty(const char *propertyname) const;\n";
1678
    print CC "    virtual int getFieldCount(void *object) const;\n";
1679
    print CC "    virtual const char *getFieldName(void *object, int field) const;\n";
1680
    print CC "    virtual int findField(void *object, const char *fieldName) const;\n";
1681
    print CC "    virtual unsigned int getFieldTypeFlags(void *object, int field) const;\n";
1682
    print CC "    virtual const char *getFieldTypeString(void *object, int field) const;\n";
1683
    print CC "    virtual const char *getFieldProperty(void *object, int field, const char *propertyname) const;\n";
1684
    print CC "    virtual int getArraySize(void *object, int field) const;\n";
1685
    print CC "\n";
1686
    print CC "    virtual std::string getFieldAsString(void *object, int field, int i) const;\n";
1687
    print CC "    virtual bool setFieldAsString(void *object, int field, int i, const char *value) const;\n";
1688
    print CC "\n";
1689
    print CC "    virtual const char *getFieldStructName(void *object, int field) const;\n";
1690
    print CC "    virtual void *getFieldStructPointer(void *object, int field, int i) const;\n";
1691
    print CC "};\n\n";
1692
1693
    # register class
1694
    print CC "Register_ClassDescriptor($msgdescclass);\n\n";
1695
1696
    # ctor, dtor
1697
    $fieldcount = $#fieldlist+1;
1698
    my $qualifiedrealmsgclass = prefixWithNamespace($namespacename, $realmsgclass);
1699
    print CC "$msgdescclass\:\:$msgdescclass() : cClassDescriptor(\"$qualifiedrealmsgclass\", \"$msgbaseclass\")\n";
1700
    print CC "{\n";
1701
    print CC "}\n";
1702
    print CC "\n";
1703
1704
    print CC "$msgdescclass\:\:~$msgdescclass()\n";
1705
    print CC "{\n";
1706
    print CC "}\n";
1707
    print CC "\n";
1708
1709
    # doesSupport()
1710
    print CC "bool $msgdescclass\:\:doesSupport(cObject *obj) const\n";
1711
    print CC "{\n";
1712
    print CC "    return dynamic_cast<$msgclass *>(obj)!=NULL;\n";
1713
    print CC "}\n";
1714
    print CC "\n";
1715
1716
    # getProperty()
1717
    print CC "const char *$msgdescclass\:\:getProperty(const char *propertyname) const\n";
1718
    print CC "{\n";
1719
    for $key (keys %props) {
1720
        $prop = quote($props{$key});
1721
        print CC "    if (!strcmp(propertyname,\"$key\")) return \"$prop\";\n";
1722
    }
1723
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1724
    print CC "    return basedesc ? basedesc->getProperty(propertyname) : NULL;\n";
1725
    print CC "}\n";
1726
    print CC "\n";
1727
1728
    # getFieldCount()
1729
    print CC "int $msgdescclass\:\:getFieldCount(void *object) const\n";
1730
    print CC "{\n";
1731
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1732
    print CC "    return basedesc ? $fieldcount+basedesc->getFieldCount(object) : $fieldcount;\n";
1733
    print CC "}\n";
1734
    print CC "\n";
1735
1736
    # getFieldTypeFlags()
1737
    print CC "unsigned int $msgdescclass\:\:getFieldTypeFlags(void *object, int field) const\n";
1738
    print CC "{\n";
1739
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1740
    print CC "    if (basedesc) {\n";
1741
    print CC "        if (field < basedesc->getFieldCount(object))\n";
1742
    print CC "            return basedesc->getFieldTypeFlags(object, field);\n";
1743
    print CC "        field -= basedesc->getFieldCount(object);\n";
1744
    print CC "    }\n";
1745
    if ($fieldcount == 0) {
1746
        print CC "    return 0;\n";
1747
    } else {
1748
        print CC "    static unsigned int fieldTypeFlags[] = {\n";
1749
        for (my $i=0; $i<$fieldcount; $i++)
1750
        {
1751
            @flags = ();
1752
            $fieldname = $fieldlist[$i];
1753
            push(@flags, "FD_ISARRAY") if ($fisarray{$fieldname});
1754
            push(@flags, "FD_ISCOMPOUND") if ($fkind{$fieldname} eq 'struct');
1755
            push(@flags, "FD_ISPOINTER") if ($fispointer{$fieldname});
1756
            push(@flags, "FD_ISCOBJECT") if ($classtype{$ftype{$fieldname}} eq 'cobject' || $classtype{$ftype{$fieldname}} eq 'cnamedobject');
1757
            push(@flags, "FD_ISCOBJECT | FD_ISCOWNEDOBJECT") if ($classtype{$ftype{$fieldname}} eq 'cownedobject');
1758
1759
            my $editable = propertyAsBool($fprops{$fieldname}->{editable});
1760
            push(@flags, "FD_ISEDITABLE") if ($editable || ($generate_setters_in_descriptor && $fkind{$fieldname} eq 'basic'));
1761
            $flags = join(" | ", @flags);
1762
            $flags = "0" if (@flags==());
1763
            print CC "        $flags,\n";
1764
        }
1765
        print CC "    };\n";
1766
        print CC "    return (field>=0 && field<$fieldcount) ? fieldTypeFlags[field] : 0;\n";
1767
    }
1768
    print CC "}\n";
1769
    print CC "\n";
1770
1771
    # getFieldName()
1772
    print CC "const char *$msgdescclass\:\:getFieldName(void *object, int field) const\n";
1773
    print CC "{\n";
1774
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1775
    print CC "    if (basedesc) {\n";
1776
    print CC "        if (field < basedesc->getFieldCount(object))\n";
1777
    print CC "            return basedesc->getFieldName(object, field);\n";
1778
    print CC "        field -= basedesc->getFieldCount(object);\n";
1779
    print CC "    }\n";
1780
    if ($fieldcount == 0) {
1781
        print CC "    return NULL;\n";
1782
    } else {
1783
        print CC "    static const char *fieldNames[] = {\n";
1784
        for (my $i=0; $i<$fieldcount; $i++)
1785
        {
1786
            print CC "        \"$fieldlist[$i]\",\n";
1787
        }
1788
        print CC "    };\n";
1789
        print CC "    return (field>=0 && field<$fieldcount) ? fieldNames[field] : NULL;\n";
1790
    }
1791
    print CC "}\n";
1792
    print CC "\n";
1793
1794
    # findField()
1795
    print CC "int $msgdescclass\:\:findField(void *object, const char *fieldName) const\n";
1796
    print CC "{\n";
1797
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1798
    if ($fieldcount > 0) {
1799
        print CC "    int base = basedesc ? basedesc->getFieldCount(object) : 0;\n";
1800
        for (my $i=0; $i<$fieldcount; $i++)
1801
        {
1802
            my $c = substr($fieldlist[$i], 0, 1);
1803
            print CC "    if (fieldName[0]=='$c' && strcmp(fieldName, \"$fieldlist[$i]\")==0) return base+$i;\n";
1804
        }
1805
    }
1806
    print CC "    return basedesc ? basedesc->findField(object, fieldName) : -1;\n";
1807
    print CC "}\n";
1808
    print CC "\n";
1809
1810
    # getFieldTypeString()
1811
    print CC "const char *$msgdescclass\:\:getFieldTypeString(void *object, int field) const\n";
1812
    print CC "{\n";
1813
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1814
    print CC "    if (basedesc) {\n";
1815
    print CC "        if (field < basedesc->getFieldCount(object))\n";
1816
    print CC "            return basedesc->getFieldTypeString(object, field);\n";
1817
    print CC "        field -= basedesc->getFieldCount(object);\n";
1818
    print CC "    }\n";
1819
    if ($fieldcount == 0) {
1820
        print CC "    return NULL;\n";
1821
    } else {
1822
        print CC "    static const char *fieldTypeStrings[] = {\n";
1823
        for (my $i=0; $i<$fieldcount; $i++)
1824
        {
1825
            print CC "        \"$ftype{$fieldlist[$i]}\",\n"; # note: NOT $fieldtypeqname! that's getFieldStructName()
1826
        }
1827
        print CC "    };\n";
1828
        print CC "    return (field>=0 && field<$fieldcount) ? fieldTypeStrings[field] : NULL;\n";
1829
    }
1830
    print CC "}\n";
1831
    print CC "\n";
1832
1833
    # getFieldProperty()
1834
    print CC "const char *$msgdescclass\:\:getFieldProperty(void *object, int field, const char *propertyname) const\n";
1835
    print CC "{\n";
1836
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1837
    print CC "    if (basedesc) {\n";
1838
    print CC "        if (field < basedesc->getFieldCount(object))\n";
1839
    print CC "            return basedesc->getFieldProperty(object, field, propertyname);\n";
1840
    print CC "        field -= basedesc->getFieldCount(object);\n";
1841
    print CC "    }\n";
1842
    print CC "    switch (field) {\n";
1843
    for (my $i=0; $i<$fieldcount; $i++)
1844
    {
1845
        my $fieldname = $fieldlist[$i];
1846
        my $ref = $fprops{$fieldname};
1847
        if (keys(%$ref) != ()) {
1848
            print CC "        case $i:\n";
1849
            for my $key (keys %$ref) {
1850
                $prop = quote($fprops{$fieldname}->{$key});
1851
                print CC "            if (!strcmp(propertyname,\"$key\")) return \"$prop\";\n";
1852
            }
1853
            print CC "            return NULL;\n";
1854
        }
1855
    }
1856
    print CC "        default: return NULL;\n";
1857
    print CC "    }\n";
1858
    print CC "}\n";
1859
    print CC "\n";
1860
1861
    # getArraySize()
1862
    print CC "int $msgdescclass\:\:getArraySize(void *object, int field) const\n";
1863
    print CC "{\n";
1864
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1865
    print CC "    if (basedesc) {\n";
1866
    print CC "        if (field < basedesc->getFieldCount(object))\n";
1867
    print CC "            return basedesc->getArraySize(object, field);\n";
1868
    print CC "        field -= basedesc->getFieldCount(object);\n";
1869
    print CC "    }\n";
1870
    print CC "    $msgclass *pp = ($msgclass *)object; (void)pp;\n";
1871
    print CC "    switch (field) {\n";
1872
    for (my $i=0; $i<$fieldcount; $i++) {
1873
        if ($fisarray{$fieldlist[$i]}) {
1874
            if ($farraysize{$fieldlist[$i]} ne '') {
1875
                print CC "        case $i: return $farraysize{$fieldlist[$i]};\n";
1876
            } elsif ($classtype eq 'struct') {
1877
                print CC "        case $i: return pp->$varsize{$fieldlist[$i]};\n";
1878
            } else {
1879
                print CC "        case $i: return pp->$getsize{$fieldlist[$i]}();\n";
1880
            }
1881
        }
1882
    }
1883
    print CC "        default: return 0;\n";
1884
    print CC "    }\n";
1885
    print CC "}\n";
1886
    print CC "\n";
1887
1888
    # getFieldAsString()
1889
    print CC "std::string $msgdescclass\:\:getFieldAsString(void *object, int field, int i) const\n";
1890
    print CC "{\n";
1891
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1892
    print CC "    if (basedesc) {\n";
1893
    print CC "        if (field < basedesc->getFieldCount(object))\n";
1894
    print CC "            return basedesc->getFieldAsString(object,field,i);\n";
1895
    print CC "        field -= basedesc->getFieldCount(object);\n";
1896
    print CC "    }\n";
1897
    print CC "    $msgclass *pp = ($msgclass *)object; (void)pp;\n";
1898
    print CC "    switch (field) {\n";
1899
    for (my $i=0; $i<$fieldcount; $i++)
1900
    {
1901
        if ($fkind{$fieldlist[$i]} eq 'basic') {
1902
            if ($classtype eq 'struct') {
1903
                if ($fisarray{$fieldlist[$i]}) {
1904
                    if ($farraysize{$fieldlist[$i]} ne '') {
1905
                        print CC "        case $i: if (i>=$farraysize{$fieldlist[$i]}) return \"\";\n";
1906
                    } else {
1907
                        print CC "        case $i: if (i>=pp->$varsize{$fieldlist[$i]}) return \"\";\n";
1908
                    }
1909
                    print CC "                return $tostring{$fieldlist[$i]}(pp->$var{$fieldlist[$i]}\[i\]);\n";
1910
                } else {
1911
                    print CC "        case $i: return $tostring{$fieldlist[$i]}(pp->$var{$fieldlist[$i]});\n";
1912
                }
1913
            } else {
1914
                if ($fisarray{$fieldlist[$i]}) {
1915
                    print CC "        case $i: return $tostring{$fieldlist[$i]}(pp->$getter{$fieldlist[$i]}(i));\n";
1916
                } else {
1917
                    print CC "        case $i: return $tostring{$fieldlist[$i]}(pp->$getter{$fieldlist[$i]}());\n";
1918
                }
1919
            }
1920
        } elsif ($fkind{$fieldlist[$i]} eq 'struct') {
1921
            if ($classtype eq 'struct') {
1922
                if ($fisarray{$fieldlist[$i]}) {
1923
                    print CC "        case $i: {std::stringstream out; out << pp->$var{$fieldlist[$i]}\[i\]; return out.str();}\n";
1924
                } else {
1925
                    print CC "        case $i: {std::stringstream out; out << pp->$var{$fieldlist[$i]}; return out.str();}\n";
1926
                }
1927
            } else {
1928
                if ($fisarray{$fieldlist[$i]}) {
1929
                    print CC "        case $i: {std::stringstream out; out << pp->$getter{$fieldlist[$i]}(i); return out.str();}\n";
1930
                } else {
1931
                    print CC "        case $i: {std::stringstream out; out << pp->$getter{$fieldlist[$i]}(); return out.str();}\n";
1932
                }
1933
            }
1934
        } else {
1935
            die 'internal error';
1936
        }
1937
    }
1938
    print CC "        default: return \"\";\n";
1939
    print CC "    }\n";
1940
    print CC "}\n";
1941
    print CC "\n";
1942
1943
    # setFieldAsString()
1944
    print CC "bool $msgdescclass\:\:setFieldAsString(void *object, int field, int i, const char *value) const\n";
1945
    print CC "{\n";
1946
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1947
    print CC "    if (basedesc) {\n";
1948
    print CC "        if (field < basedesc->getFieldCount(object))\n";
1949
    print CC "            return basedesc->setFieldAsString(object,field,i,value);\n";
1950
    print CC "        field -= basedesc->getFieldCount(object);\n";
1951
    print CC "    }\n";
1952
    print CC "    $msgclass *pp = ($msgclass *)object; (void)pp;\n";
1953
    print CC "    switch (field) {\n";
1954
    for (my $i=0; $i<$fieldcount; $i++)
1955
    {
1956
        $fieldname = $fieldlist[$i];
1957
        my $editable = propertyAsBool($fprops{$fieldname}->{editable});
1958
        if ($editable || ($generate_setters_in_descriptor && $fkind{$fieldname} eq 'basic')) {
1959
            if ($classtype eq 'struct') {
1960
                if ($fisarray{$fieldname}) {
1961
                    if ($farraysize{$fieldname} ne '') {
1962
                        print CC "        case $i: if (i>=$farraysize{$fieldname}) return false;\n";
1963
                    } else {
1964
                        print CC "        case $i: if (i>=pp->$varsize{$fieldname}) return false;\n";
1965
                    }
1966
                    print CC "                pp->$var{$fieldname}\[i\] = $fromstring{$fieldname}(value); return true;\n";
1967
                } else {
1968
                    print CC "        case $i: pp->$var{$fieldname} = $fromstring{$fieldname}(value); return true;\n";
1969
                }
1970
            } else {
1971
                if ($fisarray{$fieldname}) {
1972
                    print CC "        case $i: pp->$setter{$fieldname}(i,$fromstring{$fieldname}(value)); return true;\n";
1973
                } else {
1974
                    print CC "        case $i: pp->$setter{$fieldname}($fromstring{$fieldname}(value)); return true;\n";
1975
                }
1976
            }
1977
        }
1978
    }
1979
    print CC "        default: return false;\n";
1980
    print CC "    }\n";
1981
    print CC "}\n";
1982
    print CC "\n";
1983
1984
    # getFieldStructName()
1985
    print CC "const char *$msgdescclass\:\:getFieldStructName(void *object, int field) const\n";
1986
    print CC "{\n";
1987
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
1988
    print CC "    if (basedesc) {\n";
1989
    print CC "        if (field < basedesc->getFieldCount(object))\n";
1990
    print CC "            return basedesc->getFieldStructName(object, field);\n";
1991
    print CC "        field -= basedesc->getFieldCount(object);\n";
1992
    print CC "    }\n";
1993
    if ($fieldcount == 0) {
1994
        print CC "    return NULL;\n";
1995
    } else {
1996
        print CC "    static const char *fieldStructNames[] = {\n";
1997
        for (my $i=0; $i<$fieldcount; $i++)
1998
        {
1999
            if ($fkind{$fieldlist[$i]} eq 'struct') {
2000
                print CC "        \"$ftypeqname{$fieldlist[$i]}\",\n";
2001
            } else {
2002
                print CC "        NULL,\n";
2003
            }
2004
        }
2005
        print CC "    };\n";
2006
        print CC "    return (field>=0 && field<$fieldcount) ? fieldStructNames[field] : NULL;\n";
2007
    }
2008
    print CC "}\n";
2009
    print CC "\n";
2010
2011
    # getFieldStructPointer()
2012
    print CC "void *$msgdescclass\:\:getFieldStructPointer(void *object, int field, int i) const\n";
2013
    print CC "{\n";
2014
    print CC "    cClassDescriptor *basedesc = getBaseClassDescriptor();\n";
2015
    print CC "    if (basedesc) {\n";
2016
    print CC "        if (field < basedesc->getFieldCount(object))\n";
2017
    print CC "            return basedesc->getFieldStructPointer(object, field, i);\n";
2018
    print CC "        field -= basedesc->getFieldCount(object);\n";
2019
    print CC "    }\n";
2020
    print CC "    $msgclass *pp = ($msgclass *)object; (void)pp;\n";
2021
    print CC "    switch (field) {\n";
2022
    for (my $i=0; $i<$fieldcount; $i++)
2023
    {
2024
        $fieldname = $fieldlist[$i];
2025
2026
        if ($fkind{$fieldname} eq 'struct') {
2027
            if ($classtype eq 'struct') {
2028
                if ($fisarray{$fieldname}) {
2029
                    $value = "pp->$var{$fieldname}\[i\]";
2030
                } else {
2031
                    $value = "pp->$var{$fieldname}";
2032
                }
2033
            } else {
2034
                if ($fisarray{$fieldname}) {
2035
                    $value = "pp->$getter{$fieldname}(i)";
2036
                } else {
2037
                    $value = "pp->$getter{$fieldname}()";
2038
                }
2039
            }
2040
            $fieldclasstype = $classtype{$ftype{$fieldname}};
2041
            $cast = "(void *)";
2042
            $cast .= "static_cast<cObject *>" if ($fieldclasstype eq 'cobject' || $fieldclasstype eq 'cnamedobject' || $fieldclasstype eq 'cownedobject');
2043
            if ($fispointer{$fieldname}) {
2044
                print CC "        case $i: return $cast($value); break;\n";
2045
            } else {
2046
                print CC "        case $i: return $cast(\&$value); break;\n";
2047
            }
2048
        }
2049
    }
2050
    print CC "        default: return NULL;\n";
2051
    print CC "    }\n";
2052
    print CC "}\n";
2053
    print CC "\n";
2054
}
2055
2056
#
2057
# replace newlines with \n, and prefix quotes with backslash
2058
#
2059
sub quote($)
2060
{
2061
    my($text) = @_;
2062
    $text =~ s/\\/\\\\/gs;
2063
    $text =~ s/\n/\\n/gs;
2064
    $text =~ s/"/\\"/g;
2065
    return $text;
2066
}
2067
2068
#
2069
# If quoted, unquote it, otherwise return it unchanged
2070
#
2071
sub unquote($)
2072
{
2073
    my($text) = @_;
2074
    if ($text =~ s/^"(.*)"$/$1/) {
2075
        $text =~ s/\\"/"/gs;
2076
        $text =~ s/\\n/\n/gs;
2077
        $text =~ s/\\\\/\\/gs;
2078
    }
2079
    return $text;
2080
}
2081
2082
2083
#
2084
# Prefixes the name with the current namespace
2085
#
2086
sub prefixWithNamespace($$)
2087
{
2088
    my($namespacename, $name) = @_;
2089
    if ($namespacename ne '' && $name ne '') {
2090
        # prefix it with namespace name
2091
        $name = $namespacename . "::" . $name;
2092
    }
2093
    return $name;
2094
}
2095
2096
2097
#
2098
# Plain names are always understood in the file's namespace;
2099
# names containing "::" are understood as absolute namespace.
2100
#
2101
# Examples:
2102
#
2103
# namespace foo;
2104
# class A;         // --> foo::A
2105
# class ::A;       // --> ::A  (returned as A)
2106
# class bar::A;    // --> ::bar::A (returned as bar::A)
2107
# class ::bar::A;  // --> ::bar::A (returned as bar::A)
2108
#
2109
sub canonicalizeQName($$)
2110
{
2111
    my($namespacename, $name) = @_;
2112
    if ($name =~ /::/) {
2113
        # leave it, just remove reading "::"
2114
        $name =~ s/^:://;
2115
    }
2116
    elsif ($namespacename ne '' && $name ne '') {
2117
        # prefix it with namespace name
2118
        $name = $namespacename . "::" . $name;
2119
    }
2120
    return $name;
2121
}
2122
2123
#
2124
# Look up the given class in @classes, allowing some flexibility with
2125
# namespaces, and return the name from @classes. Return '' if not found.
2126
#
2127
sub lookupExistingClassName($$)
2128
{
2129
    my($namespacename, $name) = @_;
2130
    if ($name eq '') {
2131
        return $name;
2132
    }
2133
    if ($name =~ /::/) {
2134
        # contains "::" -- user means explicitly qualified name
2135
        $name =~ s/^:://;  # remove leading "::"
2136
        if (grep(/^\Q$name\E$/,@classes)) {
2137
            return $name;
2138
        } else {
2139
            return '';  # "not found"
2140
        }
2141
    }
2142
2143
    my $qname = prefixWithNamespace($namespacename, $name);
2144
    if (grep(/^\Q$qname\E$/,@classes)) {
2145
        return $qname; # found it in our namespace
2146
    }
2147
    elsif (grep(/^\Q$name\E$/,@classes)) {
2148
        return $name; # found it in the global namespace
2149
    }
2150
    return '';  # "not found"
2151
}
2152
2153
#
2154
# Like lookupExistingClassName(), but use @enums instead of @classes
2155
#
2156
sub lookupExistingEnumName($$)
2157
{
2158
    my($namespacename, $name) = @_;
2159
    if ($name eq '') {
2160
        return $name;
2161
    }
2162
    if ($name =~ /::/) {
2163
        # contains "::" -- user means explicitly qualified name
2164
        $name =~ s/^:://;  # remove leading "::"
2165
        if (grep(/^\Q$name\E$/,@enums)) {
2166
            return $name;
2167
        } else {
2168
            return '';  # "not found"
2169
        }
2170
    }
2171
2172
    my $qname = prefixWithNamespace($namespacename, $name);
2173
    if (grep(/^\Q$qname\E$/,@enums)) {
2174
        return $qname; # found it in our namespace
2175
    }
2176
    elsif (grep(/^\Q$name\E$/,@enums)) {
2177
        return $name; # found it in the global namespace
2178
    }
2179
    return '';  # "not found"
2180
}
2181
2182
sub propertyAsBool($)
2183
{
2184
    my($propval) = @_;
2185
    if (!defined($propval) || ($propval eq "false")) {
2186
        return 0;  # false
2187
    } else {
2188
        return 1;  # true
2189
    }
2190
}