- New common code for the winapi tools.
- New tool for extracting source code information. - New tool for automatically modifying (fixing) the source code.
This commit is contained in:
Patrik Stridvall
Alexandre Julliard
parent
303ffd2f60
commit
6a012e2502
|
|
@ -0,0 +1,83 @@
|
|||
package config;
|
||||
|
||||
use strict;
|
||||
|
||||
use setup qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
||||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(
|
||||
&file_type &file_skip &files_skip &get_spec_files
|
||||
);
|
||||
@EXPORT_OK = qw(
|
||||
$current_dir $wine_dir $winapi_dir $winapi_check_dir
|
||||
);
|
||||
|
||||
use vars qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
|
||||
|
||||
sub file_type {
|
||||
my $file = shift;
|
||||
|
||||
my $file_dir = $file;
|
||||
if(!($file_dir =~ s/^(.*?)\/[^\/]*$/$1/)) {
|
||||
$file_dir = ".";
|
||||
}
|
||||
|
||||
$file_dir =~ s/^$wine_dir\///;
|
||||
|
||||
if($file_dir =~ /^(libtest|programs|rc|server|tests|tools)/ ||
|
||||
$file =~ /dbgmain\.c$/ ||
|
||||
$file =~ /wineclipsrv\.c$/) # FIXME: Kludge
|
||||
{
|
||||
return "application";
|
||||
} elsif($file_dir =~ /^(debugger|miscemu)/) {
|
||||
return "emulator";
|
||||
} else {
|
||||
return "library";
|
||||
}
|
||||
}
|
||||
|
||||
sub file_skip {
|
||||
local $_ = shift;
|
||||
|
||||
$_ = "$current_dir/$_";
|
||||
s%^\./%%;
|
||||
|
||||
m%^(?:libtest|programs|rc|server|tests|tools)/% && return 1;
|
||||
m%^(?:debugger|miscemu|tsx11|server|unicode)/% && return 1;
|
||||
m%^dlls/wineps/data/% && return 1;
|
||||
m%^windows/x11drv/wineclipsrv.c% && return 1;
|
||||
m%^dlls/winmm/wineoss/midipatch.c% && return 1;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub files_skip {
|
||||
my @files;
|
||||
foreach my $file (@_) {
|
||||
if(!file_skip($file)) {
|
||||
push @files, $file;
|
||||
}
|
||||
}
|
||||
|
||||
return @files;
|
||||
}
|
||||
|
||||
sub get_spec_files {
|
||||
output->progress("$wine_dir: searching for *.spec");
|
||||
|
||||
my @spec_files = map {
|
||||
s/^$wine_dir\/(.*)$/$1/;
|
||||
if(file_type($_) eq "library") {
|
||||
$_;
|
||||
} else {
|
||||
();
|
||||
}
|
||||
} split(/\n/, `find $wine_dir -name \\*.spec`);
|
||||
|
||||
return @spec_files;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,348 @@
|
|||
package options;
|
||||
|
||||
use strict;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
||||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(&parse_comma_list);
|
||||
@EXPORT_OK = qw();
|
||||
|
||||
sub parse_comma_list {
|
||||
my $prefix = shift;
|
||||
my $value = shift;
|
||||
if(defined($prefix) && $prefix eq "no") {
|
||||
return { active => 0, filter => 0, hash => {} };
|
||||
} elsif(defined($value)) {
|
||||
my %names;
|
||||
for my $name (split /,/, $value) {
|
||||
$names{$name} = 1;
|
||||
}
|
||||
return { active => 1, filter => 1, hash => \%names };
|
||||
} else {
|
||||
return { active => 1, filter => 0, hash => {} };
|
||||
}
|
||||
}
|
||||
|
||||
my $_options;
|
||||
|
||||
sub new {
|
||||
my $self = shift;
|
||||
$_options = _options->new(@_);
|
||||
return $_options;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
|
||||
my $name = $options::AUTOLOAD;
|
||||
$name =~ s/^.*::(.[^:]*)$/$1/;
|
||||
|
||||
return $_options->$name(@_);
|
||||
}
|
||||
|
||||
package _options;
|
||||
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my $self = {};
|
||||
bless ($self, $class);
|
||||
|
||||
my $options_long = \%{$self->{OPTIONS_LONG}};
|
||||
my $options_short = \%{$self->{OPTIONS_SHORT}};
|
||||
my $options_usage = \${$self->{OPTIONS_USAGE}};
|
||||
|
||||
my $refoptions_long = shift;
|
||||
my $refoptions_short = shift;
|
||||
$$options_usage = shift;
|
||||
|
||||
%$options_long = %{$refoptions_long};
|
||||
%$options_short = %{$refoptions_short};
|
||||
|
||||
$self->options_set("default");
|
||||
|
||||
my $c_files = \@{$self->{C_FILES}};
|
||||
my $h_files = \@{$self->{H_FILES}};
|
||||
my @files;
|
||||
|
||||
while(defined($_ = shift @ARGV)) {
|
||||
if(/^--(all|none)$/) {
|
||||
$self->options_set("$1");
|
||||
next;
|
||||
} elsif(/^-([^=]*)(=(.*))?$/) {
|
||||
my $name;
|
||||
my $value;
|
||||
if(defined($2)) {
|
||||
$name = $1;
|
||||
$value = $3;
|
||||
} else {
|
||||
$name = $1;
|
||||
}
|
||||
|
||||
if($name =~ /^([^-].*)$/) {
|
||||
$name = $$options_short{$1};
|
||||
} else {
|
||||
$name =~ s/^-(.*)$/$1/;
|
||||
}
|
||||
|
||||
my $prefix;
|
||||
if(defined($name) && $name =~ /^no-(.*)$/) {
|
||||
$name = $1;
|
||||
$prefix = "no";
|
||||
if(defined($value)) {
|
||||
output->write("options with prefix 'no' can't take parameters\n");
|
||||
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
my $option;
|
||||
if(defined($name)) {
|
||||
$option = $$options_long{$name};
|
||||
}
|
||||
|
||||
if(defined($option)) {
|
||||
my $key = $$option{key};
|
||||
my $parser = $$option{parser};
|
||||
my $refvalue = \${$self->{$key}};
|
||||
my @parents = ();
|
||||
|
||||
if(defined($$option{parent})) {
|
||||
if(ref($$option{parent}) eq "ARRAY") {
|
||||
@parents = @{$$option{parent}};
|
||||
} else {
|
||||
@parents = $$option{parent};
|
||||
}
|
||||
}
|
||||
|
||||
if(defined($parser)) {
|
||||
$$refvalue = &$parser($prefix,$value);
|
||||
} else {
|
||||
if(defined($value)) {
|
||||
$$refvalue = $value;
|
||||
} elsif(!defined($prefix)) {
|
||||
$$refvalue = 1;
|
||||
} else {
|
||||
$$refvalue = 0;
|
||||
}
|
||||
}
|
||||
|
||||
if((ref($$refvalue) eq "HASH" && $$refvalue->{active}) || $$refvalue) {
|
||||
while($#parents >= 0) {
|
||||
my @old_parents = @parents;
|
||||
@parents = ();
|
||||
foreach my $parent (@old_parents) {
|
||||
my $parentkey = $$options_long{$parent}{key};
|
||||
my $refparentvalue = \${$self->{$parentkey}};
|
||||
|
||||
$$refparentvalue = 1;
|
||||
|
||||
if(defined($$options_long{$parent}{parent})) {
|
||||
if(ref($$options_long{$parent}{parent}) eq "ARRAY") {
|
||||
push @parents, @{$$options_long{$parent}{parent}};
|
||||
} else {
|
||||
push @parents, $$options_long{$parent}{parent};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
if(/^-(.*)$/) {
|
||||
output->write("unknown option: $_\n");
|
||||
output->write($$options_usage);
|
||||
exit 1;
|
||||
} else {
|
||||
if(!-e $_) {
|
||||
output->write("$_: no such file or directory\n");
|
||||
exit 1;
|
||||
}
|
||||
|
||||
push @files, $_;
|
||||
}
|
||||
}
|
||||
|
||||
if($self->help) {
|
||||
output->write($$options_usage);
|
||||
$self->show_help;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my @paths = ();
|
||||
my @c_files = ();
|
||||
my @h_files = ();
|
||||
foreach my $file (@files) {
|
||||
if($file =~ /\.c$/) {
|
||||
push @c_files, $file;
|
||||
} elsif($file =~ /\.h$/) {
|
||||
push @h_files, $file;
|
||||
} else {
|
||||
push @paths, $file;
|
||||
}
|
||||
}
|
||||
|
||||
if($#c_files == -1 && $#h_files == -1 && $#paths == -1)
|
||||
{
|
||||
@paths = ".";
|
||||
}
|
||||
|
||||
if($#paths != -1 || $#c_files != -1) {
|
||||
my $c_command = "find " . join(" ", @paths, @c_files) . " -name \\*.c";
|
||||
my %found;
|
||||
@$c_files = sort(map {
|
||||
s/^\.\/(.*)$/$1/;
|
||||
if(defined($found{$_}) || /glue\.c|spec\.c$/) {
|
||||
();
|
||||
} else {
|
||||
$found{$_}++;
|
||||
$_;
|
||||
}
|
||||
} split(/\n/, `$c_command`));
|
||||
}
|
||||
|
||||
if($#h_files != -1) {
|
||||
my $h_command = "find " . join(" ", @h_files) . " -name \\*.h";
|
||||
my %found;
|
||||
|
||||
@$h_files = sort(map {
|
||||
s/^\.\/(.*)$/$1/;
|
||||
if(defined($found{$_})) {
|
||||
();
|
||||
} else {
|
||||
$found{$_}++;
|
||||
$_;
|
||||
}
|
||||
} split(/\n/, `$h_command`));
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub DESTROY {
|
||||
}
|
||||
|
||||
sub options_set {
|
||||
my $self = shift;
|
||||
|
||||
my $options_long = \%{$self->{OPTIONS_LONG}};
|
||||
my $options_short = \%{$self->{OPTIONS_SHORT}};
|
||||
|
||||
local $_ = shift;
|
||||
for my $name (sort(keys(%$options_long))) {
|
||||
my $option = $$options_long{$name};
|
||||
my $key = uc($name);
|
||||
$key =~ tr/-/_/;
|
||||
$$option{key} = $key;
|
||||
my $refvalue = \${$self->{$key}};
|
||||
|
||||
if(/^default$/) {
|
||||
$$refvalue = $$option{default};
|
||||
} elsif(/^all$/) {
|
||||
if($name !~ /^help|debug|verbose|module$/) {
|
||||
if(ref($$refvalue) ne "HASH") {
|
||||
$$refvalue = 1;
|
||||
} else {
|
||||
$$refvalue = { active => 1, filter => 0, hash => {} };
|
||||
}
|
||||
}
|
||||
} elsif(/^none$/) {
|
||||
if($name !~ /^help|debug|verbose|module$/) {
|
||||
if(ref($$refvalue) ne "HASH") {
|
||||
$$refvalue = 0;
|
||||
} else {
|
||||
$$refvalue = { active => 0, filter => 0, hash => {} };
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub show_help {
|
||||
my $self = shift;
|
||||
|
||||
my $options_long = \%{$self->{OPTIONS_LONG}};
|
||||
my $options_short = \%{$self->{OPTIONS_SHORT}};
|
||||
|
||||
my $maxname = 0;
|
||||
for my $name (sort(keys(%$options_long))) {
|
||||
if(length($name) > $maxname) {
|
||||
$maxname = length($name);
|
||||
}
|
||||
}
|
||||
|
||||
for my $name (sort(keys(%$options_long))) {
|
||||
my $option = $$options_long{$name};
|
||||
my $description = $$option{description};
|
||||
my $default = $$option{default};
|
||||
my $current = ${$self->{$$option{key}}};
|
||||
|
||||
my $value = $current;
|
||||
|
||||
my $command;
|
||||
if(ref($value) ne "HASH") {
|
||||
if($value) {
|
||||
$command = "--no-$name";
|
||||
} else {
|
||||
$command = "--$name";
|
||||
}
|
||||
} else {
|
||||
if($value->{active}) {
|
||||
$command = "--[no-]$name\[=<value>]";
|
||||
} else {
|
||||
$command = "--$name\[=<value>]";
|
||||
}
|
||||
}
|
||||
|
||||
output->write($command);
|
||||
for (0..(($maxname - length($name) + 17) - (length($command) - length($name) + 1))) { output->write(" "); }
|
||||
if(ref($value) ne "HASH") {
|
||||
if($value) {
|
||||
output->write("Disable ");
|
||||
} else {
|
||||
output->write("Enable ");
|
||||
}
|
||||
} else {
|
||||
if($value->{active}) {
|
||||
output->write("(Disable) ");
|
||||
} else {
|
||||
output->write("Enable ");
|
||||
}
|
||||
}
|
||||
if($default == $current) {
|
||||
output->write("$description (default)\n");
|
||||
} else {
|
||||
output->write("$description\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
|
||||
my $name = $_options::AUTOLOAD;
|
||||
$name =~ s/^.*::(.[^:]*)$/\U$1/;
|
||||
|
||||
my $refvalue = $self->{$name};
|
||||
if(!defined($refvalue)) {
|
||||
die "<internal>: options.pm: member $name does not exists\n";
|
||||
}
|
||||
|
||||
if(ref($$refvalue) ne "HASH") {
|
||||
return $$refvalue;
|
||||
} else {
|
||||
return $$refvalue->{active};
|
||||
}
|
||||
}
|
||||
|
||||
sub c_files { my $self = shift; return @{$self->{C_FILES}}; }
|
||||
|
||||
sub h_files { my $self = shift; return @{$self->{H_FILES}}; }
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,132 @@
|
|||
package output;
|
||||
|
||||
use strict;
|
||||
|
||||
my $_output;
|
||||
|
||||
sub new {
|
||||
my $self = shift;
|
||||
$_output = _output->new(@_);
|
||||
return $_output;
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $self = shift;
|
||||
|
||||
my $name = $output::AUTOLOAD;
|
||||
$name =~ s/^.*::(.[^:]*)$/$1/;
|
||||
|
||||
return $_output->$name(@_);
|
||||
}
|
||||
|
||||
package _output;
|
||||
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my $self = {};
|
||||
bless ($self, $class);
|
||||
|
||||
my $progress = \${$self->{PROGRESS}};
|
||||
my $last_progress = \${$self->{LAST_PROGRESS}};
|
||||
my $progress_count = \${$self->{PROGRESS_COUNT}};
|
||||
my $prefix = \${$self->{PREFIX}};
|
||||
|
||||
$$progress = "";
|
||||
$$last_progress = "";
|
||||
$$progress_count = 0;
|
||||
$$prefix = "";
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
|
||||
sub show_progress {
|
||||
my $self = shift;
|
||||
my $progress = \${$self->{PROGRESS}};
|
||||
my $last_progress = \${$self->{LAST_PROGRESS}};
|
||||
my $progress_count = \${$self->{PROGRESS_COUNT}};
|
||||
|
||||
$$progress_count++;
|
||||
|
||||
if($$progress_count > 0 && $$progress) {
|
||||
print STDERR $$progress;
|
||||
$$last_progress = $$progress;
|
||||
}
|
||||
}
|
||||
|
||||
sub hide_progress {
|
||||
my $self = shift;
|
||||
my $progress = \${$self->{PROGRESS}};
|
||||
my $last_progress = \${$self->{LAST_PROGRESS}};
|
||||
my $progress_count = \${$self->{PROGRESS_COUNT}};
|
||||
|
||||
$$progress_count--;
|
||||
|
||||
if($$last_progress) {
|
||||
my $message;
|
||||
for (1..length($$last_progress)) {
|
||||
$message .= " ";
|
||||
}
|
||||
print STDERR $message;
|
||||
undef $$last_progress;
|
||||
}
|
||||
}
|
||||
|
||||
sub update_progress {
|
||||
my $self = shift;
|
||||
my $progress = \${$self->{PROGRESS}};
|
||||
my $last_progress = \${$self->{LAST_PROGRESS}};
|
||||
|
||||
my $prefix = "";
|
||||
my $suffix = "";
|
||||
if($$last_progress) {
|
||||
for (1..length($$last_progress)) {
|
||||
$prefix .= "";
|
||||
}
|
||||
|
||||
my $diff = length($$last_progress)-length($$progress);
|
||||
if($diff > 0) {
|
||||
for (1..$diff) {
|
||||
$suffix .= " ";
|
||||
}
|
||||
for (1..$diff) {
|
||||
$suffix .= "";
|
||||
}
|
||||
}
|
||||
}
|
||||
print STDERR $prefix . $$progress . $suffix;
|
||||
$$last_progress = $$progress;
|
||||
}
|
||||
|
||||
sub progress {
|
||||
my $self = shift;
|
||||
my $progress = \${$self->{PROGRESS}};
|
||||
|
||||
$$progress = shift;
|
||||
|
||||
$self->update_progress;
|
||||
}
|
||||
|
||||
sub prefix {
|
||||
my $self = shift;
|
||||
my $prefix = \${$self->{PREFIX}};
|
||||
|
||||
$$prefix = shift;
|
||||
}
|
||||
|
||||
sub write {
|
||||
my $self = shift;
|
||||
|
||||
my $message = shift;
|
||||
|
||||
my $prefix = \${$self->{PREFIX}};
|
||||
|
||||
$self->hide_progress;
|
||||
print $$prefix . $message;
|
||||
$self->show_progress;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
package setup;
|
||||
|
||||
use strict;
|
||||
|
||||
BEGIN {
|
||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
||||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw();
|
||||
@EXPORT_OK = qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
|
||||
|
||||
use vars qw($current_dir $wine_dir $winapi_dir $winapi_check_dir);
|
||||
|
||||
my $dir;
|
||||
my $tool;
|
||||
|
||||
if($0 =~ m%^((.*?)/?tools/([^/]+))/([^/]+)$%)
|
||||
{
|
||||
$winapi_dir = $1;
|
||||
$winapi_check_dir = $1;
|
||||
$dir = $3;
|
||||
$tool = $4;
|
||||
|
||||
if(defined($2) && $2 ne "")
|
||||
{
|
||||
$wine_dir = $2;
|
||||
} else {
|
||||
$wine_dir = ".";
|
||||
|
||||
}
|
||||
|
||||
if($wine_dir =~ /^\./) {
|
||||
$current_dir = ".";
|
||||
my $pwd; chomp($pwd = `pwd`);
|
||||
foreach my $n (1..((length($wine_dir) + 1) / 3)) {
|
||||
$pwd =~ s/\/([^\/]*)$//;
|
||||
$current_dir = "$1/$current_dir";
|
||||
}
|
||||
$current_dir =~ s%/\.$%%;
|
||||
}
|
||||
|
||||
$winapi_dir =~ s%^\./%%;
|
||||
$winapi_dir =~ s/$dir/winapi/g;
|
||||
|
||||
$winapi_check_dir =~ s%^\./%%;
|
||||
$winapi_check_dir =~ s/$dir/winapi_check/g;
|
||||
} else {
|
||||
print STDERR "$tool: You must run this tool in the main Wine directory or a sub directory\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
push @INC, ($winapi_check_dir, $winapi_dir) if $tool eq "winapi_check";
|
||||
push @INC, ($winapi_dir, $winapi_check_dir) if $tool eq "winapi_extract";
|
||||
push @INC, ($winapi_dir, $winapi_check_dir) if $tool eq "winapi_fixup";
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,89 @@
|
|||
package util;
|
||||
|
||||
use strict;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
|
||||
require Exporter;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(append_file edit_file read_file replace_file);
|
||||
@EXPORT_OK = qw();
|
||||
%EXPORT_TAGS = ();
|
||||
|
||||
########################################################################
|
||||
# append_file
|
||||
|
||||
sub append_file {
|
||||
my $filename = shift;
|
||||
my $function = shift;
|
||||
|
||||
open(OUT, ">> $filename") || die "Can't open file '$filename'";
|
||||
my $result = &$function(\*OUT, @_);
|
||||
close(OUT);
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# edit_file
|
||||
|
||||
sub edit_file {
|
||||
my $filename = shift;
|
||||
my $function = shift;
|
||||
|
||||
open(IN, "< $filename") || die "Can't open file '$filename'";
|
||||
open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
|
||||
|
||||
my $result = &$function(\*IN, \*OUT, @_);
|
||||
|
||||
close(IN);
|
||||
close(OUT);
|
||||
|
||||
if($result) {
|
||||
unlink("$filename");
|
||||
rename("$filename.tmp", "$filename");
|
||||
} else {
|
||||
unlink("$filename.tmp");
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# read_file
|
||||
|
||||
sub read_file {
|
||||
my $filename = shift;
|
||||
my $function = shift;
|
||||
|
||||
open(IN, "< $filename") || die "Can't open file '$filename'";
|
||||
my $result = &$function(\*IN, @_);
|
||||
close(IN);
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
# replace_file
|
||||
|
||||
sub replace_file {
|
||||
my $filename = shift;
|
||||
my $function = shift;
|
||||
|
||||
open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
|
||||
|
||||
my $result = &$function(\*OUT, @_);
|
||||
|
||||
close(OUT);
|
||||
|
||||
if($result) {
|
||||
unlink("$filename");
|
||||
rename("$filename.tmp", "$filename");
|
||||
} else {
|
||||
unlink("$filename.tmp");
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,245 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
# Copyright 2001 Patrik Stridvall
|
||||
|
||||
use strict;
|
||||
|
||||
BEGIN {
|
||||
$0 =~ m%^(.*?/?tools)/winapi/winapi_extract$%;
|
||||
require "$1/winapi/setup.pm";
|
||||
}
|
||||
|
||||
use config qw(
|
||||
&file_type &file_skip &files_skip &get_spec_files
|
||||
$current_dir $wine_dir $winapi_dir $winapi_check_dir
|
||||
);
|
||||
use output;
|
||||
use options;
|
||||
use winapi;
|
||||
use winapi_parser;
|
||||
|
||||
my $output = output->new;
|
||||
|
||||
my %options_long = (
|
||||
"debug" => { default => 0, description => "debug mode" },
|
||||
"help" => { default => 0, description => "help mode" },
|
||||
"verbose" => { default => 0, description => "verbose mode" },
|
||||
|
||||
"progress" => { default => 1, description => "show progress" },
|
||||
|
||||
"win16" => { default => 1, description => "Win16 extraction" },
|
||||
"win32" => { default => 1, description => "Win32 extraction" },
|
||||
|
||||
"local" => { default => 1, description => "local extraction" },
|
||||
"global" => { default => 1, description => "global extraction" },
|
||||
|
||||
"spec-files" => { default => 1, parent => "global", description => "spec files extraction" },
|
||||
);
|
||||
|
||||
my %options_short = (
|
||||
"d" => "debug",
|
||||
"?" => "help",
|
||||
"v" => "verbose"
|
||||
);
|
||||
|
||||
my $options_usage = "usage: winapi_extract [--help] [<files>]\n";
|
||||
|
||||
my $options = options->new(\%options_long, \%options_short, $options_usage);
|
||||
|
||||
my %module2spec_file;
|
||||
my %module2type;
|
||||
{
|
||||
local $_;
|
||||
|
||||
foreach my $spec_file (get_spec_files) {
|
||||
my $module;
|
||||
my $type;
|
||||
|
||||
open(IN, "< $wine_dir/$spec_file");
|
||||
while(<IN>) {
|
||||
s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begining and end of line
|
||||
s/^(.*?)\s*#.*$/$1/; # remove comments
|
||||
/^$/ && next; # skip empty lines
|
||||
|
||||
if(/^name\s+(.*?)$/) {
|
||||
$module = $1;
|
||||
$module2spec_file{$module} = $spec_file;
|
||||
} elsif(/^type\s+(.*?)$/) {
|
||||
$type = $1;
|
||||
$module2type{$module} = $type;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
}
|
||||
|
||||
my $win16api = winapi->new($options, $output, "win16", "$winapi_check_dir/win16");
|
||||
my $win32api = winapi->new($options, $output, "win32", "$winapi_check_dir/win32");
|
||||
my @winapis = ($win16api, $win32api);
|
||||
|
||||
my %specifications;
|
||||
|
||||
my @files = files_skip($options->c_files);
|
||||
|
||||
my $progress_output;
|
||||
my $progress_current = 0;
|
||||
my $progress_max = scalar(@files);
|
||||
|
||||
foreach my $file (@files) {
|
||||
my $functions = 0;
|
||||
|
||||
$progress_current++;
|
||||
if($options->progress) {
|
||||
output->progress("$file: file $progress_current of $progress_max");
|
||||
}
|
||||
|
||||
my $found_function = sub {
|
||||
my $line = shift;
|
||||
my $refdebug_channels = shift;
|
||||
my @debug_channels = @$refdebug_channels;
|
||||
my $documentation = shift;
|
||||
my $linkage = shift;
|
||||
my $return_type = shift;
|
||||
my $calling_convention = shift;
|
||||
my $internal_name = shift;
|
||||
my $refargument_types = shift;
|
||||
my @argument_types = @$refargument_types;
|
||||
my $refargument_names = shift;
|
||||
my @argument_names = @$refargument_names;
|
||||
my $refargument_documentations = shift;
|
||||
my @argument_documentations = @$refargument_documentations;
|
||||
my $statements = shift;
|
||||
|
||||
$functions++;
|
||||
|
||||
if($linkage eq "static") {
|
||||
return;
|
||||
}
|
||||
|
||||
local $_;
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
if(/^ \*\s*(\w+)\s*[\(\[]\s*(\w+)\.\s*(\@|\d+)\s*[\)\]]/m) {
|
||||
my $name = $1;
|
||||
my $module = lc($2);
|
||||
my $ordinal = $3;
|
||||
|
||||
if($ordinal eq "@") {
|
||||
$specifications{$module}{unfixed}{$name}{debug_channels} = [@debug_channels];
|
||||
$specifications{$module}{unfixed}{$name}{name} = $name;
|
||||
$specifications{$module}{unfixed}{$name}{ordinal} = $ordinal;
|
||||
$specifications{$module}{unfixed}{$name}{arguments} = [@argument_types];
|
||||
} else {
|
||||
$specifications{$module}{fixed}{$ordinal}{debug_channels} = [@debug_channels];
|
||||
$specifications{$module}{fixed}{$ordinal}{ordinal} = $ordinal;
|
||||
$specifications{$module}{fixed}{$ordinal}{name} = $name;
|
||||
$specifications{$module}{fixed}{$ordinal}{arguments} = [@argument_types];
|
||||
}
|
||||
|
||||
if($options->debug) {
|
||||
output->write("$file: $name ($module.$ordinal)\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
my $found_preprocessor = sub {
|
||||
my $directive = shift;
|
||||
my $argument = shift;
|
||||
};
|
||||
|
||||
winapi_parser::parse_c_file $options, $output, $file, $found_function, $found_preprocessor;
|
||||
|
||||
if($functions == 0) {
|
||||
output->write("$file: doesn't contain any functions\n");
|
||||
}
|
||||
}
|
||||
|
||||
sub output_function {
|
||||
local *OUT = shift;
|
||||
my $type = shift;
|
||||
my $function = shift;
|
||||
|
||||
my $name = $function->{name};
|
||||
my $ordinal = $function->{ordinal};
|
||||
my @arguments = @{$function->{arguments}};
|
||||
|
||||
my @arguments2;
|
||||
foreach my $argument (@arguments) {
|
||||
my $argument2;
|
||||
if($type eq "win16") {
|
||||
$argument2 = $win16api->translate_argument($argument);
|
||||
} else {
|
||||
$argument2 = $win32api->translate_argument($argument);
|
||||
}
|
||||
if(!defined($argument2)) {
|
||||
$argument2 = "undef";
|
||||
}
|
||||
push @arguments2, $argument2;
|
||||
}
|
||||
|
||||
if($type eq "win16") {
|
||||
print OUT "$ordinal pascal $name(@arguments2) $name\n";
|
||||
} else {
|
||||
print OUT "$ordinal stdcall $name(@arguments2) $name\n";
|
||||
}
|
||||
}
|
||||
|
||||
if($options->spec_files) {
|
||||
foreach my $module (keys(%specifications)) {
|
||||
my $spec_file = $module2spec_file{$module};
|
||||
my $type = $module2type{$module};
|
||||
|
||||
if(!defined($spec_file) || !defined($type)) {
|
||||
output->write("$module: doesn't exist\n");
|
||||
next;
|
||||
}
|
||||
|
||||
$spec_file .= "2";
|
||||
|
||||
output->progress("$spec_file");
|
||||
open(OUT, "> $wine_dir/$spec_file");
|
||||
|
||||
print OUT "name $module\n";
|
||||
print OUT "type $type\n";
|
||||
print OUT "\n";
|
||||
|
||||
my %debug_channels;
|
||||
foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
|
||||
my $function = $specifications{$module}{fixed}{$ordinal};
|
||||
foreach my $debug_channel (@{$function->{debug_channels}}) {
|
||||
$debug_channels{$debug_channel}++;
|
||||
}
|
||||
}
|
||||
foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
|
||||
my $function = $specifications{$module}{unfixed}{$name};
|
||||
foreach my $debug_channel (@{$function->{debug_channels}}) {
|
||||
$debug_channels{$debug_channel}++;
|
||||
}
|
||||
}
|
||||
|
||||
my @debug_channels = sort(keys(%debug_channels));
|
||||
if($#debug_channels >= 0) {
|
||||
print OUT "debug_channels (" . join(" ", @debug_channels) . ")\n";
|
||||
print OUT "\n";
|
||||
}
|
||||
|
||||
my $empty = 1;
|
||||
foreach my $ordinal (sort {$a <=> $b} keys(%{$specifications{$module}{fixed}})) {
|
||||
my $function = $specifications{$module}{fixed}{$ordinal};
|
||||
output_function(\*OUT, $type, $function);
|
||||
$empty = 0;
|
||||
}
|
||||
|
||||
foreach my $name (sort(keys(%{$specifications{$module}{unfixed}}))) {
|
||||
if(!$empty) {
|
||||
print OUT "\n";
|
||||
$empty = 1;
|
||||
}
|
||||
my $function = $specifications{$module}{unfixed}{$name};
|
||||
output_function(\*OUT, $type, $function);
|
||||
}
|
||||
close(OUT);
|
||||
}
|
||||
}
|
||||
output->hide_progress;
|
||||
|
|
@ -0,0 +1,194 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
# Copyright 2001 Patrik Stridvall
|
||||
|
||||
use strict;
|
||||
|
||||
BEGIN {
|
||||
$0 =~ m%^(.*?/?tools)/winapi/winapi_fixup$%;
|
||||
require "$1/winapi/setup.pm";
|
||||
}
|
||||
|
||||
use config qw(
|
||||
&file_type &file_skip &files_skip &get_spec_files
|
||||
$current_dir $wine_dir $winapi_dir $winapi_check_dir
|
||||
);
|
||||
use output;
|
||||
use options;
|
||||
use modules;
|
||||
use util;
|
||||
use winapi;
|
||||
use winapi_parser;
|
||||
|
||||
my $output = output->new;
|
||||
|
||||
my %options_long = (
|
||||
"debug" => { default => 0, description => "debug mode" },
|
||||
"help" => { default => 0, description => "help mode" },
|
||||
"verbose" => { default => 0, description => "verbose mode" },
|
||||
|
||||
"progress" => { default => 1, description => "show progress" },
|
||||
|
||||
"win16" => { default => 1, description => "Win16 fixup" },
|
||||
"win32" => { default => 1, description => "Win32 fixup" },
|
||||
|
||||
"local" => { default => 1, description => "local fixup" },
|
||||
"global" => { default => 1, description => "global fixup" },
|
||||
|
||||
"modify" => { default => 0, description => "global fixup" },
|
||||
);
|
||||
|
||||
my %options_short = (
|
||||
"d" => "debug",
|
||||
"?" => "help",
|
||||
"v" => "verbose"
|
||||
);
|
||||
|
||||
my $options_usage = "usage: winapi_fixup [--help] [<files>]\n";
|
||||
|
||||
my $options = options->new(\%options_long, \%options_short, $options_usage);
|
||||
|
||||
my $modules = modules->new($options, $output, $wine_dir, $current_dir, \&file_type, "$winapi_check_dir/modules.dat");
|
||||
|
||||
my $win16api = winapi->new($options, $output, "win16", "$winapi_check_dir/win16");
|
||||
my $win32api = winapi->new($options, $output, "win32", "$winapi_check_dir/win32");
|
||||
my @winapis = ($win16api, $win32api);
|
||||
|
||||
if($wine_dir eq ".") {
|
||||
winapi->read_all_spec_files($modules, $wine_dir, $current_dir, \&file_type, $win16api, $win32api);
|
||||
} else {
|
||||
my @spec_files = $modules->allowed_spec_files($wine_dir, $current_dir);
|
||||
winapi->read_spec_files($modules, $wine_dir, $current_dir, \@spec_files, $win16api, $win32api);
|
||||
}
|
||||
|
||||
my %substitute;
|
||||
my %insert_line;
|
||||
|
||||
my @c_files = files_skip(options->c_files);
|
||||
|
||||
my $progress_output;
|
||||
my $progress_current = 0;
|
||||
my $progress_max = scalar(@c_files);
|
||||
|
||||
foreach my $file (@c_files) {
|
||||
$progress_current++;
|
||||
if(options->progress) {
|
||||
output->progress("$file: file $progress_current of $progress_max");
|
||||
}
|
||||
|
||||
my $found_function = sub {
|
||||
my $line = shift;
|
||||
my $refdebug_channels = shift;
|
||||
my @debug_channels = @$refdebug_channels;
|
||||
my $documentation = shift;
|
||||
my $linkage = shift;
|
||||
my $return_type = shift;
|
||||
my $calling_convention = shift;
|
||||
my $internal_name = shift;
|
||||
my $refargument_types = shift;
|
||||
my @argument_types = @$refargument_types;
|
||||
my $refargument_names = shift;
|
||||
my @argument_names = @$refargument_names;
|
||||
my $refargument_documentations = shift;
|
||||
my @argument_documentations = @$refargument_documentations;
|
||||
my $statements = shift;
|
||||
|
||||
if($linkage eq "static" || $linkage eq "extern") {
|
||||
return;
|
||||
}
|
||||
|
||||
if($documentation) {
|
||||
local $_;
|
||||
foreach (split(/\n/, $documentation)) {
|
||||
if(/^(\s*\*\s*\w+\s*)([\(\[]\s*\w+\.\s*(?:\@|\d+)\s*[\)\]])\s*([\(\[]\s*\w+\.\s*(?:\@|\d+)\s*[\)\]])/m) {
|
||||
$substitute{$_}{search} = $_;
|
||||
$substitute{$_}{replace} = "$1$2\n$1$3";
|
||||
} elsif(/^\s*\*\s*(\w+)\s*[\(\[]\s*(\w+)\.\s*(\@|\d+)\s*[\)\]]/m) {
|
||||
my $name = $1;
|
||||
my $module = $2;
|
||||
my $ordinal = $3;
|
||||
|
||||
my $module2;
|
||||
my $ordinal2;
|
||||
foreach my $winapi (@winapis) {
|
||||
$module2 = ($winapi->function_module($internal_name) || $module2);
|
||||
$ordinal2 = ($winapi->function_ordinal($internal_name) || $ordinal2);
|
||||
if(defined($module2) || defined($ordinal2)) { last; }
|
||||
}
|
||||
|
||||
if(!defined($module2) || !defined($ordinal2)) {
|
||||
output->write("$file: $internal_name: unknown error\n");
|
||||
} elsif(lc($module) eq $module2 && $ordinal ne $ordinal2) {
|
||||
$substitute{$_}{search} = "$module.$ordinal";
|
||||
$substitute{$_}{replace} = "\U$module2\E.$ordinal2";
|
||||
}
|
||||
}
|
||||
}
|
||||
} elsif(0) {
|
||||
my $name;
|
||||
my $module;
|
||||
my $ordinal;
|
||||
foreach my $winapi (@winapis) {
|
||||
$name = ($winapi->function_external_name($internal_name) || $name);
|
||||
$module = ($winapi->function_module($internal_name) || $module);
|
||||
$ordinal = ($winapi->function_ordinal($internal_name) || $ordinal);
|
||||
if(defined($name) || defined($module) || defined($ordinal)) { last; }
|
||||
}
|
||||
|
||||
if(defined($name) && defined($module) && defined($ordinal)) {
|
||||
$insert_line{$line} =
|
||||
"/" . "*" x 71 . "\n" .
|
||||
" *\t\t$name (\U$module\E.$ordinal)\n" .
|
||||
" */\n";
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
my $found_preprocessor = sub {
|
||||
my $directive = shift;
|
||||
my $argument = shift;
|
||||
};
|
||||
|
||||
winapi_parser::parse_c_file $options, $output, $file, $found_function, $found_preprocessor;
|
||||
|
||||
my $editor = sub {
|
||||
local *IN = shift;
|
||||
local *OUT = shift;
|
||||
|
||||
my $modified = 0;
|
||||
while(<IN>) {
|
||||
chomp;
|
||||
|
||||
my $line = $insert_line{$.};
|
||||
if(defined($line)) {
|
||||
if(options->modify) {
|
||||
$_ = "$line$_";
|
||||
$modified = 1;
|
||||
} else {
|
||||
output->write("$file: $.: insert : '$line'\n");
|
||||
}
|
||||
}
|
||||
|
||||
my $search = $substitute{$_}{search};
|
||||
my $replace = $substitute{$_}{replace};
|
||||
|
||||
if(defined($search) && defined($replace)) {
|
||||
if(options->modify) {
|
||||
if(s/\Q$search\E/$replace/) {
|
||||
$modified = 1;
|
||||
}
|
||||
} else {
|
||||
output->write("$file: $.: search : '$search'\n");
|
||||
output->write("$file: $.: replace: '$replace'\n");
|
||||
}
|
||||
}
|
||||
print OUT "$_\n";
|
||||
}
|
||||
|
||||
return $modified;
|
||||
};
|
||||
|
||||
edit_file($file, $editor);
|
||||
}
|
||||
|
||||
output->hide_progress;
|
||||
Loading…
Reference in New Issue