mkdef.pl

mediastreamer2是开源的网络传输媒体流的库

	# endif
	foreach $platform (split /,/, $pl) {
		if ($platform =~ /^!(.*)$/) {
			$p{$1}--;
		} else {
			$p{$platform}++;
		}
	}
	foreach $platform (keys %p) {
		if ($p{$platform} == 0) { delete $p{$platform}; }
	}

	delete $p{""};

	$ret = join(',',sort(map { $p{$_} < 0 ? "!".$_ : $_ } keys %p));
	print STDERR "DEBUG: Exiting reduce_platforms with \"$ret\"\n"
	    if $debug;
	return $ret;
}

sub info_string {
	(my $symbol, my $exist, my $platforms, my $kind, my $algorithms) = @_;

	my %a = defined($algorithms) ?
	    map { $_ => 1 } split /,/, $algorithms : ();
	my $k = defined($kind) ? $kind : "FUNCTION";
	my $ret;
	my $p = &reduce_platforms($platforms);

	delete $a{""};

	$ret = $exist;
	$ret .= ":".$p;
	$ret .= ":".$k;
	$ret .= ":".join(',',sort keys %a);
	return $ret;
}

sub maybe_add_info {
	(my $name, *nums, my @symbols) = @_;
	my $sym;
	my $new_info = 0;
	my %syms=();

	print STDERR "Updating $name info\n";
	foreach $sym (@symbols) {
		(my $s, my $i) = split /\\/, $sym;
		if (defined($nums{$s})) {
			$i =~ s/^(.*?:.*?:\w+)(\(\w+\))?/$1/;
			(my $n, my $dummy) = split /\\/, $nums{$s};
			if (!defined($dummy) || $i ne $dummy) {
				$nums{$s} = $n."\\".$i;
				$new_info++;
				print STDERR "DEBUG: maybe_add_info for $s: \"$dummy\" => \"$i\"\n" if $debug;
			}
		}
		$syms{$s} = 1;
	}

	my @s=sort { &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n") } keys %nums;
	foreach $sym (@s) {
		(my $n, my $i) = split /\\/, $nums{$sym};
		if (!defined($syms{$sym}) && $i !~ /^NOEXIST:/) {
			$new_info++;
			print STDERR "DEBUG: maybe_add_info for $sym: -> undefined\n" if $debug;
		}
	}
	if ($new_info) {
		print STDERR "$new_info old symbols got an info update\n";
		if (!$do_rewrite) {
			print STDERR "You should do a rewrite to fix this.\n";
		}
	} else {
		print STDERR "No old symbols needed info update\n";
	}
}

# Param: string of comma-separated keywords, each possibly prefixed with a "!"
sub is_valid
{
	my ($keywords_txt,$platforms) = @_;
	my (@keywords) = split /,/,$keywords_txt;
	my ($falsesum, $truesum) = (0, 1);

	# Param: one keyword
	sub recognise
	{
		my ($keyword,$platforms) = @_;

		if ($platforms) {
			# platforms
			if ($keyword eq "VMS" && $VMS) { return 1; }
			if ($keyword eq "WIN32" && $W32) { return 1; }
			if ($keyword eq "WIN16" && $W16) { return 1; }
			if ($keyword eq "WINNT" && $NT) { return 1; }
			if ($keyword eq "OS2" && $OS2) { return 1; }
			# Special platforms:
			# EXPORT_VAR_AS_FUNCTION means that global variables
			# will be represented as functions.  This currently
			# only happens on VMS-VAX.
			if ($keyword eq "EXPORT_VAR_AS_FUNCTION" && ($VMSVAX || $W32 || $W16)) {
				return 1;
			}
			return 0;
		} else {
			# algorithms
			if ($keyword eq "RC2" && $no_rc2) { return 0; }
			if ($keyword eq "RC4" && $no_rc4) { return 0; }
			if ($keyword eq "RC5" && $no_rc5) { return 0; }
			if ($keyword eq "IDEA" && $no_idea) { return 0; }
			if ($keyword eq "DES" && $no_des) { return 0; }
			if ($keyword eq "BF" && $no_bf) { return 0; }
			if ($keyword eq "CAST" && $no_cast) { return 0; }
			if ($keyword eq "MD2" && $no_md2) { return 0; }
			if ($keyword eq "MD4" && $no_md4) { return 0; }
			if ($keyword eq "MD5" && $no_md5) { return 0; }
			if ($keyword eq "SHA" && $no_sha) { return 0; }
			if ($keyword eq "RIPEMD" && $no_ripemd) { return 0; }
			if ($keyword eq "MDC2" && $no_mdc2) { return 0; }
			if ($keyword eq "RSA" && $no_rsa) { return 0; }
			if ($keyword eq "DSA" && $no_dsa) { return 0; }
			if ($keyword eq "DH" && $no_dh) { return 0; }
			if ($keyword eq "EC" && $no_ec) { return 0; }
			if ($keyword eq "ECDSA" && $no_ecdsa) { return 0; }
			if ($keyword eq "ECDH" && $no_ecdh) { return 0; }
			if ($keyword eq "HMAC" && $no_hmac) { return 0; }
			if ($keyword eq "AES" && $no_aes) { return 0; }
			if ($keyword eq "EVP" && $no_evp) { return 0; }
			if ($keyword eq "LHASH" && $no_lhash) { return 0; }
			if ($keyword eq "STACK" && $no_stack) { return 0; }
			if ($keyword eq "ERR" && $no_err) { return 0; }
			if ($keyword eq "BUFFER" && $no_buffer) { return 0; }
			if ($keyword eq "BIO" && $no_bio) { return 0; }
			if ($keyword eq "COMP" && $no_comp) { return 0; }
			if ($keyword eq "DSO" && $no_dso) { return 0; }
			if ($keyword eq "KRB5" && $no_krb5) { return 0; }
			if ($keyword eq "ENGINE" && $no_engine) { return 0; }
			if ($keyword eq "HW" && $no_hw) { return 0; }
			if ($keyword eq "FP_API" && $no_fp_api) { return 0; }
			if ($keyword eq "STATIC_ENGINE" && $no_static_engine) { return 0; }
			if ($keyword eq "GMP" && $no_gmp) { return 0; }
			if ($keyword eq "DEPRECATED" && $no_deprecated) { return 0; }

			# Nothing recognise as true
			return 1;
		}
	}

	foreach $k (@keywords) {
		if ($k =~ /^!(.*)$/) {
			$falsesum += &recognise($1,$platforms);
		} else {
			$truesum *= &recognise($k,$platforms);
		}
	}
	print STDERR "DEBUG: [",$#keywords,",",$#keywords < 0,"] is_valid($keywords_txt) => (\!$falsesum) && $truesum = ",(!$falsesum) && $truesum,"\n" if $debug;
	return (!$falsesum) && $truesum;
}

sub print_test_file
{
	(*OUT,my $name,*nums,my $testall,my @symbols)=@_;
	my $n = 1; my @e; my @r;
	my $sym; my $prev = ""; my $prefSSLeay;

	(@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
	(@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:.*/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:.*/,@symbols);
	@symbols=((sort @e),(sort @r));

	foreach $sym (@symbols) {
		(my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
		my $v = 0;
		$v = 1 if $i=~ /^.*?:.*?:VARIABLE/;
		my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
		my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
		if (!defined($nums{$s})) {
			print STDERR "Warning: $s does not have a number assigned\n"
			    if(!$do_update);
		} elsif (is_valid($p,1) && is_valid($a,0)) {
			my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
			if ($prev eq $s2) {
				print OUT "\t/* The following has already appeared previously */\n";
				print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
			}
			$prev = $s2;	# To warn about duplicates...

			($nn,$ni)=($nums{$s2} =~ /^(.*?)\\(.*)$/);
			if ($v) {
				print OUT "\textern int $s2; /* type unknown */ /* $nn $ni */\n";
			} else {
				print OUT "\textern int $s2(); /* type unknown */ /* $nn $ni */\n";
			}
		}
	}
}

sub get_version {
   local *MF;
   my $v = '?';
   open MF, 'Makefile' or return $v;
   while (<MF>) {
     $v = $1, last if /^VERSION=(.*?)\s*$/;
   }
   close MF;
   return $v;
}

sub print_def_file
{
	(*OUT,my $name,*nums,my @symbols)=@_;
	my $n = 1; my @e; my @r; my @v; my $prev="";
	my $liboptions="";
	my $libname = $name;
	my $http_vendor = 'www.openssl.org/';
	my $version = get_version();
	my $what = "OpenSSL: implementation of Secure Socket Layer";
	my $description = "$what $version, $name - http://$http_vendor";

	if ($W32)
		{ $libname.="32"; }
	elsif ($W16)
		{ $libname.="16"; }
	elsif ($OS2)
		{ # DLL names should not clash on the whole system.
		  # However, they should not have any particular relationship
		  # to the name of the static library.  Chose descriptive names
		  # (must be at most 8 chars).
		  my %translate = (ssl => 'open_ssl', crypto => 'cryptssl');
		  $libname = $translate{$name} || $name;
		  $liboptions = <<EOO;
INITINSTANCE
DATA MULTIPLE NONSHARED
EOO
		  # Vendor field can't contain colon, drat; so we omit http://
		  $description = "\@#$http_vendor:$version#\@$what; DLL for library $name.  Build for EMX -Zmtd";
		}

	print OUT <<"EOF";
;
; Definition file for the DLL version of the $name library from OpenSSL
;

LIBRARY         $libname	$liboptions

DESCRIPTION     '$description'

EOF

	if ($W16) {
		print <<"EOF";
CODE            PRELOAD MOVEABLE
DATA            PRELOAD MOVEABLE SINGLE

EXETYPE		WINDOWS

HEAPSIZE	4096
STACKSIZE	8192

EOF
	}

	print "EXPORTS\n";

	(@e)=grep(/^SSLeay(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols);
	(@r)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:FUNCTION/ && !/^SSLeay(\{[0-9]+\})?\\.*?:.*?:FUNCTION/,@symbols);
	(@v)=grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:VARIABLE/,@symbols);
	@symbols=((sort @e),(sort @r), (sort @v));


	foreach $sym (@symbols) {
		(my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
		my $v = 0;
		$v = 1 if $i =~ /^.*?:.*?:VARIABLE/;
		if (!defined($nums{$s})) {
			printf STDERR "Warning: $s does not have a number assigned\n"
			    if(!$do_update);
		} else {
			(my $n, my $dummy) = split /\\/, $nums{$s};
			my %pf = ();
			my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
			my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
			if (is_valid($p,1) && is_valid($a,0)) {
				my $s2 = ($s =~ /^(.*?)(\{[0-9]+\})?$/, $1);
				if ($prev eq $s2) {
					print STDERR "Warning: Symbol '",$s2,"' redefined. old=",($nums{$prev} =~ /^(.*?)\\/,$1),", new=",($nums{$s2} =~ /^(.*?)\\/,$1),"\n";
				}
				$prev = $s2;	# To warn about duplicates...
				if($v && !$OS2) {
					printf OUT "    %s%-39s @%-8d DATA\n",($W32)?"":"_",$s2,$n;
				} else {
					printf OUT "    %s%-39s @%d\n",($W32||$OS2)?"":"_",$s2,$n;
				}
			}
		}
	}
	printf OUT "\n";
}

sub load_numbers
{
	my($name)=@_;
	my(@a,%ret);

	$max_num = 0;
	$num_noinfo = 0;
	$prev = "";
	$prev_cnt = 0;

	open(IN,"<$name") || die "unable to open $name:$!\n";
	while (<IN>) {
		chop;
		s/#.*$//;
		next if /^\s*$/;
		@a=split;
		if (defined $ret{$a[0]}) {
			# This is actually perfectly OK
			#print STDERR "Warning: Symbol '",$a[0],"' redefined. old=",$ret{$a[0]},", new=",$a[1],"\n";
		}
		if ($max_num > $a[1]) {
			print STDERR "Warning: Number decreased from ",$max_num," to ",$a[1],"\n";
		}
		elsif ($max_num == $a[1]) {
			# This is actually perfectly OK
			#print STDERR "Warning: Symbol ",$a[0]," has same number as previous ",$prev,": ",$a[1],"\n";
			if ($a[0] eq $prev) {
				$prev_cnt++;
				$a[0] .= "{$prev_cnt}";
			}
		}
		else {
			$prev_cnt = 0;
		}
		if ($#a < 2) {
			# Existence will be proven later, in do_defs
			$ret{$a[0]}=$a[1];
			$num_noinfo++;
		} else {
			$ret{$a[0]}=$a[1]."\\".$a[2]; # \\ is a special marker
		}
		$max_num = $a[1] if $a[1] > $max_num;
		$prev=$a[0];
	}
	if ($num_noinfo) {
		print STDERR "Warning: $num_noinfo symbols were without info.";
		if ($do_rewrite) {
			printf STDERR "  The rewrite will fix this.\n";
		} else {
			printf STDERR "  You should do a rewrite to fix this.\n";
		}
	}
	close(IN);
	return(%ret);
}

sub parse_number
{
	(my $str, my $what) = @_;
	(my $n, my $i) = split(/\\/,$str);
	if ($what eq "n") {
		return $n;
	} else {
		return $i;
	}
}

sub rewrite_numbers
{
	(*OUT,$name,*nums,@symbols)=@_;
	my $thing;

	print STDERR "Rewriting $name\n";

	my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
	my $r; my %r; my %rsyms;
	foreach $r (@r) {
		(my $s, my $i) = split /\\/, $r;
		my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
		$i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
		$r{$a} = $s."\\".$i;
		$rsyms{$s} = 1;
	}

	my %syms = ();
	foreach $_ (@symbols) {
		(my $n, my $i) = split /\\/;
		$syms{$n} = 1;
	}

	my @s=sort {
	    &parse_number($nums{$a},"n") <=> &parse_number($nums{$b},"n")
	    || $a cmp $b
	} keys %nums;
	foreach $sym (@s) {
		(my $n, my $i) = split /\\/, $nums{$sym};
		next if defined($i) && $i =~ /^.*?:.*?:\w+\(\w+\)/;
		next if defined($rsyms{$sym});
		print STDERR "DEBUG: rewrite_numbers for sym = ",$sym,": i = ",$i,", n = ",$n,", rsym{sym} = ",$rsyms{$sym},"syms{sym} = ",$syms{$sym},"\n" if $debug;
		$i="NOEXIST::FUNCTION:"
			if !defined($i) || $i eq "" || !defined($syms{$sym});
		my $s2 = $sym;
		$s2 =~ s/\{[0-9]+\}$//;
		printf OUT "%s%-39s %d\t%s\n","",$s2,$n,$i;
		if (exists $r{$sym}) {
			(my $s, $i) = split /\\/,$r{$sym};
			my $s2 = $s;
			$s2 =~ s/\{[0-9]+\}$//;
			printf OUT "%s%-39s %d\t%s\n","",$s2,$n,$i;
		}
	}
}

sub update_numbers
{
	(*OUT,$name,*nums,my $start_num, my @symbols)=@_;
	my $new_syms = 0;

	print STDERR "Updating $name numbers\n";

	my @r = grep(/^\w+(\{[0-9]+\})?\\.*?:.*?:\w+\(\w+\)/,@symbols);
	my $r; my %r; my %rsyms;
	foreach $r (@r) {
		(my $s, my $i) = split /\\/, $r;
		my $a = $1 if $i =~ /^.*?:.*?:\w+\((\w+)\)/;
		$i =~ s/^(.*?:.*?:\w+)\(\w+\)/$1/;
		$r{$a} = $s."\\".$i;
		$rsyms{$s} = 1;
	}

	foreach $sym (@symbols) {
		(my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
		next if $i =~ /^.*?:.*?:\w+\(\w+\)/;
		next if defined($rsyms{$sym});
		die "ERROR: Symbol $sym had no info attached to it."
		    if $i eq "";
		if (!exists $nums{$s}) {
			$new_syms++;
			my $s2 = $s;
			$s2 =~ s/\{[0-9]+\}$//;
			printf OUT "%s%-39s %d\t%s\n","",$s2, ++$start_num,$i;
			if (exists $r{$s}) {
				($s, $i) = split /\\/,$r{$s};
				$s =~ s/\{[0-9]+\}$//;
				printf OUT "%s%-39s %d\t%s\n","",$s, $start_num,$i;
			}
		}
	}
	if($new_syms) {
		print STDERR "$new_syms New symbols added\n";
	} else {
		print STDERR "No New symbols Added\n";
	}
}

sub check_existing
{
	(*nums, my @symbols)=@_;
	my %existing; my @remaining;
	@remaining=();
	foreach $sym (@symbols) {
		(my $s, my $i) = $sym =~ /^(.*?)\\(.*)$/;
		$existing{$s}=1;
	}
	foreach $sym (keys %nums) {
		if (!exists $existing{$sym}) {
			push @remaining, $sym;
		}
	}
	if(@remaining) {
		print STDERR "The following symbols do not seem to exist:\n";
		foreach $sym (@remaining) {
			print STDERR "\t",$sym,"\n";
		}
	}
}