view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

	    print "\tProcessing AR_CHAR_MENU_DD name codes..\n";
	    my($code, $line);
	    foreach $line (grep (/^\#define\s+AR_CHAR_MENU_DD_.*/, @arh)) {
		$code = (split(/\s/, $line))[1];
		print "\t\t$code\n" if $debug;
		$code =~ /^AR_CHAR_MENU_(\w+)/;
		next if ($1 eq "DD_NONE");
		next if ($1 eq "DD_FORM");
		next if ($1 eq "DD_FIELD");
		last if ($1 eq "DD_FORMAT_NONE");
		print FD "  { $code, \t\t\"\L$1\E\" },\n";
	    }
	}
	elsif(/CHARMENUDDVALUEMAP/) {
	    print "\tProcessing AR_CHAR_MENU_DD value format..\n";
	    my($code, $line);
	    foreach $line (grep (/^\#define\s+AR_CHAR_MENU_DD_FORMAT_.*/, @arh)) {
		$code = (split(/\s/, $line))[1];
		print "\t\t$code\n" if $debug;
		$code =~ /^AR_CHAR_MENU_(\w+)/;
		print FD "  { $code, \t\t\"\L$1\E\" },\n";
	    }
	}
	elsif(/CHARMENUTYPEMAP/) {
	    print "\tProcessing AR_CHAR_MENU codes..\n";
	    my($code, $line);
	    foreach $line (grep (/^\#define\s+AR_CHAR_MENU.*/, @arh)) {
		$code = (split(/\s/, $line))[1];
		print "\t\t$code\n" if $debug;
		$code =~ /^AR_CHAR_MENU_(\w+)/;
		next if ($1 =~ m/^DD_/);
		print FD "  { $code, \t\t\"\L$1\E\" },\n";
	    }
	}
	elsif(/STATUSRETURNTYPEMAP/) {
	    print "\tProcessing AR_RETURN codes..\n";
	    my($code, $line);
	    foreach $line (grep (/^\#define\s+AR_RETURN.*/, @arh)) {
		$code = (split(/\s/, $line))[1];
		print "\t\t$code\n" if $debug;
		$code =~ /^AR_RETURN_(\w+)/;
		print FD "  { $code, \t\t\"\L$1\E\" },\n";
	    }
	}
	elsif(/SERVERSTATTYPEMAP/) {
	    print "\tProcessing AR_SERVER_STAT codes..\n";
	    my($code, $line);
	    foreach $line (grep (/^\#define\s+AR_SERVER_STAT.*/, @arh)) {
		$code = (split(/\s/, $line))[1];
		print "\t\t$code\n" if $debug;
		$code =~ /^AR_SERVER_STAT_(\w+)/;
		print FD "  { $code, \t\t\"\L$1\E\" },\n";
	    }
	}
	elsif(/SCHEMAPERMISSIONTYPEMAP/) {
	    print "\tProcessing AR_PERMISSIONS (Schema) codes..\n";
	    my($code, $line);
	    foreach $line (grep (/^\#define\s+AR_PERMISSIONS.*/, @arh)) {
		$code = (split(/\s/, $line))[1];

		# _view & _change are field permissions
		# it would be nice if AR_PERM.. differentiated between
		# schema and field.

		if($code !~ /_VIEW|_CHANGE/) {
		    print "\t\t$code\n" if $debug;
		    $code =~ /^AR_PERMISSIONS_(\w+)/;
		    print FD "  { $code, \t\t\"\L$1\E\" },\n";
		}
	    }
	}
	elsif(/FIELDPERMISSIONTYPEMAP/) {
	    print "\tProcessing AR_PERMISSIONS (Field) codes..\n";
	    my($code, $line);
	    foreach $line (grep (/^\#define\s+AR_PERMISSIONS.*/, @arh)) {
		$code = (split(/\s/, $line))[1];

		# _visible & _hidden are schema permissions
		if($code !~ /_VISIBLE|_HIDDEN/) {
		    print "\t\t$code\n" if $debug;
		    $code =~ /^AR_PERMISSIONS_(\w+)/;
		    print FD "  { $code, \t\t\"\L$1\E\" },\n";
		}
	    }
	}
	elsif(/DATATYPEMAP/) {
	    print "\tProcessing AR_DATA_TYPE codes..\n";
	    my($code, $line);
	    foreach $line (grep (/^\#define\s+AR_DATA_TYPE.*/, @arh)) {
		$code = (split(/\s/, $line))[1];

		print "\t\t$code\n" if $debug;
		$code =~ /^AR_DATA_TYPE_(\w+)/;
		print FD "  { $code, \t\t\"\L$1\E\" },\n";
	    }
	}
        elsif(/SCHEMATYPEMAP/) {
            print "\tProcessing AR_SCHEMA codes..\n";
            my($code, $line);
            foreach $line (grep (/^\#define\s+AR_SCHEMA.*/, @arh)) {
		# another instance of poor naming conventions
		next if $line =~ /_DELETE/;
                $code = (split(/\s/, $line))[1];

                print "\t\t$code\n" if $debug;
                $code =~ /^AR_SCHEMA_(\w+)/;
                print FD "  { $code, \t\t\"\L$1\E\" },\n";
            }
        }
        elsif(/STRUCTITEMTYPEMAP/) {
            print "\tProcessing AR_STRUCT_ITEM codes..\n";
            my($code, $line);
            foreach $line (grep (/^\#define\s+AR_STRUCT_ITEM.*/, @arh)) {
                $code = (split(/\s/, $line))[1];

                print "\t\t$code\n" if $debug;
                $code =~ /^AR_STRUCT_ITEM_(\w+)/;
                print FD "  { $code, \t\t\"\L$1\E\" },\n";
            }
        }
	elsif(/BYTELISTTYPEMAP/) {

Makefile.PL  view on Meta::CPAN

	if($TCPPORT eq "") {
		$TCPPORT = $T if ($T ne "");
	} 
	$TCPPORT = 0 if ! $TCPPORT;

	#print "Storing $SERVER / $USERNAME / $PASSWORD ..\n";
	open (FD, "> ./t/config.cache") || die "open failed: $!";
	print FD "package CCACHE;\n";
	print FD "\# enter your server, admin username and password below.\n\n";
	print FD "sub SERVER { \"$SERVER\" ; }\n";
	print FD "sub USERNAME { \"$USERNAME\" ; }\n";
	print FD "sub PASSWORD { \"$PASSWORD\" ; }\n";
	print FD "sub TCPPORT { $TCPPORT ; }\n";
	print FD "1;\n";
	close(FD);

}



#
# given a path to the Api directory, go find ar.h and parse the value
#  of the AR_CURRENT_API_VERSION #define and return it.
# if the path to ar.h is, e.g.,
#  c:\Program Files\ARSystem6.0.1\Arserver\Api\include\ar.h
# then this method wants an appropriately quoted
#  c:\Program Files\ARSystem6.0.1\Arserver\Api
# as its first arg
#
sub findAPIVersion {
  my $path_to_api_dir = shift;

  my $ar_fname = join('/', $path_to_api_dir, 'include', 'ar.h');
  open ($ar_fh, '<'. $ar_fname) or
    die "couldn't open ar.h include file from: \"$ar_fname\": $!\n";

  my $api_version = undef;

  # the line we want to parse looks like:
  #
  ##define AR_CURRENT_API_VERSION       10  /* current api version */
  while (<$ar_fh>) {
    chomp;
    if (m/^\s*#define\s*AR_CURRENT_API_VERSION\s*(\d+)/) {
      $api_version = $1;
      last;
    }
  }

  close $ar_fh;
  return $api_version;
}


#
# given an API version from above, return the minimum server version
#  that supports it.
# That is, if an API version is supported by multiple releases of the
#  AR System Server, we return the chronologically first version
#  since compiling against that version will have been the first
#  time we have arsperl will have to change to support the API change.
#
# this whole strategy of deriving the server version from the api version
#  presumes that we won't have to distinguish between releases of the
#  same api version, which may or may not be correct.
#
# the api version can be the main variable arsperl uses to adjust
#  itself however.
#

sub serverReleaseFromAPIVersion {
  my $api_version = shift;

  # keys are server releases converted to floating point numbers;
  #  values are the api version that release produced.
  # add more values to this table as needed.
  my $rh_api_version_table =
    {
     4.5  => 7,
     4.51 => 7,
     4.52 => 7,
     5.0  => 8,
     5.01 => 8,
     5.1  => 9,
     5.11 => 9,
     5.12 => 9,
     6.0  => 10,
     6.01 => 10,
     6.3  => 11,
    };

  my @api_list = ();
  # make a sorted list from the api version / server release values
  #  that match our api version.
  while (($server_rel, $api) = each %{$rh_api_version_table}) {
    if ($api_version == $api) {
      push @api_list, $server_rel;
    }
  }

  # make sure the values are treated as numbers during the sort
  my @sorted = sort { ($a + 0) <=> ($b + 0) }@api_list;

  return $sorted[0];
}

sub findArLibs {
  my $path_to_api_dir = shift;

  my $cwd = getcwd();
  my $ar_lib_dir = join('/', $path_to_api_dir, 'lib');
  chdir($ar_lib_dir);

  # we want all of the files that end in .lib on win32
  my @libs = <*.lib>;
  chdir($cwd);

  return \@libs;
}

sub ARS_VERSION_45  {  7; }