#!/usr/bin/perl -w

=begin comment info
 +-----------------------------------------------------------------------------+
 | Copyright 2000-2005 Guardian Digital, Inc., All Rights Reserved
 | $Id: discover-einstall,v 1.5 2005/10/18 18:51:21 rwm Exp $
 |
 | Ryan W. Maple <ryan@guardiandigital.com>
 +-----------------------------------------------------------------------------+
=end comment info
=cut

  # use perl;
  use strict;
  use vars	qw($seen);

  #
  # Local prototypes.
  #
  sub append_file($$$$);
  sub get_module_info($);
  sub read_names();

  #
  # Local constants.
  #
  use constant	PCI_DEVLIST_FILE	=> '/tmp/pci_probe_results';
  use constant	PCI_SCSILIST_FILE	=> '/tmp/pci_scsi_results';

  #
  # Close STDERR and unlink our files if they already exist.
  #
  close STDERR;
  unlink PCI_DEVLIST_FILE, PCI_SCSILIST_FILE;

  #
  # Do it.
  #
  $seen		= { };
  my @names	= read_names();
  my @cmd	= ('discover', '--data-path=linux/module/name', '--format=%s');

  open MODULES, '-|', @cmd or exit 1;
  for (my $i = 0; my $l = <MODULES>; $i++) {
    chomp $l; next if ($l eq ' ' || $l eq ''); $l =~ s/\s//g;

    my $type	= get_module_info($l); next unless ($type);

    if    ($type eq 'net')  { append_file(PCI_DEVLIST_FILE,  $l, $i, \@names);  }
    elsif ($type eq 'scsi') { append_file(PCI_SCSILIST_FILE, $l, $i, \@names); }
  }
  close MODULES;

  #
  # All done, exit quietly.
  #
  exit 0;

################################################################################
sub append_file($$$$) {
  my $file	= shift;
  my $module	= shift;
  my $index	= shift;
  my $names	= shift;
  my $name	= $names->[$index];

  # Avoid writing duplicate SCSI entries.
  return 1 if ($seen->{$module} && $file eq PCI_SCSILIST_FILE);

  open FILE, '>>', $file or return 1;

  if ($file eq PCI_DEVLIST_FILE) {
    print FILE "1 0 $module $name ##\n";
  }
  elsif ($file eq PCI_SCSILIST_FILE) {
    print FILE "2 2 $module $name ##\n";
  }

  close FILE;

  $seen->{$module} = 1;

  return 0;
}

################################################################################
sub get_module_info($) {
  my $module	= shift;
  my @cmd	= ('modinfo', $module);
  my $rv	= undef;

  open CMD, '-|', @cmd or goto $rv;
  while (my $l = <CMD>) {
    chomp $l;

    if ($l =~ m/^filename\:\s+\/lib\/modules\/[^\/]+\/kernel\/(.+)$/) {
      my $stuff	= $1;

      if    ($stuff =~ m/\/net\//)     { $rv = 'net';  goto done; }
      elsif ($stuff =~ m/\/usb\//)     { $rv = 'usb';  goto done; }
      elsif ($stuff =~ m/\/scsi\//)    { $rv = 'scsi'; goto done; }
      elsif ($stuff =~ m/\/message\//) { $rv = 'scsi'; goto done; }
      elsif ($stuff =~ m/\/block\//)   { $rv = 'scsi'; goto done; }
    }
  }
done:
  close CMD;

  return $rv;
}

################################################################################
sub read_names() {
  my @cmd	= ('discover');
  my @rv	= ();

  open CMD, '-|', @cmd or return @rv;
  while (my $l = <CMD>) { chomp $l; push @rv, $l; }
  close CMD;

  return @rv;
}
