Sweden-Number/tools/winapi_check/modules.pm

package modules;

use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw($modules);

use vars qw($modules);

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    bless ($self, $class);

    my $options = \${$self->{OPTIONS}};
    my $output = \${$self->{OUTPUT}};
    my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
    my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
    my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};

    $$options = shift;
    $$output = shift;
    my $wine_dir = shift;
    my $current_dir = shift;
    my $file_type = shift;    
    my $module_file = shift;

    $module_file =~ s/^\.\///;

    my @all_spec_files = map {
	s/^.\/(.*)$/$1/;
	if(&$file_type($_) eq "winelib") {
	    $_;
	} else {
	    ();
	}
    } split(/\n/, `find $wine_dir -name \\*.spec`);

    my %all_spec_files;
    foreach my $file (@all_spec_files) {
	$all_spec_files{$file}++ ;
    }

    if($$options->progress) {
	$$output->progress("modules.dat");
    }

    my $allowed_dir;
    my $spec_file;

    open(IN, "< $module_file");
    local $/ = "\n";
    while(<IN>) {
	s/^\s*?(.*?)\s*$/$1/; # remove whitespace at begining and end of line
	s/^(.*?)\s*#.*$/$1/;  # remove comments
	/^$/ && next;         # skip empty lines

	if(/^%\s+(.*?)$/) {
	    $spec_file = $1;
	   
	    if(!-f "$wine_dir/$spec_file") {
		$$output->write("modules.dat: $spec_file: file ($spec_file) doesn't exist or is no file\n");
	    } 

	    if($wine_dir eq ".") {
		$all_spec_files{$spec_file}--;
	    } else {
		$all_spec_files{"$wine_dir/$spec_file"}--;
	    }
	    $$dir2spec_file{""}{$spec_file}++; # FIXME: Kludge
	    next;
	} else {
	    $allowed_dir = $1;
	    $$spec_file2dir{$spec_file}{$allowed_dir}++;
	}
	$$dir2spec_file{$allowed_dir}{$spec_file}++;

	if(!-d "$wine_dir/$allowed_dir") {
	    $$output->write("modules.dat: $spec_file: directory ($allowed_dir) doesn't exist or is no directory\n");
	} 
    }
    close(IN);

    foreach my $spec_file (sort(keys(%all_spec_files))) {
	if($all_spec_files{$spec_file} > 0) {
	    $$output->write("modules.dat: $spec_file: exists but is not specified\n");
	}
    }

    $modules = $self;

    return $self;
}

sub all_modules {
    my $self = shift;

    my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};

    return sort(keys(%$module2spec_file));
}

sub spec_file_module {
    my $self = shift;

    my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
    my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};

    my $spec_file = shift;
    $spec_file =~ s/^\.\///;

    my $module = shift;
  
    $$spec_file2module{$spec_file} = $module;
    $$module2spec_file{$module} = $spec_file;
}

sub is_allowed_module_in_file {
    my $self = shift;

    my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
    my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};

    my $module = shift;
    my $file = shift;
    $file =~ s/^\.\///;

    my $dir = $file;
    $dir =~ s/\/[^\/]*$//;

    foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
	if($$spec_file2module{$spec_file} eq $module) {
	    return 1;
	}
    }

    return 0;
}

sub allowed_modules_in_file {
    my $self = shift;

    my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
    my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};

    my $file = shift;
    $file =~ s/^\.\///;

    my $dir = $file;
    $dir =~ s/\/[^\/]*$//;

    my %allowed_modules = ();
    foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
	my $module = $$spec_file2module{$spec_file};
	$allowed_modules{$module}++;
    }

    return join(" & ", sort(keys(%allowed_modules)));
}

sub allowed_dirs_for_module {
   my $self = shift;

   my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
   my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};   

   my $module = shift;

   my $spec_file = $$module2spec_file{$module};

   return sort(keys(%{$$spec_file2dir{$spec_file}}));
}

sub allowed_spec_files {
    my $self = shift;

    my $options = \${$self->{OPTIONS}};
    my $output = \${$self->{OUTPUT}};
    my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};

    my $wine_dir = shift;
    my $current_dir = shift;

    my @dirs = map {
	s/^\.\/(.*)$/$1/;
	if(/^\.$/) {
	    $current_dir;
	} else {
	    if($current_dir ne ".") {
		"$current_dir/$_";
	    } else {
		$_;
	    }
	}
    } split(/\n/, `find . -type d ! -name CVS`);

    my %allowed_spec_files = ();
    foreach my $dir (sort(@dirs)) {
	foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
	    $allowed_spec_files{$spec_file}++; 
	}
    }

    return sort(keys(%allowed_spec_files));
}

sub found_module_in_dir {
    my $self = shift;

    my $module = shift;
    my $dir = shift;

    my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};

    $$used_module_dirs{$module}{$dir}++;
}

sub global_report {
    my $self = shift;

    my $output = \${$self->{OUTPUT}};
    my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
    my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
    my $used_module_dirs = \%{$self->{USED_MODULE_DIRS}};

    my @messages;
    foreach my $dir (sort(keys(%$dir2spec_file))) {
	if($dir eq "") { next; }
	foreach my $spec_file (sort(keys(%{$$dir2spec_file{$dir}}))) {
	    my $module = $$spec_file2module{$spec_file};
	    if(!$$used_module_dirs{$module}{$dir}) {
		push @messages, "modules.dat: $spec_file: directory ($dir) is not used\n";
	    }
	}
    }

    foreach my $message (sort(@messages)) {
	$$output->write($message);
    }
}

1;