ARSperl

 view release on metacpan or  search on metacpan

ARS/CodeTemplate.pm  view on Meta::CPAN

sub init_template {
	%opt = ();
	Getopt::Long::Configure( 'no_ignore_case' );
	Getopt::Long::GetOptions( \%opt, 'o=s', 'x!', 'debug!', @_ );
}

sub procdef {
	my( $text ) = @_;
	my $outfile;
	if( defined $opt{'o'} ){
		$outfile = $opt{'o'};
	}else{
		$outfile = '-';
	}
	open( OUTFILE, ">$outfile" ) or die "$outfile: $!\n";
	print OUTFILE get_header( $outfile, $0 ) if $opt{'o'};
	print OUTFILE $text;
	close OUTFILE;
}

sub include {
	my( $file ) = @_;

	local $/ = undef;
	local *FILE;
	open( FILE, $file ) or do {

example/getCharSets.pl  view on Meta::CPAN

use ARS;
use strict;

die "usage: $0 server username password \n"
  unless ( $#ARGV >= 2 );

my ( $server, $user, $password, ) = ( shift, shift, shift );

# if you'd like to use UTF8:
# $ENV{'LANG'} = "en_US.utf8";

#Logging in to the server
( my $ctrl = ars_Login( $server, $user, $password ) )
  || die "ars_Login: $ars_errstr";

print "Fetching the charsets - easy...\n";

( my $servercharset = ars_GetServerCharSet($ctrl) ) || die "ERR: $ars_errstr\n";
( my $clientcharset = ars_GetClientCharSet($ctrl) ) || die "ERR: $ars_errstr\n";

infra/h2ph  view on Meta::CPAN

my %isatype;
@isatype{@isatype} = (1) x @isatype;
my $inif = 0;
my %Is_converted;

@ARGV = ('-') unless @ARGV;

build_preamble_if_necessary();

my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
my ($incl, $next);
while (defined (my $file = next_file())) {
    if (-l $file and -d $file) {
        link_if_possible($file) if ($opt_l);
        next;
    }

    # Recover from header files with unbalanced cpp directives
    $t = '';
    $tab = 0;

    # $eval_index goes into ``#line'' directives, to help locate syntax errors:
    $eval_index = 1;

    if ($file eq '-') {
	open(IN, "-");
	open(OUT, ">-");
    } else {
	($outfile = $file) =~ s/\.h$/.ph/ || next;
	print "$file -> $outfile\n" unless $opt_Q;
	if ($file =~ m|^(.*)/|) {
	    $dir = $1;
	    mkpath "$Dest_dir/$dir";
	}

	if ($opt_a) { # automagic mode:  locate header file in @inc_dirs
	    foreach (@inc_dirs) {
		chdir $_;
		last if -f $file;
	    }
	}

	open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
	open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
    }

#    print OUT "require '_h2ph_pre.ph';\n\n";   ### TS, _h2ph_pre.ph is empty anyways

    while (defined (local $_ = next_line($file))) {
	if (s/^\s*\#\s*//) {
	    if (s/^define\s+(\w+)//) {
		$name = $1;
		$new = '';
		s/\s+$//;

infra/h2ph  view on Meta::CPAN

		    }
		    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";
		    }

infra/h2ph  view on Meta::CPAN

	    next unless /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/;
	    (my $enum_subs = $3) =~ s/\s//g;
	    my @enum_subs = split(/,/, $enum_subs);
	    my $enum_val = -1;
	    foreach my $enum (@enum_subs) {
		my ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
		$enum_value =~ s/^=//;
		$enum_val = (length($enum_value) ? $enum_value : $enum_val + 1);
		if ($opt_h) {
		    print OUT ($t,
			       "eval(\"\\n#line $eval_index $outfile\\n",
			       "sub $enum_name () \{ $enum_val; \}\") ",
			       "unless defined(\&$enum_name);\n");
		    ++ $eval_index;
		} else {
		    print OUT ($t,
			       "eval(\"sub $enum_name () \{ $enum_val; \}\") ",
			       "unless defined(\&$enum_name);\n");
		}
	    }
	}

infra/mkchanges.pl  view on Meta::CPAN

use strict;
use FileHandle;
use vars qw{$opt_t $opt_f};
use Getopt::Std;

getopts('tf:');

my ($html) = defined($opt_t)?0:1;

if((!defined($opt_f)) || (! -e "$opt_f")) {
	die "usage: mkchanges.pl [-t] -f changes.dat > outputfile
-t    text output (default = html)
-f    changes.dat input file
";
}

my($f) = new FileHandle($opt_f, "r");
die "open($opt_f) failed: $!" if !defined($f);

if($html) {
	headerHTML();