view release on metacpan or  search on metacpan

infra/h2ph  view on Meta::CPAN

		    if ($args ne '') {
    	    	    	$proto = '';
			foreach my $arg (split(/,\s*/,$args)) {
			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
			    $curargs{$arg} = 1;
			}
			$args =~ s/\b(\w)/\$$1/g;
			$args = "local($args) = \@_;\n$t    ";
		    }
		    s/^\s+//;
		    expr();
		    $new =~ s/(["\\])/\\$1/g;       #"]);
		    $new = reindent($new);
		    $args = reindent($args);
		    if ($t ne '') {
			$new =~ s/(['\\])/\\$1/g;   #']);
			if ($opt_h) {
			    print OUT $t,
                            "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t    ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
                            $eval_index++;
			} else {
			    print OUT $t,
                            "eval 'sub $name $proto\{\n$t    ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
			}
		    } else {
                      print OUT "unless(defined(\&$name)) {\n    sub $name $proto\{\n\t${args}eval q($new);\n    }\n}\n";
		    }
		    %curargs = ();
		} else {
		    s/^\s+//;
		    expr();
		    $new = 1 if $new eq '';
		    $new = reindent($new);
		    $args = reindent($args);
		    if ($t ne '') {
			$new =~ s/(['\\])/\\$1/g;        #']);

			if ($opt_h) {
			    print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n";
			    $eval_index++;
			} else {
			    print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
			}
		    } else {
		    	# Shunt around such directives as `#define FOO FOO':
		    	next if " \&$name" eq $new;

                      print OUT $t,"unless(defined(\&$name)) {\n    sub $name () {\t",$new,";}\n}\n";
		    }
		}
	    } elsif (/^(include|import)\s*[<"](.*)[>"]/) {
		($incl = $2) =~ s/\.h$/.ph/;
#		print OUT $t,"require '$incl';\n";   ### TS, don't require artypes.ph
	    } elsif(/^include_next\s*[<"](.*)[>"]/) {
		($incl = $1) =~ s/\.h$/.ph/;
		print OUT ($t,
			   "eval {\n");
                $tab += 4;
                $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT ($t,
			   "my(\%INCD) = map { \$INC{\$_} => 1 } ",
			   "(grep { \$_ eq \"$incl\" } keys(\%INC));\n");
		print OUT ($t,
			   "my(\@REM) = map { \"\$_/$incl\" } ",
			   "(grep { not exists(\$INCD{\"\$_/$incl\"})",
			   "and -f \"\$_/$incl\" } \@INC);\n");
		print OUT ($t,
			   "require \"\$REM[0]\" if \@REM;\n");
                $tab -= 4;
                $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
                print OUT ($t,
			   "};\n");
		print OUT ($t,
			   "warn(\$\@) if \$\@;\n");
	    } elsif (/^ifdef\s+(\w+)/) {
		print OUT $t,"if(defined(&$1)) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    } elsif (/^ifndef\s+(\w+)/) {
		print OUT $t,"unless(defined(&$1)) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    } elsif (s/^if\s+//) {
		$new = '';
		$inif = 1;
		expr();
		$inif = 0;
		print OUT $t,"if($new) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    } elsif (s/^elif\s+//) {
		$new = '';
		$inif = 1;
		expr();
		$inif = 0;
		$tab -= 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT $t,"}\n elsif($new) {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    } elsif (/^else/) {
		$tab -= 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT $t,"} else {\n";
		$tab += 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
	    } elsif (/^endif/) {
		$tab -= 4;
		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
		print OUT $t,"}\n";
	    } elsif(/^undef\s+(\w+)/) {
		print OUT $t, "undef(&$1) if defined(&$1);\n";
	    } elsif(/^error\s+(".*")/) {
		print OUT $t, "die($1);\n";
	    } elsif(/^error\s+(.*)/) {
		print OUT $t, "die(\"", quotemeta($1), "\");\n";
	    } elsif(/^warning\s+(.*)/) {
		print OUT $t, "warn(\"", quotemeta($1), "\");\n";
	    } elsif(/^ident\s+(.*)/) {
		print OUT $t, "# $1\n";
	    }
	} elsif(/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?/) {
	    until(/\{[^}]*\}.*;/ || /;/) {
		last unless defined ($next = next_line($file));