package Function; use strict; use warnings; use Util; use FunctionBase; # These flags indicate whether parameters are optional or output parameters. use constant FLAG_PARAM_OPTIONAL => 1; use constant FLAG_PARAM_OUTPUT => 2; # These flags indicate how an empty string shall be translated to a C string: # to a nullptr or to a pointer to an empty string. use constant FLAG_PARAM_NULLPTR => 4; use constant FLAG_PARAM_EMPTY_STRING => 8; BEGIN { use Exporter (); our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); # set the version for version checking $VERSION = 1.00; @ISA = qw(FunctionBase); @EXPORT = qw(&func1 &func2 &func4); %EXPORT_TAGS = ( ); # your exported package globals go here, # as well as any optionally exported functions @EXPORT_OK = qw($Var1 %Hashit &func3 FLAG_PARAM_OPTIONAL FLAG_PARAM_OUTPUT FLAG_PARAM_NULLPTR FLAG_PARAM_EMPTY_STRING); } our @EXPORT_OK; ################################################## ### Function # Commonly used algorithm for parsing a function declaration into # its component pieces # # class Function : FunctionBase # { # string rettype; # bool const; # bool static; # string name; e.g. gtk_accelerator_valid # string c_name; # string array param_type; # string array param_name; # string array param_default_value; # int array param_flags; (stores flags form params: 1 => optional, 2 => output) # hash param_mappings; (maps C param names (if specified) to the C++ index) # string array possible_args_list; (a list of space separated indexes) # string in_module; e.g. Gtk # string signal_when. e.g. first, last, or both. # string class e.g. GtkButton ( == of-object. Useful for signal because their names are not unique. # string entity_type. e.g. method or signal # } # Subroutine to get an array of string of indices representing the possible # combination of arguments based on whether some parameters are optional. sub possible_args_list($$); sub new_empty() { my $self = {}; bless $self; return $self; } # $objFunction new($function_declaration, $objWrapParser) sub new($$) { #Parse a function/method declaration. #e.g. guint gtk_something_set_thing(guint a, const gchar* something) my ($line, $objWrapParser) = @_; my $self = {}; bless $self; #Initialize member data: $$self{rettype} = ""; $$self{rettype_needs_ref} = 0; #Often the gtk function doesn't do an extra ref for the receiver. $$self{const} = 0; $$self{name} = ""; $$self{param_types} = []; $$self{param_names} = []; $$self{param_default_values} = []; $$self{param_flags} = []; $$self{param_mappings} = {}; $$self{possible_args_list} = []; $$self{in_module} = ""; $$self{class} = ""; $$self{entity_type} = "method"; $line =~ s/^\s+//; # Remove leading whitespace. $line =~ s/\s+/ /g; # Compress white space. if ($line =~ /^static\s+([^()]+)\s+(\S+)\s*\((.*)\)\s*$/) { $$self{rettype} = $1; $$self{name} = $2; $$self{c_name} = $2; $self->parse_param($3); $$self{static} = 1; } elsif ($line =~ /^([^()]+)\s+(\S+)\s*\((.*)\)\s*(const)*$/) { $$self{rettype} = $1; $$self{name} = $2; $$self{c_name} = $2; $self->parse_param($3); $$self{const} = defined($4); } else { $objWrapParser->error("fail to parse $line\n"); } # Store the list of possible argument combinations based on if arguments # are optional. my $possible_args_list = $$self{possible_args_list}; push(@$possible_args_list, $self->possible_args_list()); return $self; } # $objFunction new_ctor($function_declaration, $objWrapParser) # Like new(), but the function_declaration doesn't need a return type. sub new_ctor($$) { #Parse a function/method declaration. #e.g. guint gtk_something_set_thing(guint a, const gchar* something) my ($line, $objWrapParser) = @_; my $self = {}; bless $self; #Initialize member data: $$self{rettype} = ""; $$self{rettype_needs_ref} = 0; $$self{const} = 0; $$self{name} = ""; $$self{param_types} = []; $$self{param_names} = []; $$self{param_default_values} = []; $$self{param_flags} = []; $$self{param_mappings} = {}; $$self{possible_args_list} = []; $$self{in_module} = ""; $$self{class} = ""; $$self{entity_type} = "method"; $line =~ s/^\s+//; # Remove leading whitespace. $line =~ s/\s+/ /g; # Compress white space. if ($line =~ /^(\S+)\s*\((.*)\)\s*/) { $$self{name} = $1; $$self{c_name} = $1; $self->parse_param($2); } else { $objWrapParser->error("fail to parse $line\n"); } # Store the list of possible argument combinations based on if arguments # are optional. my $possible_args_list = $$self{possible_args_list}; push(@$possible_args_list, $self->possible_args_list()); return $self; } # $num num_args() sub num_args #($) { my ($self) = @_; my $param_types = $$self{param_types}; return $#$param_types+1; } # parses C++ parameter lists. # forms a list of types, names, and default values sub parse_param($$) { my ($self, $line) = @_; my $type = ""; my $name = ""; my $name_pos = -1; my $value = ""; my $id = 0; my $has_value = 0; my $flags = 0; my $curr_param = 0; my $param_types = $$self{param_types}; my $param_names = $$self{param_names}; my $param_default_values = $$self{param_default_values}; my $param_flags = $$self{param_flags}; my $param_mappings = $$self{param_mappings}; # Mappings from a C name to this C++ param defaults to empty (no mapping). my $mapping = ""; # clean up space and handle empty case $line = string_trim($line); $line =~ s/\s+/ /g; # Compress whitespace. return if ($line =~ /^$/); # Add a ',' at the end. No special treatment of the last parameter is necessary, # if it's followed by a comma, like the other parameters. $line .= ',' if (substr($line, -1) ne ','); # Parse through the argument list. # # We must find commas (,) that separate parameters, and equal signs (=) that # separate parameter names from optional default values. # '&', '*' and '>' are delimiters in split() because they must be separated # from the parameter name even if there is no space char between. # Commas within "<.,.>" or "{.,.}" or "(.,.)" do not end a parameter. # This parsing is not guaranteed to work well if there are several levels # of (()) or {{}}. X> works in the normal case where there is nothing # but possibly spaces between the multiple ">>". # Quoted strings are not detected. If a quoted string exists in a function # prototype, it's probably as part of a default value, inside ("x") or {"y"}. # my @str = (); foreach (split(/(\bconst\b|[,=&*>]|<.*?>|{.*?}|\(.*?\)|\s+)/, $line)) { next if ( !defined($_) or $_ eq "" ); if ($_ =~ /^(?:const|[*&>]|<.*>|\(.*\)|\s+)$/) { # Any separator, except ',' or '=' or {.*}. push(@str, $_); next; } elsif ($_ =~ /^{(.*)}$/) { if (!$has_value) { # gmmproc options have been specified for the current parameter so # process them. # Get the options. my $options = $1; # Check if param should be optional or an output param. $flags = FLAG_PARAM_OPTIONAL if($options =~ /\?/); $flags |= FLAG_PARAM_OUTPUT if($options =~ />>/); # Delete "NULL" from $options, so it won't be interpreted as a parameter name. if ($options =~ s/(!?\bNULL\b)//) { $flags |= ($1 eq "!NULL") ? FLAG_PARAM_EMPTY_STRING : FLAG_PARAM_NULLPTR; } # Check if it should be mapped to a C param. if ($options =~ /(\w+|\.)/) { $mapping = $1; $mapping = $name if($mapping eq "."); } } else { # {...} in a default value. push(@str, $_); } next; } elsif ( $_ eq "=" ) #Default value { $str[$name_pos] = "" if ($name_pos >= 0); # The type is everything before the = character, except the parameter name. $type = join("", @str); @str = (); #Wipe it so that it will only contain the default value, which comes next. $has_value = 1; next; } elsif ( $_ eq "," ) #The end of one parameter: { if ($has_value) { $value = join("", @str); # If there's a default value, then it's the part before the next ",". } else { $str[$name_pos] = "" if ($name_pos >= 0); $type = join("", @str); } if ($name eq "") { $name = sprintf("p%s", $#$param_types + 2) } $type = string_trim($type); push(@$param_types, $type); push(@$param_names, $name); push(@$param_default_values, $value); push(@$param_flags, $flags); # Map from the c_name to the C++ index (no map if no name given). $$param_mappings{$mapping} = $curr_param if($mapping); #Clear variables, ready for the next parameter. @str = (); $type= ""; $value = ""; $has_value = 0; $name = ""; $name_pos = -1; $flags = 0; $curr_param++; # Mappings from a C name to this C++ param defaults to empty (no mapping). $mapping = ""; $id = 0; next; } # Anything but a separator in split(). push(@str, $_); if (!$has_value) { # The last identifier before ',', '=', or '{.*}' is the parameter name. # E.g. int name, unsigned long int name = 42, const unsigned int& name. # The name must be preceded by at least one other identifier (the type). # 'const' is treated specially, as it can't by itself denote the type. $id++; if ($id >= 2) { $name = $_; $name_pos = $#str; } } } # end foreach } # add_parameter_autoname($, $type, $name) # Adds e.g "sometype somename" sub add_parameter_autoname($$) { my ($self, $type) = @_; add_parameter($self, $type, ""); } # add_parameter($, $type, $name) # Adds e.g GtkSomething* p1" sub add_parameter($$$) { my ($self, $type, $name) = @_; $type = string_unquote($type); $type =~ s/-/ /g; my $param_names = $$self{param_names}; if ($name eq "") { $name = sprintf("p%s", $#$param_names + 2); } push(@$param_names, $name); my $param_types = $$self{param_types}; push(@$param_types, $type); return $self; } # $string get_refdoc_comment($existing_signal_docs, $signal_flags) # Generate a readable prototype for signals and merge the prototype into the # existing Doxygen comment block. sub get_refdoc_comment($$$) { my ($self, $documentation, $signal_flags) = @_; my $str = " /**\n"; $str .= " * \@par Slot Prototype:\n"; $str .= " * $$self{rettype} on_my_\%$$self{name}("; my $param_names = $$self{param_names}; my $param_types = $$self{param_types}; my $num_params = scalar(@$param_types); # List the parameters: for(my $i = 0; $i < $num_params; ++$i) { $str .= $$param_types[$i] . ' ' . $$param_names[$i]; $str .= ", " if($i < $num_params - 1); } $str .= ")\n"; $str .= " *\n"; if ($signal_flags) { $str .= " * Flags: $signal_flags\n *\n"; } if($documentation ne "") { # Remove the initial '/** ' from the existing docs and merge it. $documentation =~ s/\/\*\*\s+/ \* /; $str .= $documentation; } else { # Close the doc block if there's no existing docs. $str .= " */\n"; } # Return the merged documentation. return $str; } sub get_is_const($) { my ($self) = @_; return $$self{const}; } # string array possible_args_list() # Returns an array of string of space separated indexes representing the # possible argument combinations based on whether parameters are optional. sub possible_args_list($$) { my ($self, $start_index) = @_; my $param_names = $$self{param_names}; my $param_types = $$self{param_types}; my $param_flags = $$self{param_flags}; my @result = (); # Default starting index is 0 (The first call will have an undefined start # index). my $i = $start_index || 0; if($i > $#$param_types) { # If index is past last arg, return an empty array inserting an empty # string if this function has no parameters. push(@result, "") if ($i == 0); return @result; } elsif($i == $#$param_types) { # If it's the last arg just add its index: push(@result, "$i"); # And if it's optional also add an empty string to represent that it is # not added. push(@result, "") if ($$param_flags[$i] & FLAG_PARAM_OPTIONAL); return @result; } # Get the possible indices for remaining params without this one. my @remaining = possible_args_list($self, $i + 1); # Prepend this param's index to the remaining ones. foreach my $possibility (@remaining) { if($possibility) { push(@result, "$i " . $possibility); } else { push(@result, "$i"); } } # If this parameter is optional, append the remaining possibilities without # this param's type and name. if($$param_flags[$i] & FLAG_PARAM_OPTIONAL) { foreach my $possibility (@remaining) { push(@result, $possibility); } } return @result; } 1; # indicate proper module load.