Method.pm 7.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286
  1. package Logos::Method;
  2. use strict;
  3. use Logos::Util qw(matchedParenthesisSet);
  4. sub new {
  5. my $proto = shift;
  6. my $class = ref($proto) || $proto;
  7. my $self = {};
  8. $self->{CLASS} = undef;
  9. $self->{SCOPE} = undef;
  10. $self->{RETURN} = undef;
  11. $self->{SELECTOR_PARTS} = [];
  12. $self->{ARGNAMES} = [];
  13. $self->{ARGTYPES} = [];
  14. $self->{NEW} = 0;
  15. $self->{TYPE} = "";
  16. bless($self, $class);
  17. return $self;
  18. }
  19. ##################### #
  20. # Setters and Getters #
  21. # #####################
  22. sub class {
  23. my $self = shift;
  24. if(@_) { $self->{CLASS} = shift; }
  25. return $self->{CLASS};
  26. }
  27. sub scope {
  28. my $self = shift;
  29. if(@_) { $self->{SCOPE} = shift; }
  30. return $self->{SCOPE};
  31. }
  32. sub return {
  33. my $self = shift;
  34. if(@_) { $self->{RETURN} = shift; }
  35. return $self->{RETURN};
  36. }
  37. sub groupIdentifier {
  38. my $self = shift;
  39. return $self->class->group->identifier;
  40. }
  41. sub selectorParts {
  42. my $self = shift;
  43. if(@_) { @{$self->{SELECTOR_PARTS}} = @_; }
  44. return $self->{SELECTOR_PARTS};
  45. }
  46. sub setNew {
  47. my $self = shift;
  48. if(@_) { $self->{NEW} = shift; }
  49. return $self->{NEW};
  50. }
  51. sub isNew {
  52. my $self = shift;
  53. return $self->{NEW};
  54. }
  55. sub type {
  56. my $self = shift;
  57. if(@_) { $self->{TYPE} = shift; }
  58. return $self->{TYPE};
  59. }
  60. sub argnames {
  61. my $self = shift;
  62. return $self->{ARGNAMES};
  63. }
  64. sub argtypes {
  65. my $self = shift;
  66. return $self->{ARGTYPES};
  67. }
  68. ##### #
  69. # END #
  70. # #####
  71. sub numArgs {
  72. my $self = shift;
  73. return scalar @{$self->{ARGTYPES}};
  74. }
  75. sub addArgument {
  76. my $self = shift;
  77. my ($type, $name) = @_;
  78. push(@{$self->{ARGTYPES}}, $type);
  79. push(@{$self->{ARGNAMES}}, $name);
  80. }
  81. sub selector {
  82. my $self = shift;
  83. if($self->numArgs == 0) {
  84. return $self->{SELECTOR_PARTS}[0];
  85. } else {
  86. return join(":", @{$self->{SELECTOR_PARTS}}).":";
  87. }
  88. }
  89. sub _new_selector {
  90. my $self = shift;
  91. if($self->numArgs == 0) {
  92. return $self->{SELECTOR_PARTS}[0];
  93. } else {
  94. return join("\$", @{$self->{SELECTOR_PARTS}})."\$";
  95. }
  96. }
  97. sub methodFamily {
  98. my $self = shift;
  99. my $selector = $self->selector;
  100. if ($self->scope eq "+") {
  101. if ($selector =~ /^alloc($|[A-Z,:])/) {
  102. return "alloc" if $self->return eq "id" || $self->return eq "instancetype";
  103. }
  104. if ($selector eq "new") {
  105. return "new" if $self->return eq "id" || $self->return eq "instancetype";
  106. }
  107. } else {
  108. if ($selector =~ /^init($|[A-Z,:])/) {
  109. return "init" if $self->return eq "id" || $self->return eq "instancetype";
  110. }
  111. if (($selector eq "copy") || ($selector eq "copyWithZone:")) {
  112. return "copy";
  113. }
  114. if (($selector eq "mutableCopy") || ($selector eq "mutableCopyWithZone:")) {
  115. return "mutableCopy";
  116. }
  117. }
  118. return "";
  119. }
  120. sub printArgForArgType {
  121. my $argtype = shift;
  122. my $argname = shift;
  123. my ($formatchar, $fallthrough) = formatCharForArgType($argtype);
  124. return undef if $formatchar eq "--";
  125. $argtype =~ s/^\s+//g;
  126. $argtype =~ s/\s+$//g;
  127. return "NSStringFromSelector($argname)" if $argtype =~ /^SEL$/;
  128. return "$argname" if $argtype =~ /^Class$/;
  129. return "$argname.location, $argname.length" if $argtype =~ /^NSRange$/;
  130. return "$argname.origin.x, $argname.origin.y, $argname.size.width, $argname.size.height" if $argtype =~ /^(CG|NS)Rect$/;
  131. return "$argname.x, $argname.y" if $argtype =~ /^(CG|NS)Point$/;
  132. return "$argname.width, $argname.height" if $argtype =~ /^(CG|NS)Size$/;
  133. return "(long)$argname" if $argtype =~ /^NS(Integer|SocketNativeHandle|StringEncoding|SortOptions|ComparisonResult|EnumerationOptions|(Hash|Map)TableOptions|SearchPath(Directory|DomainMask))$/i;
  134. return "(unsigned long)$argname" if $argtype =~ /^NSUInteger$/i;
  135. return ($fallthrough ? "(unsigned int)" : "").$argname;
  136. }
  137. sub formatCharForArgType {
  138. local $_ = shift;
  139. s/^\s+//g;
  140. s/\s+$//g;
  141. # Integral Types
  142. # Straight characters get %c. Signed/Unsigned characters get %hhu/%hhd.
  143. return "'%c'" if /^char$/;
  144. if(/^((signed|unsigned)\s+)?(unsigned|signed|int|long|long\s+long|bool|BOOL|_Bool|char|short)$/) {
  145. my $conversion = "d";
  146. $conversion = "u" if /\bunsigned\b/;
  147. my $length;
  148. $length = "" if /\bint\b/;
  149. $length = "l" if /\blong\b/;
  150. $length = "ll" if /\blong long\b/;
  151. $length = "h" if /\bshort\b/;
  152. $length = "hh" if /\bchar\b/;
  153. return "%".$length.$conversion;
  154. }
  155. return "%ld" if /^NS(Integer|SocketNativeHandle|StringEncoding|SortOptions|ComparisonResult|EnumerationOptions|(Hash|Map)TableOptions|SearchPath(Directory|DomainMask))$/i;
  156. return "%lu" if /^NSUInteger$/i;
  157. return "%d" if /^GS(FontTraitMask)$/i;
  158. # Pointer Types
  159. return "%s" if /^char\s*\*$/;
  160. return "%p" if /^void\s*\*$/; # void *
  161. return "%p" if /^id\s*\*$/; # id *
  162. return "%p" if /^((unsigned|signed)\s+)?(unsigned|signed|int|long|long\s+long|bool|BOOL|_Bool|char|short|float|double)\s*\*+$/;
  163. return "%p" if /^NS.*?(Pointer|Array)$/;
  164. return "%p" if /^NSZone\s*\*$/;
  165. return "%p" if /^struct.*\*$/; # struct pointer
  166. return "%p" if /\*\*+$/; # anything with more than one pointer indirection
  167. return "%p" if /\[.*\]$/; # any array
  168. # Objects
  169. return "%@" if /^id$/; # id is an objc_object.
  170. return "%@" if /^\w+\s*\*$/; # try to treat *any* other pointer as an objc_object.
  171. return "%@" if /^\w+Ref$/; # *Ref can be printed with %@.
  172. # Floating-Point Types
  173. return "%f" if /^(double|float|CGFloat|CGDouble|NSTimeInterval)$/;
  174. # Special Types (should also have an entry in printArgForArgType
  175. return "%@" if /^SEL$/;
  176. return "%@" if /^Class$/;
  177. # Even-more-special expanded types
  178. return "(%d:%d)" if /^NSRange$/;
  179. return "{{%g, %g}, {%g, %g}}" if /^(CG|NS)Rect$/;
  180. return "{%g, %g}" if /^(CG|NS)Point$/;
  181. return "{%g, %g}" if /^(CG|NS)Size$/;
  182. # Discarded Types
  183. return "--" if /^(CG\w*|CF\w*|void)$/;
  184. return "--" if /^NS(HashTable(Callbacks)?|Map(Table((Key|Value)Callbacks)?|Enumerator))$/;
  185. return "--" if /^struct/; # structs that aren't covered by 'struct ... *'
  186. # Fallthrough - Treat everything we don't understand as POD.
  187. return ("0x%x", 1) if wantarray; # The 1 is the fallthrough flag - used to signal to argName(...) that we should be casting.
  188. return "0x%x";
  189. }
  190. sub typeEncodingForArgType {
  191. local $_ = shift;
  192. s/^\s+//g;
  193. s/\s+$//g;
  194. return "c" if /^char$/;
  195. return "i" if /^int$/;
  196. return "s" if /^short$/;
  197. return "l" if /^long$/;
  198. return "q" if /^long long$/;
  199. return "C" if /^unsigned\s+char$/;
  200. return "I" if /^unsigned\s+int$/;
  201. return "S" if /^unsigned\s+short$/;
  202. return "L" if /^unsigned\s+long$/;
  203. return "Q" if /^unsigned\s+long long$/;
  204. return "f" if /^float$/;
  205. return "d" if /^double$/;
  206. return "B" if /^(bool|_Bool)$/;
  207. return "v" if /^void$/;
  208. return "*" if /^char\s*\*$/;
  209. return "@" if /^id$/;
  210. return "@" if /^instancetype$/;
  211. return "#" if /^Class$/;
  212. return ":" if /^SEL$/;
  213. if(/^([^*\s]+)\s*\*$/) {
  214. my $subEncoding = typeEncodingForArgType($1);
  215. return undef if(!defined $subEncoding);
  216. return "^".$subEncoding;
  217. }
  218. return undef;
  219. }
  220. sub declarationForTypeWithName {
  221. my $argtype = shift;
  222. my $argname = shift;
  223. if($argtype !~ /\(\s*[*^]/) {
  224. return $argtype." ".$argname;
  225. }
  226. my $substring = $argtype;
  227. my ($opening, $closing) = matchedParenthesisSet($substring, 0);
  228. my $offset = 0;
  229. while(1) {
  230. # We want to put the parameter name right before the closing ) in the deepest nested set if we found a (^ or (*.
  231. $substring = substr($substring, $opening, $closing - $opening - 1);
  232. $offset += $opening;
  233. my ($newopening, $newclosing) = matchedParenthesisSet($substring, 0);
  234. last if !defined $newopening;
  235. $opening = $newopening;
  236. $closing = $newclosing;
  237. }
  238. my $out = $argtype;
  239. substr($out, $offset-$opening+$closing-1, 0, $argname);
  240. return $out;
  241. }
  242. 1;