view release on metacpan or  search on metacpan

contrib/lib/ModPerl/CScan.pm  view on Meta::CPAN

sub struct_chunks {
  my $txt = shift;
  pos $txt = 0;
  my ($b, $e, @out);
  while ($txt =~ /\b(?=struct\s*(\w*\s*)?\{)/g) {
    push @out, pos $txt;
    $txt =~ /(?=;)|\Z/g;
    push @out, pos $txt;
  }
  \@out;
}

sub typedefs_whited {		# Input is sanitized text, and list of beg/end.
  my @lst = @{$_[1]};
  my @out;
  my ($b, $e);
  while ($b = shift @lst) {
    $e = shift @lst;
    push @out, whited_decl($_[2], substr $_[0], $b, $e - $b);
  }
  \@out;
}

sub structs_whited {
  my @lst = @{$_[1]};
  my @out;
  my ($b, $e, $in);
  while ($b = shift @lst) {
    $e = shift @lst;
    $in = substr $_[0], $b, $e - $b;
    $in =~ s/^(struct\s*(\w*\s*)?)(.*)$/$1 . " " x length($3)/es;
    push @out, $in;
  }
  \@out;
}

sub typedef_texts {
  my ($txt, $chunks) = (shift, shift);
  my ($b, $e, $in, @out);
  my @in = @$chunks;
  while (($b, $e) = splice @in, 0, 2) {
    $in = substr($txt, $b, $e - $b);
    # remove any remaining directives
    $in =~ s/^ ( \s* \# .* ( \\ $ \n .* )* ) / ' ' x length($1)/xgem;
    push @out, $in;
  }
  \@out;
}

sub typedef_hash {
  my ($typedefs, $whited) = (shift,shift);
  my %out;

 loop:
  for my $o (0..$#$typedefs) {
    my $wh = $whited->[$o];
    my $td = $typedefs->[$o];
#my $verb = $td =~ /apr_child_errfn_t/ ? 1 : 0;
#warn "$wh || $td\n" if $verb;
    if ($wh =~ /,/ or not $wh =~ /\w/) { # Hard case, guessimates ...
      # Determine whether the new thingies are inside parens
      $wh =~ /,/g;
      my $p = pos $wh;
      my ($s, $e);
      if (matchingbrace($wh)) {	# Inside.  Easy part: just split on /,/...
	$e = pos($wh) - 1;
	$s = $e;
	my $d = 0;
	# Skip back
	while (--$s >= 0) {
	  my $c = substr $wh, $s, 1;
	  if ($c =~ /[\(\{\[]/) {
	    $d--;
	  } elsif ($c =~ /[\)\]\}]/) {
	    $d++;
	  }
	  last if $d < 0;
	}
	if ($s < 0) {		# Should not happen
	  warn("panic: could not match braces in\n\t$td\nwhited as\n\t$wh\n");
	  next loop;
	}
	$s++;
      } else {			# We are at toplevel
	# We need to skip back all the modifiers attached to the first thingy
	# Guesstimates: everything after the first '*' (inclusive)
	pos $wh = 0;
	$wh = /(?=\w)/g;
	my $ws = pos $wh;
	my $pre = substr $wh, 0, $ws;
	$s = $ws;
	$s = pos $pre if $pre =~ /(?=\*)/g;
	$e = length $wh;
      }
      # Now: need to split $td based on commas in $wh!
      # And need to split each chunk of $td based on word in the chunk of $wh!
      my $td_decls = substr($td, $s, $e - $s);
      my ($pre, $post) = (substr($td, 0, $s), substr($td, $e));
      my $wh_decls = substr($wh, $s, $e - $s);
      my @wh_decls = split /,/, $wh_decls;
      my $td_s = 0;
      my (@td_decl, @td_pre, @td_post, @td_word);
      for my $wh_d (@wh_decls) {
	my $td_d = substr $td, $td_s, length $wh_d;
	push @td_decl, $td_d;
	$wh_d =~ /(\w+)/g;
	push @td_word, $1;
	push @td_post, substr $td_d, pos($wh_d);
	push @td_pre,  substr $td_d, pos($wh_d) - length $1, length $1;
	$td_s += 1 + length $wh_d; # Skip over ','
      }
      for my $i (0..$#wh_decls) {
	my $p = "$td_post[$i]$post";
	$p = '' unless $p =~ /\S/;
	$out{$td_word[$i]} = ["$pre$td_pre[$i]", $p];
      }
    } elsif ($td =~ /\(\s* \*? \s* ([^)]+) \s* \) \s* \(.*\)/gxs){	# XXX: function pointer typedef
      $out{$1} = ['XXX: pre_foo', 'XXX: post_bar']; # XXX: not sure what to stuff here
      #warn "[$1] [$td]" if $verb;
    } else {			# Only one thing defined...