tools/winapi/nativeapi.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   4 # This library is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU Lesser General Public
   6 # License as published by the Free Software Foundation; either
   7 # version 2.1 of the License, or (at your option) any later version.
   8 #
   9 # This library is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # Lesser General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU Lesser General Public
  15 # License along with this library; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  17 #
  18
  19 package nativeapi;
  20
  21 use strict;
  22
  23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  24 require Exporter;
  25
  26 @ISA = qw(Exporter);
  27 @EXPORT = qw();
  28 @EXPORT_OK = qw($nativeapi);
  29
  30 use vars qw($nativeapi);
  31
  32 use config qw(file_type $current_dir $wine_dir $winapi_dir);
  33 use options qw($options);
  34 use output qw($output);
  35
  36 $nativeapi = 'nativeapi'->new;
  37
  38 sub new($) {
  39     my $proto = shift;
  40     my $class = ref($proto) || $proto;
  41     my $self  = {};
  42     bless ($self, $class);
  43
  44     my $functions = \%{$self->{FUNCTIONS}};
  45     my $conditionals = \%{$self->{CONDITIONALS}};
  46     my $conditional_headers = \%{$self->{CONDITIONAL_HEADERS}};
  47     my $conditional_functions = \%{$self->{CONDITIONAL_FUNCTIONS}};
  48
  49     my $api_file = "$winapi_dir/nativeapi.dat";
  50     my $configure_ac_file = "$wine_dir/configure.ac";
  51     my $config_h_in_file = "$wine_dir/include/config.h.in";
  52
  53     $api_file =~ s/^\.\///;
  54     $configure_ac_file =~ s/^\.\///;
  55     $config_h_in_file =~ s/^\.\///;
  56
  57
  58     $$conditional_headers{"config.h"}++;
  59
  60     $output->progress("$api_file");
  61
  62     open(IN, "< $api_file") || die "Error: Can't open $api_file: $!\n";
  63     local $/ = "\n";
  64     while(<IN>) {
  65         s/^\s*(.*?)\s*$/$1/; # remove whitespace at begin and end of line
  66         s/^(.*?)\s*#.*$/$1/; # remove comments
  67         /^$/ && next;        # skip empty lines
  68
  69         $$functions{$_}++;
  70     }
  71     close(IN);
  72
  73     $output->progress("$configure_ac_file");
  74
  75     my $again = 0;
  76     open(IN, "< $configure_ac_file") || die "Error: Can't open $configure_ac_file: $!\n";
  77     local $/ = "\n";
  78     while($again || (defined($_ = <IN>))) {
  79         $again = 0;
  80         chomp;
  81         if(/^(.*?)\\$/) {
  82             my $current = $1;
  83             my $next = <IN>;
  84             if(defined($next)) {
  85                 # remove trailing whitespace
  86                 $current =~ s/\s+$//;
  87
  88                 # remove leading whitespace
  89                 $next =~ s/^\s+//;
  90
  91                 $_ = $current . " " . $next;
  92
  93                 $again = 1;
  94                 next;
  95             }
  96         }
  97
  98         # remove leading and trailing whitespace
  99         s/^\s*(.*?)\s*$/$1/;
 100
 101         # skip emty lines
 102         if(/^$/) { next; }
 103
 104         # skip comments
 105         if(/^dnl/) { next; }
 106
 107         if(/AC_CHECK_HEADERS\(\s*([^,\)]*)(?:,|\))?/) {
 108             my $headers = $1;
 109             $headers =~ s/^\s*\[\s*(.*?)\s*\]\s*$/$1/;
 110             foreach my $name (split(/\s+/, $headers)) {
 111                 $$conditional_headers{$name}++;
 112             }
 113         } elsif(/AC_HEADER_STAT\(\)/) {
 114             # This checks for a bunch of standard headers
 115             # There's stdlib.h, string.h and sys/types.h too but we don't
 116             # want to force ifdefs for those at this point.
 117             foreach my $name ("sys/stat.h", "memory.h", "strings.h",
 118                               "inttypes.h", "stdint.h", "unistd.h") {
 119                 $$conditional_headers{$name}++;
 120             }
 121         } elsif(/AC_CHECK_FUNCS\(\s*([^,\)]*)(?:,|\))?/) {
 122             my $funcs = $1;
 123             $funcs =~ s/^\s*\[\s*(.*?)\s*\]\s*$/$1/;
 124             foreach my $name (split(/\s+/, $funcs)) {
 125                 $$conditional_functions{$name}++;
 126             }
 127         } elsif(/AC_FUNC_ALLOCA/) {
 128             $$conditional_headers{"alloca.h"}++;
 129         } elsif (/AC_DEFINE\(\s*HAVE_(.*?)_H/) {
 130             my $name = lc($1);
 131             $name =~ s/_/\//;
 132             $name .= ".h";
 133
 134             next if $name =~ m%correct/%;
 135
 136             $$conditional_headers{$name}++;
 137         }
 138
 139     }
 140     close(IN);
 141
 142     $output->progress("$config_h_in_file");
 143
 144     open(IN, "< $config_h_in_file") || die "Error: Can't open $config_h_in_file: $!\n";
 145     local $/ = "\n";
 146     while(<IN>) {
 147         # remove leading and trailing whitespace
 148         s/^\s*(.*?)\s*$/$1/;
 149
 150         # skip emty lines
 151         if(/^$/) { next; }
 152
 153         if(/^\#undef\s+(\S+)$/) {
 154             $$conditionals{$1}++;
 155         }
 156     }
 157     close(IN);
 158
 159     $nativeapi = $self;
 160
 161     return $self;
 162 }
 163
 164 sub is_function($$) {
 165     my $self = shift;
 166     my $functions = \%{$self->{FUNCTIONS}};
 167
 168     my $name = shift;
 169
 170     return ($$functions{$name} || 0);
 171 }
 172
 173 sub is_conditional($$) {
 174     my $self = shift;
 175     my $conditionals = \%{$self->{CONDITIONALS}};
 176
 177     my $name = shift;
 178
 179     return ($$conditionals{$name} || 0);
 180 }
 181
 182 sub found_conditional($$) {
 183     my $self = shift;
 184     my $conditional_found = \%{$self->{CONDITIONAL_FOUND}};
 185
 186     my $name = shift;
 187
 188     $$conditional_found{$name}++;
 189 }
 190
 191 sub is_conditional_header($$) {
 192     my $self = shift;
 193     my $conditional_headers = \%{$self->{CONDITIONAL_HEADERS}};
 194
 195     my $name = shift;
 196
 197     return ($$conditional_headers{$name} || 0);
 198 }
 199
 200 sub is_conditional_function($$) {
 201     my $self = shift;
 202     my $conditional_functions = \%{$self->{CONDITIONAL_FUNCTIONS}};
 203
 204     my $name = shift;
 205
 206     return ($$conditional_functions{$name} || 0);
 207 }
 208
 209 sub global_report($) {
 210     my $self = shift;
 211
 212     my $output = \${$self->{OUTPUT}};
 213     my $conditional_found = \%{$self->{CONDITIONAL_FOUND}};
 214     my $conditionals = \%{$self->{CONDITIONALS}};
 215
 216     my @messages;
 217     foreach my $name (sort(keys(%$conditionals))) {
 218         if($name =~ /^(?:const|inline|size_t)$/) { next; }
 219
 220         if(0 && !$$conditional_found{$name}) {
 221             push @messages, "config.h.in: conditional $name not used\n";
 222         }
 223     }
 224
 225     foreach my $message (sort(@messages)) {
 226         $output->write($message);
 227     }
 228 }
 229
 230 1;