3 # xpidl2cs.pl : Generates C# interfaces from idl
5 # Author: Andreia Gaita <shana.ufie@gmail.com>
7 # Copyright (c) 2007 Novell, Inc.
9 # Licensed under the MIT license. See LICENSE file in the project root for full license information.
20 #open FILE, '<', $path.$file or die "Can't open file $path$file";
36 $types{"short"} = {name => "short", out => "out", marshal => ""};
37 $types{"PRUint8"} = {name => "char", out => "out", marshal => ""};
38 $types{"PRInt8"} = {name => "char", out => "out", marshal => ""};
39 $types{"unsigned,short"} = {name => "ushort", out => "out", marshal => ""};
40 $types{"PRUint16"} = {name => "ushort", out => "out", marshal => ""};
41 $types{"PRInt16"} = {name => "short", out => "out", marshal => ""};
42 $types{"int"} = {name => "int", out => "out", marshal => ""};
43 $types{"nsresult"} = {name => "int", out => "out", marshal => ""};
44 $types{"unsigned,int"} = {name => "uint", out => "out", marshal => ""};
45 $types{"PRUint32"} = {name => "UInt32", out => "out", marshal => ""};
46 $types{"PRInt32"} = {name => "Int32", out => "out", marshal => ""};
47 $types{"PRInt64"} = {name => "long", out => "out", marshal => ""};
48 $types{"long"} = {name => "int", out => "out", marshal => ""};
49 $types{"size_t"} = {name => "int", out => "out", marshal => ""};
50 $types{"unsigned,long"} = {name => "uint", out => "out", marshal => ""};
51 $types{"float"} = {name => "float", out => "out", marshal => ""};
52 $types{"boolean"} = {name => "bool", out => "out", marshal => ""};
53 $types{"PRBool"} = {name => "bool", out => "out", marshal => ""};
54 $types{"void"} = {name => "", out => "", marshal => ""};
55 $types{"octet"} = {name => "byte", out => "out", marshal => ""};
56 $types{"octet[]"} = {name => "IntPtr", out => "out", marshal => " "};
57 $types{"byte"} = {name => "byte", out => "out", marshal => ""};
58 $types{"DOMString"} = {name => "/*DOMString*/ HandleRef", out => "", marshal => ""};
59 $types{"AUTF8String"} = {name => "/*AUTF8String*/ HandleRef", out => "", marshal => ""};
60 $types{"ACString"} = {name => "/*ACString*/ HandleRef", out => "", marshal => ""};
61 $types{"AString"} = {name => "/*AString*/ HandleRef", out => "", marshal => ""};
62 $types{"wstring"} = {name => "string", out => "", marshal => "MarshalAs(UnmanagedType.LPWStr)"};
63 $types{"nsCIDRef"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
64 $types{"nsIIDRef"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
65 $types{"Guid"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
66 $types{"nsCID"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
67 $types{"nsCIDPtr"} = {name => "Guid", out => "out", marshal => "MarshalAs (UnmanagedType.LPStruct)"};
68 $types{"string"} = {name => "string", out => "ref", marshal => "MarshalAs (UnmanagedType.LPStr)"};
69 $types{"refstring"} = {name => "IntPtr", out => "ref", marshal => ""};
70 $types{"charPtr"} = {name => "StringBuilder", out => "", marshal => ""};
71 $types{"voidPtr"} = {name => "IntPtr", out => "", marshal => ""};
72 $types{"nsISupports"} = {name => "IntPtr", out => "out", marshal =>"MarshalAs (UnmanagedType.Interface)"};
73 $types{"DOMTimeStamp"} = {name => "int", out => "out", marshal => ""};
74 $types{"nsWriteSegmentFun"} = {name => "nsIWriteSegmentFunDelegate", out => "", marshal => ""};
75 $types{"nsReadSegmentFun"} = {name => "nsIReadSegmentFunDelegate", out => "", marshal => ""};
76 $types{"nsTimerCallbackFunc"} = {name => "nsITimerCallbackDelegate", out => "", marshal => ""};
77 $types{"nsLoadFlags"} = {name => "ulong", out => "out", marshal => ""};
78 $types{"nsQIResult"} = {name => "IntPtr", out => "out", marshal => ""};
79 $types{"nsIIDPtr[]"} = {name => "IntPtr", out => "out", marshal => ""};
80 $types{"PRFileDescStar"} = {name => "IntPtr", out => "out", marshal => ""};
81 $types{"PRLibraryStar"} = {name => "IntPtr", out => "out", marshal => ""};
82 $types{"FILE"} = {name => "IntPtr", out => "out", marshal => ""};
83 $types{"nsIPresShell"} = {name => "/*nsIPresShell*/ IntPtr", out => "out", marshal => ""};
84 $types{"nsIDocument"} = {name => "/*nsIDocument*/ IntPtr", out => "out", marshal => ""};
85 $types{"nsIFrame"} = {name => "/*nsIFrame*/ IntPtr", out => "out", marshal => ""};
86 $types{"nsObjectFrame"} = {name => "/*nsObjectFrame*/ IntPtr", out => "out", marshal => ""};
87 $types{"nsIContent"} = {name => "/*nsIContent*/ IntPtr", out => "out", marshal => ""};
88 $types{"others"} = {name => "", out => "out", marshal => "MarshalAs (UnmanagedType.Interface)"};
91 $returnvalues{"short"} = {value => "0"};
92 $returnvalues{"ushort"} = {value => "0"};
93 $returnvalues{"int"} = {value => "0"};
94 $returnvalues{"uint"} = {value => "0"};
95 $returnvalues{"UInt32"} = {value => "0"};
96 $returnvalues{"Int32"} = {value => "0"};
97 $returnvalues{"long"} = {value => "0"};
98 $returnvalues{"ulong"} = {value => "0"};
99 $returnvalues{"IntPtr"} = {value => "0"};
100 $returnvalues{"float"} = {value => "0"};
101 $returnvalues{"byte"} = {value => "0"};
102 $returnvalues{"IntPtr"} = {value => "IntPtr.Zero"};
103 $returnvalues{"string"} = {value => "String.Empty"};
104 $returnvalues{"bool"} = {value => "false"};
105 $returnvalues{"/*DOMString*/ HandleRef"} = {value => "null"};
106 $returnvalues{"/*AUTF8String*/ HandleRef"} = {value => "null"};
107 $returnvalues{"ACString*/ HandleRef"} = {value => "null"};
108 $returnvalues{"/*AString*/ HandleRef"} = {value => "null"};
109 $returnvalues{""} = {value => ""};
110 $returnvalues{"others"} = {value => "null"};
113 $names{"event"} = {name => "_event"};
114 $names{"lock"} = {name => "_lock"};
118 my $class_implementation;
124 print STDERR << "EOF";
125 Usage: xpidl2cs.pl -f file -p path/to/idl [-nh -c class]
127 -f : idl file to parse, with extension
128 -p : path to the idl file directory
129 -n : generate files with no PreserveSig attribute (optional, defaults to adding the attribute)
130 -c : specific class to use inside the idl file (optional)
138 my $opts = 'f:p:c:n';
139 getopts( "$opts", \%opt ) or usage();
142 usage() if !$opt{f} or !$opt{p};
146 open FILE, '<', $path.$file or die "Can't open file $path$file";
148 $nosig = 1 if $opt{n};
161 #print "parse_parent\n";
164 print "Parsing parent $x\n";
165 `perl xpidl2cs.pl $x.idl $path $nosig`;
167 open my $f, '<', "$x.cs";
170 while (my $line = <$f>) {
173 if ($line =~ /#region/) {
175 $out .= $line . "\n";
178 elsif ($line =~ /\}/) {
182 $out .= $line . "\n";
190 #print "has_setter\n";
192 return !$properties{$x}->{"setter"};
199 if (exists $names{$x}) {
200 return $names{$x}->{"name"};
211 # print "arr = $arr ; out = $out ; name = $x\n";
214 if ($arr && exists $types{"$out$x\[\]"}) {
215 return $types{"$out$x\[\]"}->{"name"};
216 } elsif ($arr && exists $types{"$out$x"}) {
217 return $types{"$out$x"}->{"name"}."[]";
218 } elsif (exists $types{"$out$x"}) {
219 return $types{"$out$x"}->{"name"};
223 if (exists $types{$x} || ($arr && exists $types{"$x\[\]"})) {
224 if ($arr && exists $types{"$x\[\]"}) {
225 return $types{"$x\[\]"}->{"name"};
227 return $types{$x}->{"name"}."[]";
229 return $types{$x}->{"name"};
238 if (exists $types{$x}) {
239 return $types{$x}->{"out"};
241 return $types{"others"}->{"out"};
245 #print "get_marshal\n";
251 if ($arr && exists $types{"$out$x\[\]"}) {
252 return $types{"$out$x\[\]"}->{"marshal"};
253 } elsif (exists $types{"$out$x"}) {
254 return $types{"$out$x"}->{"marshal"};
258 if (exists $types{$x} || ($arr && exists $types{"$x\[\]"})) {
259 if ($arr && exists $types{"$x\[\]"}) {
260 return $types{"$x\[\]"}->{"marshal"};
262 return $types{$x}->{"marshal"};
266 return $types{"others"}->{"marshal"};
269 sub get_return_value {
270 #print "get_return_value\n";
272 if (exists $returnvalues{$x}) {
273 return $returnvalues{$x}->{"value"};
275 return $returnvalues{"others"}->{"value"};
280 #print "is_property\n";
282 return (exists $properties{$x});
286 #print "add_external\n";
288 if ($x !~ /nsISupports/ && !exists $types{$x} && !exists $dependents{$x}) {
289 $dependents{$x} = $x;
291 # print "add_external $x\n";
295 #print "get_params\n";
298 #print $methods{$x}->{"params"}."\n";
299 my @params = split /,/, $methods{$x}->{"params"};
300 my $lastoutparam = "";
303 #print "params:@params:\n";
304 for my $param (@params) {
312 # print "param:$param:\n";
313 my @p = split (" ", $param);
315 # need to backtrack to a previous parameter defined by iid_is(name) and
316 # replace the type of this one with that. who the $%#@ came up with this idea? le sigh.
318 if (@p[0] =~ m/iid_is/) {
320 $name = &get_name (@p[0]);
322 $type = $list{$name}->{"type"};
323 $marshal = $list{$name}->{"marshal"};
324 $marshal = " " if !$marshal;
326 until (scalar(@p) == 3) {
331 if (@p[0] =~ m/array/ || @p[1] =~ m/array/) {
332 until (scalar(@p) == 3) {
335 $isout = 1 if (@p[0] =~ m/out/);
337 $marshal = &get_marshal (@p[0], "", 1);
338 $type = &get_type(@p[0], "", 1);
341 shift @p unless @p[0] =~ /(in|out)/;
342 $isout = 1 if (@p[0] =~ m/out/);
343 shift @p unless scalar(@p) <= 2;
345 # if an out parameter is of type nsQIResult, that means
346 # it will return a pointer to an interface (that can be anything).
347 # That means we want to return an IntPtr, and later cast it to
348 # the proper type, so reset type and marshalling
349 if ($isout && @p[0] =~ /nsQIResult/) {
355 $type = join ",", @p[0..@p-2];
357 until (scalar(@p) == 1) {
361 $marshal = &get_marshal ($type);
362 $marshal = " " if !$marshal;
363 $type = &get_type ($type);
364 $name = &get_name (@p[0]);
366 #print "marshal:$marshal\ttype:$type\tname:$name\n";
367 $out = &get_out($type) if $isout;
369 $type = &get_type (@p[0]) unless $type;
370 shift @p unless scalar(@p) == 1;
371 $marshal = &get_marshal ($type) unless $marshal;
372 $name = &get_name (@p[0]) unless $name;
374 #print "marshal:$marshal\ttype:$type\tname:$name\n";
384 &add_external ($type);
386 $marshal = "" if $marshal eq " ";
388 # my $tmp = "\n\t\t\t\t";
390 $tmp .= "[$marshal] " if $marshal;
391 $tmp .= "$out $type $name";
393 $lastoutparam = $name if $isout;
397 #print "$methods{$x}->{\"type\"}\n";
398 #print "nosig:$nosig;x:$x;type:" . &get_type ($methods{$x}->{"type"}) . ";\n";
399 if (!$nosig && $x !~ /void/ && &get_type ($methods{$x}->{"type"}) ne "") {
400 $type = $methods{$x}->{"type"};
401 $type =~ s/\[.*\],//;
402 $marshal = &get_marshal ($type);
405 $tmp = "[$marshal] " if $marshal;
406 $tmp .= &get_out($type);
407 $tmp .= " " . &get_type ($type);
409 #print "tmp 2:$tmp\n";
412 &add_external ($type);
415 if ($nosig && &get_type ($methods{$x}->{"type"}) eq "" && $lastoutparam) {
416 $methods{$x}->{"type"} = $list{$lastoutparam}->{"type"};
421 return join (",\n\t\t\t\t", @ret);
425 #print "parse_file\n";
433 while (my $line = <FILE>) {
436 next if !$start && $line !~ /uuid\(/;
438 last if $start && $line =~ /\};/;
442 if (index($line, "/*") > -1) {
446 if ($comment && index($line, "*/") > -1) {
453 if (index($line, "*") == -1 && index ($line, "//") == -1 && index ($line, "#include") == -1) {
455 $line =~ s/\[noscript\] //;
457 if (index ($line, "uuid(") != -1) {
459 $uuid =~ s/\[.*uuid\((.*)\)\]/\1/;
460 $interface->{"uuid"} = $uuid;
463 elsif (index($line, "interface") != -1) {
465 $class =~ s/interface ([^\:|\s]+)\s*:\s*(.*)/\1/;
466 # print "\t\tclass:$class\n";
467 # print "\t\t_class:$_class\n";
468 if ($_class && $_class !~ $class) {
481 $parent =~ s/([^\:]+):\s*(.*)[\s|\{]/\2/;
482 # print "\t\tparent:$parent\n";
483 $interface->{"class"} = $class;
484 $interface->{"parent"} = $parent;
486 elsif (index ($line, "const") != -1 && index ($line, "[") == -1) {
489 elsif (index ($line, "attribute") != -1) {
490 my $att = substr($line, index($line, "attribute") + 10);
492 my @atts = split / /, $att;
494 my $name = pop @atts;
496 # print $name . "\n";
497 my @nospaces = grep /[^ ]/, @atts;
498 my $type = join ",", @nospaces;
501 if (index ($line, "readonly") != -1) {
504 # print $type . "\n";
505 $properties{$name} = {type => $type, setter => $setter};
506 $interface->{"items"} .= $name . ",";
508 elsif ($line !~ m/[{|}]/ && $line =~ m/./) {
509 # print $line . "\n";
512 my $m = substr($line, 0, index($line, "("));
513 my @atts = split / /, $m;
517 # print "name=$mname\n";
518 my @nospaces = grep /[^ ]/, @atts;
519 $mtype = join ",", @nospaces;
520 $mtype =~ s/\[.*\],//;
521 # print "type=$mtype\n";
522 $mparams .= substr($line, index($line, "(") + 1);
526 @atts = split / /, $mparams;
527 @nospaces = grep /[^ ]/, @atts;
528 $mparams = join " ", @nospaces;
529 # print "params=>$mparams\n";
532 elsif (index ($line, "raises") == -1) {
536 my @atts = split / /, $mparams;
537 my @nospaces = grep /[^ ]/, @atts;
538 $mparams = join " ", @nospaces;
539 # print "params=>$mparams\n";
541 if (index ($line, ";") != -1) {
543 $mparams =~ s/\[([^\]]+),([^\]]+),([^\]]+)\]/\1 \2 \3/;
544 $mparams =~ s/\[([^\]]+),([^\]]+)\]/\1 \2/;
547 $mparams =~ s/retval//;
549 $methods{$mname} = {type => $mtype, params => $mparams};
550 $interface->{"items"} .= $mname . ",";
551 # print "params=>$mparams\n";
564 my $name = $interface->{"class"};
567 print X "// THIS FILE AUTOMATICALLY GENERATED BY xpidl2cs.pl\n";
568 print X "// EDITING IS PROBABLY UNWISE\n";
569 print X "// Permission is hereby granted, free of charge, to any person obtaining\n";
570 print X "// a copy of this software and associated documentation files (the\n";
571 print X "// \"Software\"), to deal in the Software without restriction, including\n";
572 print X "// without limitation the rights to use, copy, modify, merge, publish,\n";
573 print X "// distribute, sublicense, and/or sell copies of the Software, and to\n";
574 print X "// permit persons to whom the Software is furnished to do so, subject to\n";
575 print X "// the following conditions:\n";
577 print X "// The above copyright notice and this permission notice shall be\n";
578 print X "// included in all copies or substantial portions of the Software.\n";
580 print X "// THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,\n";
581 print X "// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF\n";
582 print X "// MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND\n";
583 print X "// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE\n";
584 print X "// LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION\n";
585 print X "// OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION\n";
586 print X "// WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.\n";
588 print X "// Copyright (c) 2007, 2008 Novell, Inc.\n";
590 print X "// Authors:\n";
591 print X "// Andreia Gaita (avidigal\@novell.com)\n";
594 print X "using System;\n";
595 print X "using System.Runtime.InteropServices;\n";
596 print X "using System.Runtime.CompilerServices;\n";
597 print X "using System.Text;\n";
599 print X "namespace Mono.Mozilla {\n";
602 my $uuid = $interface->{"uuid"};
603 my $parent = $interface->{"parent"};
604 print X "\t[Guid (\"$uuid\")]\n";
605 print X "\t[InterfaceType (ComInterfaceType.InterfaceIsIUnknown)]\n";
606 print X "\t[ComImport ()]\n";
607 print X "\tinternal interface $name";
608 print X " : $parent" if $parent !~ /nsISupports/;
611 if ($parent !~ /nsISupports/) {
612 print X &parse_parent ($parent);
615 print X "#region $name\n";
617 my @items = split ",", $interface->{"items"};
618 for my $item (@items) {
621 print X "\t\t[PreserveSigAttribute]\n";
623 print X "\t\t[MethodImpl (MethodImplOptions.InternalCall, MethodCodeType = MethodCodeType.Runtime)]\n";
625 if (&is_property ($item)) {
626 my $out = &get_out($properties{$item}->{"type"});
627 my $marshal = &get_marshal($properties{$item}->{"type"}, $out);
628 my $type = &get_type ($properties{$item}->{"type"}, $out);
629 my $name = ucfirst ($item);
631 &add_external ($properties{$item}->{"type"});
635 print X "[return: $marshal] " if $marshal;
636 print X "$type get$name ();\n";
638 print X "int get$name (";
639 print X "[$marshal] " if $marshal;
640 print X "$out $type ret);\n";
644 $type = &get_type ($properties{$item}->{"type"});
645 $marshal = &get_marshal($properties{$item}->{"type"});
648 if (&has_setter($item)) {
650 print X "\t\t[PreserveSigAttribute]\n";
652 print X "\t\t[MethodImpl (MethodImplOptions.InternalCall, MethodCodeType = MethodCodeType.Runtime)]\n";
658 print X " set$name (";
659 print X "[$marshal] " if $marshal;
660 print X "$type value);\n";
665 my $type = &get_type ($methods{$item}->{"type"});
666 my $out = &get_out($methods{$item}->{"type"}) if $type;
667 my $marshal = &get_marshal($methods{$item}->{"type"}, $out) if $type;
668 $type = "void" if !$type;
672 print X "[return: $marshal] " if $marshal;
673 print X "$type $item (";
674 print X &get_params($item);
677 print X "int $item (";
678 print X &get_params($item);
684 print X "#endregion\n";
688 # mozilla-specific helper classes to proxy objects between threads
689 # remove if you're not running this for mono.mozilla
693 $helpername =~ s/nsI/ns/;
694 print X "\tinternal class $helpername";
696 print X "\t\tpublic static $name GetProxy (Mono.WebBrowser.IWebBrowser control, $name obj)\n";
698 print X "\t\t\tobject o = Base.GetProxyForObject (control, typeof($name).GUID, obj);\n";
699 print X "\t\t\treturn o as $name;\n";
703 #end of mozilla-specific helper classes
708 &generate_class_implementation_example ();
714 sub generate_dependents {
715 #print "generate_dependents\n";
716 for my $dependent (keys %dependents) {
717 if (! (-e "$dependent.cs") && -e "$path$dependent.idl" && $file != $dependent) {
718 print "generating $path$dependent.idl\n";
719 my $cmd = "perl xpidl2cs.pl -f $dependent.idl -p $path";
720 $cmd .= "-n" if $nosig;
727 sub generate_class_implementation_example {
728 #print "generate_class_implementation_example\n";
729 my $name = $interface->{"class"};
730 my $interfacename = $interface->{"class"};
731 my $helpername = $name;
732 $helpername =~ s/nsI//;
733 my $parent = $interface->{"parent"};
735 print X "#if example\n\n";
736 print X "using System;\n";
737 print X "using System.Runtime.InteropServices;\n";
738 print X "using System.Runtime.CompilerServices;\n";
739 print X "using System.Text;\n";
742 print X "\tinternal class $helpername";
743 print X " : $interfacename";
747 print X "#region $interfacename\n";
749 my @items = split ",", $interface->{"items"};
750 for my $item (@items) {
752 if (&is_property ($item)) {
753 my $out = &get_out($properties{$item}->{"type"});
754 my $marshal = &get_marshal($properties{$item}->{"type"}, $out);
755 my $type = &get_type ($properties{$item}->{"type"}, $out);
757 my $retval = &get_return_value($type);
758 my $name = ucfirst ($item);
763 print X "[return: $marshal] " if $marshal;
764 print X "$type $interfacename.get$name ()\n";
766 print X "int $interfacename.get$name (";
767 print X "[$marshal] " if $marshal;
768 print X "$out $type ret)\n";
774 print X "return $retval;\n";
780 $type = &get_type ($properties{$item}->{"type"});
781 $retval = &get_return_value($type);
782 $marshal = &get_marshal($properties{$item}->{"type"});
785 if (&has_setter($item)) {
791 print X " $interfacename.set$name (";
792 print X "[$marshal] " if $marshal;
793 print X "$type value)\n";
799 print X "return $retval;\n";
807 my $type = &get_type ($methods{$item}->{"type"});
808 my $out = &get_out($methods{$item}->{"type"}) if $type;
809 my $marshal = &get_marshal($methods{$item}->{"type"}, $out) if $type;
810 $type = "void" if !$type;
814 print X "[return: $marshal] " if $marshal;
815 print X "$type $interfacename.$item (";
816 print X &get_params($item);
819 print X "int $interfacename.$item (";
820 print X &get_params($item);
827 print X "return $retval;\n";
835 print X "#endregion\n";
846 &generate_dependents ();