|  | @@ -1,66 +1,259 @@
 | 
		
	
		
			
			| 1 | 1 |  #!/usr/bin/env perl
 | 
		
	
		
			
			| 2 | 2 |  #
 | 
		
	
		
			
			| 3 |  | -# Parse PCI_ROM and ISA_ROM entries from a source file on stdin and
 | 
		
	
		
			
			| 4 |  | -# output the relevant Makefile variable definitions to stdout
 | 
		
	
		
			
			|  | 3 | +# Parse PCI_ROM and ISA_ROM entries from source file(s) specified as
 | 
		
	
		
			
			|  | 4 | +# arguments and output the relevant Makefile rules to STDOUT.
 | 
		
	
		
			
			| 5 | 5 |  #
 | 
		
	
		
			
			| 6 |  | -# Based upon portions of Ken Yap's genrules.pl
 | 
		
	
		
			
			|  | 6 | +# Originally based on portions of Ken Yap's genrules.pl. Completely
 | 
		
	
		
			
			|  | 7 | +# rewritten by Robin Smidsrød to be more maintainable.
 | 
		
	
		
			
			| 7 | 8 |  
 | 
		
	
		
			
			| 8 | 9 |  use strict;
 | 
		
	
		
			
			| 9 | 10 |  use warnings;
 | 
		
	
		
			
			|  | 11 | +use Getopt::Long;
 | 
		
	
		
			
			| 10 | 12 |  
 | 
		
	
		
			
			| 11 |  | -die "Syntax: $0 driver_source.c" unless @ARGV == 1;
 | 
		
	
		
			
			| 12 |  | -my $source = shift;
 | 
		
	
		
			
			| 13 |  | -open DRV, "<$source" or die "Could not open $source: $!\n";
 | 
		
	
		
			
			|  | 13 | +# Parse command-line options
 | 
		
	
		
			
			|  | 14 | +my @exclude_driver_classes = ();
 | 
		
	
		
			
			|  | 15 | +my @exclude_drivers = ();
 | 
		
	
		
			
			|  | 16 | +my $debug = 0;
 | 
		
	
		
			
			|  | 17 | +my $help = 0;
 | 
		
	
		
			
			|  | 18 | +GetOptions(
 | 
		
	
		
			
			|  | 19 | +    "exclude-driver-class=s" => \@exclude_driver_classes,
 | 
		
	
		
			
			|  | 20 | +    "exclude-driver=s"       => \@exclude_drivers,
 | 
		
	
		
			
			|  | 21 | +    "debug"                  => \$debug,
 | 
		
	
		
			
			|  | 22 | +    "help"                   => \$help,
 | 
		
	
		
			
			|  | 23 | +);
 | 
		
	
		
			
			| 14 | 24 |  
 | 
		
	
		
			
			| 15 |  | -( my $family, my $driver_name ) = ( $source =~ /^(.*?([^\/]+))\..$/ )
 | 
		
	
		
			
			| 16 |  | -    or die "Could not parse source file name \"$source\"\n";
 | 
		
	
		
			
			|  | 25 | +# Convert exclution arrays to lookup tables
 | 
		
	
		
			
			|  | 26 | +my $exclude_driver_class_map = { map { $_ => 1 } @exclude_driver_classes };
 | 
		
	
		
			
			|  | 27 | +my $exclude_driver_map       = { map { $_ => 1 } @exclude_drivers        };
 | 
		
	
		
			
			| 17 | 28 |  
 | 
		
	
		
			
			| 18 |  | -my $printed_family;
 | 
		
	
		
			
			|  | 29 | +# Ensure STDOUT and STDERR are synchronized if debugging
 | 
		
	
		
			
			|  | 30 | +if ( $debug ) {
 | 
		
	
		
			
			|  | 31 | +    STDOUT->autoflush(1);
 | 
		
	
		
			
			|  | 32 | +    STDERR->autoflush(1);
 | 
		
	
		
			
			|  | 33 | +}
 | 
		
	
		
			
			|  | 34 | +
 | 
		
	
		
			
			|  | 35 | +# Compile regular expressions here for slight performance boost
 | 
		
	
		
			
			|  | 36 | +my %RE = (
 | 
		
	
		
			
			|  | 37 | +    'parse_driver_class'    => qr{ drivers/ (\w+?) / }x,
 | 
		
	
		
			
			|  | 38 | +    'parse_family'          => qr{^ (?:\./)? (.*) \..+? $}x,
 | 
		
	
		
			
			|  | 39 | +    'find_rom_line'         => qr/^ \s* ( (PCI|ISA)_ROM \s* \( \s* (.*?) ) $/x,
 | 
		
	
		
			
			|  | 40 | +    'extract_pci_id'        => qr/^ \s* 0x([0-9A-Fa-f]{4}) \s* ,? \s* (.*) $/x,
 | 
		
	
		
			
			|  | 41 | +    'extract_quoted_string' => qr/^ \s* \" ([^\"]*?) \" \s* ,? \s* (.*) $/x,
 | 
		
	
		
			
			|  | 42 | +);
 | 
		
	
		
			
			|  | 43 | +
 | 
		
	
		
			
			|  | 44 | +# Show help if required arguments are missing or help was requested
 | 
		
	
		
			
			|  | 45 | +show_usage_and_exit() if $help or @ARGV < 1;
 | 
		
	
		
			
			|  | 46 | +
 | 
		
	
		
			
			|  | 47 | +# Process each source file specified
 | 
		
	
		
			
			|  | 48 | +process_source_file($_) for @ARGV;
 | 
		
	
		
			
			|  | 49 | +
 | 
		
	
		
			
			|  | 50 | +exit;
 | 
		
	
		
			
			|  | 51 | +
 | 
		
	
		
			
			|  | 52 | +sub show_usage_and_exit {
 | 
		
	
		
			
			|  | 53 | +    print STDERR <<"EOM";
 | 
		
	
		
			
			|  | 54 | +Syntax: $0 [<options>] <source-file> [<source-file>]
 | 
		
	
		
			
			|  | 55 | +Options:
 | 
		
	
		
			
			|  | 56 | +    --exclude-driver-class Exclude specified driver classes
 | 
		
	
		
			
			|  | 57 | +    --exclude-driver       Exclude specified drivers
 | 
		
	
		
			
			|  | 58 | +    --debug                Output debug information on STDERR
 | 
		
	
		
			
			|  | 59 | +    --help                 This help information
 | 
		
	
		
			
			|  | 60 | +EOM
 | 
		
	
		
			
			|  | 61 | +    exit 1;
 | 
		
	
		
			
			|  | 62 | +}
 | 
		
	
		
			
			|  | 63 | +
 | 
		
	
		
			
			|  | 64 | +# Figure out if source file is a driver and look for ROM declarations
 | 
		
	
		
			
			|  | 65 | +sub process_source_file {
 | 
		
	
		
			
			|  | 66 | +    my ($source_file) = @_;
 | 
		
	
		
			
			|  | 67 | +    return unless defined $source_file;
 | 
		
	
		
			
			|  | 68 | +    return unless length $source_file;
 | 
		
	
		
			
			|  | 69 | +    my $state = { 'source_file' => $source_file };
 | 
		
	
		
			
			|  | 70 | +    log_debug("SOURCE_FILE", $state->{source_file});
 | 
		
	
		
			
			|  | 71 | +    # Skip source files that aren't drivers
 | 
		
	
		
			
			|  | 72 | +    parse_driver_class( $state );
 | 
		
	
		
			
			|  | 73 | +    unless ( $state->{'driver_class'} ) {
 | 
		
	
		
			
			|  | 74 | +        log_debug("SKIP_NOT_DRIVER", $state->{source_file} );
 | 
		
	
		
			
			|  | 75 | +        return;
 | 
		
	
		
			
			|  | 76 | +    }
 | 
		
	
		
			
			|  | 77 | +    # Skip source files with driver classes that are explicitly excluded
 | 
		
	
		
			
			|  | 78 | +    if ( $exclude_driver_class_map->{ $state->{'driver_class'} } ) {
 | 
		
	
		
			
			|  | 79 | +        log_debug("SKIP_EXCL_CLASS", $state->{'driver_class'} );
 | 
		
	
		
			
			|  | 80 | +        return;
 | 
		
	
		
			
			|  | 81 | +    }
 | 
		
	
		
			
			|  | 82 | +    # Skip source files without driver information
 | 
		
	
		
			
			|  | 83 | +    parse_family( $state );
 | 
		
	
		
			
			|  | 84 | +    parse_driver_name( $state );
 | 
		
	
		
			
			|  | 85 | +    unless ( $state->{'family'} and $state->{'driver_name'} ) {
 | 
		
	
		
			
			|  | 86 | +        log_debug("SKIP_NO_DRV_INFO", $state->{source_file} );
 | 
		
	
		
			
			|  | 87 | +        return;
 | 
		
	
		
			
			|  | 88 | +    }
 | 
		
	
		
			
			|  | 89 | +    # Skip source files with drivers that are explicitly excluded
 | 
		
	
		
			
			|  | 90 | +    if ( $exclude_driver_map->{ $state->{'driver_name'} } ) {
 | 
		
	
		
			
			|  | 91 | +        log_debug("SKIP_EXCL_DRV", $state->{'driver_name'} );
 | 
		
	
		
			
			|  | 92 | +        return;
 | 
		
	
		
			
			|  | 93 | +    }
 | 
		
	
		
			
			|  | 94 | +    # Iterate through lines in source files looking for ROM declarations
 | 
		
	
		
			
			|  | 95 | +    # and # output Makefile rules
 | 
		
	
		
			
			|  | 96 | +    open( my $fh, "<", $state->{'source_file'} )
 | 
		
	
		
			
			|  | 97 | +        or die "Couldn't open $state->{source_file}: $!\n";
 | 
		
	
		
			
			|  | 98 | +    while (<$fh>) {
 | 
		
	
		
			
			|  | 99 | +        process_rom_decl($state, $1, $2, $3) if m/$RE{find_rom_line}/;
 | 
		
	
		
			
			|  | 100 | +    }
 | 
		
	
		
			
			|  | 101 | +    close($fh) or die "Couldn't close $source_file: $!\n";
 | 
		
	
		
			
			|  | 102 | +    return 1;
 | 
		
	
		
			
			|  | 103 | +}
 | 
		
	
		
			
			|  | 104 | +
 | 
		
	
		
			
			|  | 105 | +# Verify that the found ROM declaration is sane and dispatch to the right
 | 
		
	
		
			
			|  | 106 | +# handler depending on type
 | 
		
	
		
			
			|  | 107 | +sub process_rom_decl {
 | 
		
	
		
			
			|  | 108 | +    my ($state, $rom_line, $rom_type, $rom_decl) = @_;
 | 
		
	
		
			
			|  | 109 | +    return unless defined $rom_line;
 | 
		
	
		
			
			|  | 110 | +    return unless length $rom_line;
 | 
		
	
		
			
			|  | 111 | +    log_debug("ROM_LINE", $rom_line);
 | 
		
	
		
			
			|  | 112 | +    return unless defined $rom_type;
 | 
		
	
		
			
			|  | 113 | +    return unless length $rom_type;
 | 
		
	
		
			
			|  | 114 | +    log_debug("ROM_TYPE", $rom_type);
 | 
		
	
		
			
			|  | 115 | +    $state->{'type'} = lc $rom_type;
 | 
		
	
		
			
			|  | 116 | +    return process_pci_rom($state, $rom_decl) if $rom_type eq "PCI";
 | 
		
	
		
			
			|  | 117 | +    return process_isa_rom($state, $rom_decl) if $rom_type eq "ISA";
 | 
		
	
		
			
			|  | 118 | +    return;
 | 
		
	
		
			
			|  | 119 | +}
 | 
		
	
		
			
			|  | 120 | +
 | 
		
	
		
			
			|  | 121 | +# Extract values from PCI_ROM declaration lines and dispatch to
 | 
		
	
		
			
			|  | 122 | +# Makefile rule generator
 | 
		
	
		
			
			|  | 123 | +sub process_pci_rom {
 | 
		
	
		
			
			|  | 124 | +    my ($state, $decl) = @_;
 | 
		
	
		
			
			|  | 125 | +    return unless defined $decl;
 | 
		
	
		
			
			|  | 126 | +    return unless length $decl;
 | 
		
	
		
			
			|  | 127 | +    (my $vendor, $decl) = extract_pci_id($decl,        'PCI_VENDOR');
 | 
		
	
		
			
			|  | 128 | +    (my $device, $decl) = extract_pci_id($decl,        'PCI_DEVICE');
 | 
		
	
		
			
			|  | 129 | +    (my $image,  $decl) = extract_quoted_string($decl, 'IMAGE');
 | 
		
	
		
			
			|  | 130 | +    (my $desc,   $decl) = extract_quoted_string($decl, 'DESCRIPTION');
 | 
		
	
		
			
			|  | 131 | +    if ( $vendor and $device and $image and $desc ) {
 | 
		
	
		
			
			|  | 132 | +        print_make_rules( $state, "${vendor}${device}", $desc, $vendor, $device );
 | 
		
	
		
			
			|  | 133 | +        print_make_rules( $state, $image, $desc, $vendor, $device, 1 );
 | 
		
	
		
			
			|  | 134 | +    }
 | 
		
	
		
			
			|  | 135 | +    else {
 | 
		
	
		
			
			|  | 136 | +        log_debug("WARNING", "Malformed PCI_ROM macro on line $. of $state->{source_file}");
 | 
		
	
		
			
			|  | 137 | +    }
 | 
		
	
		
			
			|  | 138 | +    return 1;
 | 
		
	
		
			
			|  | 139 | +}
 | 
		
	
		
			
			|  | 140 | +
 | 
		
	
		
			
			|  | 141 | +# Extract values from ISA_ROM declaration lines and dispatch to
 | 
		
	
		
			
			|  | 142 | +# Makefile rule generator
 | 
		
	
		
			
			|  | 143 | +sub process_isa_rom {
 | 
		
	
		
			
			|  | 144 | +    my ($state, $decl) = @_;
 | 
		
	
		
			
			|  | 145 | +    return unless defined $decl;
 | 
		
	
		
			
			|  | 146 | +    return unless length $decl;
 | 
		
	
		
			
			|  | 147 | +    (my $image, $decl) = extract_quoted_string($decl, 'IMAGE');
 | 
		
	
		
			
			|  | 148 | +    (my $desc,  $decl) = extract_quoted_string($decl, 'DESCRIPTION');
 | 
		
	
		
			
			|  | 149 | +    if ( $image and $desc ) {
 | 
		
	
		
			
			|  | 150 | +        print_make_rules( $state, $image, $desc );
 | 
		
	
		
			
			|  | 151 | +    }
 | 
		
	
		
			
			|  | 152 | +    else {
 | 
		
	
		
			
			|  | 153 | +        log_debug("WARNING", "Malformed ISA_ROM macro on line $. of $state->{source_file}");
 | 
		
	
		
			
			|  | 154 | +    }
 | 
		
	
		
			
			|  | 155 | +    return 1;
 | 
		
	
		
			
			|  | 156 | +}
 | 
		
	
		
			
			| 19 | 157 |  
 | 
		
	
		
			
			| 20 |  | -sub rom {
 | 
		
	
		
			
			| 21 |  | -  ( my $type, my $image, my $desc, my $vendor, my $device, my $dup ) = @_;
 | 
		
	
		
			
			| 22 |  | -  my $ids = $vendor ? "$vendor,$device" : "-";
 | 
		
	
		
			
			| 23 |  | -  unless ( $printed_family ) {
 | 
		
	
		
			
			|  | 158 | +# Output Makefile rules for the specified ROM declarations
 | 
		
	
		
			
			|  | 159 | +sub print_make_rules {
 | 
		
	
		
			
			|  | 160 | +    my ( $state, my $image, my $desc, my $vendor, my $device, my $dup ) = @_;
 | 
		
	
		
			
			|  | 161 | +    unless ( $state->{'is_header_printed'} ) {
 | 
		
	
		
			
			|  | 162 | +        print "# NIC\t\n";
 | 
		
	
		
			
			|  | 163 | +        print "# NIC\tfamily\t$state->{family}\n";
 | 
		
	
		
			
			|  | 164 | +        print "DRIVERS += $state->{driver_name}\n";
 | 
		
	
		
			
			|  | 165 | +        print "\n";
 | 
		
	
		
			
			|  | 166 | +        $state->{'is_header_printed'} = 1;
 | 
		
	
		
			
			|  | 167 | +    }
 | 
		
	
		
			
			|  | 168 | +    return if $vendor and ( $vendor eq "ffff" or $device eq "ffff" );
 | 
		
	
		
			
			|  | 169 | +    my $ids = $vendor ? "$vendor,$device" : "-";
 | 
		
	
		
			
			|  | 170 | +    print "# NIC\t$image\t$ids\t$desc\n";
 | 
		
	
		
			
			|  | 171 | +    print "DRIVER_$image = $state->{driver_name}\n";
 | 
		
	
		
			
			|  | 172 | +    print "ROM_TYPE_$image = $state->{type}\n";
 | 
		
	
		
			
			|  | 173 | +    print "ROM_DESCRIPTION_$image = \"$desc\"\n";
 | 
		
	
		
			
			|  | 174 | +    print "PCI_VENDOR_$image = 0x$vendor\n" if $vendor;
 | 
		
	
		
			
			|  | 175 | +    print "PCI_DEVICE_$image = 0x$device\n" if $device;
 | 
		
	
		
			
			|  | 176 | +    print "ROMS += $image\n" unless $dup;
 | 
		
	
		
			
			|  | 177 | +    print "ROMS_$state->{driver_name} += $image\n" unless $dup;
 | 
		
	
		
			
			| 24 | 178 |      print "\n";
 | 
		
	
		
			
			| 25 |  | -    print "# NIC\t\n";
 | 
		
	
		
			
			| 26 |  | -    print "# NIC\tfamily\t$family\n";
 | 
		
	
		
			
			| 27 |  | -    print "DRIVERS += $driver_name\n";
 | 
		
	
		
			
			| 28 |  | -    $printed_family = 1;
 | 
		
	
		
			
			| 29 |  | -  }
 | 
		
	
		
			
			| 30 |  | -  print "\n";
 | 
		
	
		
			
			| 31 |  | -  return if ( $vendor && ( ( $vendor eq "ffff" ) || ( $device eq "ffff" ) ) );
 | 
		
	
		
			
			| 32 |  | -  print "# NIC\t$image\t$ids\t$desc\n";
 | 
		
	
		
			
			| 33 |  | -  print "DRIVER_$image = $driver_name\n";
 | 
		
	
		
			
			| 34 |  | -  print "ROM_TYPE_$image = $type\n";
 | 
		
	
		
			
			| 35 |  | -  print "ROM_DESCRIPTION_$image = \"$desc\"\n";
 | 
		
	
		
			
			| 36 |  | -  print "PCI_VENDOR_$image = 0x$vendor\n" if $vendor;
 | 
		
	
		
			
			| 37 |  | -  print "PCI_DEVICE_$image = 0x$device\n" if $device;
 | 
		
	
		
			
			| 38 |  | -  print "ROMS += $image\n" unless $dup;
 | 
		
	
		
			
			| 39 |  | -  print "ROMS_$driver_name += $image\n" unless $dup;
 | 
		
	
		
			
			|  | 179 | +    return 1;
 | 
		
	
		
			
			|  | 180 | +}
 | 
		
	
		
			
			|  | 181 | +
 | 
		
	
		
			
			|  | 182 | +# Driver class is whatever comes after the "drivers" part of the filename (relative path)
 | 
		
	
		
			
			|  | 183 | +sub parse_driver_class {
 | 
		
	
		
			
			|  | 184 | +    my ($state) = @_;
 | 
		
	
		
			
			|  | 185 | +    my $filename = $state->{'source_file'};
 | 
		
	
		
			
			|  | 186 | +    return unless defined $filename;
 | 
		
	
		
			
			|  | 187 | +    return unless length $filename;
 | 
		
	
		
			
			|  | 188 | +    if ( $filename =~ m/$RE{parse_driver_class}/ ) {
 | 
		
	
		
			
			|  | 189 | +        log_debug("DRIVER_CLASS", $1);
 | 
		
	
		
			
			|  | 190 | +        $state->{'driver_class'} = $1;
 | 
		
	
		
			
			|  | 191 | +    }
 | 
		
	
		
			
			|  | 192 | +    return;
 | 
		
	
		
			
			|  | 193 | +}
 | 
		
	
		
			
			|  | 194 | +
 | 
		
	
		
			
			|  | 195 | +# Family name is filename (relative path) without extension
 | 
		
	
		
			
			|  | 196 | +sub parse_family {
 | 
		
	
		
			
			|  | 197 | +    my ($state) = @_;
 | 
		
	
		
			
			|  | 198 | +    my $filename = $state->{'source_file'};
 | 
		
	
		
			
			|  | 199 | +    return unless defined $filename;
 | 
		
	
		
			
			|  | 200 | +    return unless length $filename;
 | 
		
	
		
			
			|  | 201 | +    if ( $filename =~ m/$RE{parse_family}/ ) {
 | 
		
	
		
			
			|  | 202 | +        log_debug("FAMILY", $1);
 | 
		
	
		
			
			|  | 203 | +        $state->{'family'} = $1;
 | 
		
	
		
			
			|  | 204 | +    }
 | 
		
	
		
			
			|  | 205 | +    return;
 | 
		
	
		
			
			|  | 206 | +}
 | 
		
	
		
			
			|  | 207 | +
 | 
		
	
		
			
			|  | 208 | +# Driver name is last part of family name
 | 
		
	
		
			
			|  | 209 | +sub parse_driver_name {
 | 
		
	
		
			
			|  | 210 | +    my ($state) = @_;
 | 
		
	
		
			
			|  | 211 | +    my $family = $state->{'family'};
 | 
		
	
		
			
			|  | 212 | +    return unless defined $family;
 | 
		
	
		
			
			|  | 213 | +    return unless length $family;
 | 
		
	
		
			
			|  | 214 | +    my @parts = split "/", $family;
 | 
		
	
		
			
			|  | 215 | +    $state->{'driver_name'} = $parts[-1];
 | 
		
	
		
			
			|  | 216 | +    log_debug("DRIVER", $state->{'driver_name'});
 | 
		
	
		
			
			|  | 217 | +    return;
 | 
		
	
		
			
			| 40 | 218 |  }
 | 
		
	
		
			
			| 41 | 219 |  
 | 
		
	
		
			
			| 42 |  | -while ( <DRV> ) {
 | 
		
	
		
			
			| 43 |  | -  next unless /(PCI|ISA)_ROM\s*\(/;
 | 
		
	
		
			
			| 44 |  | -
 | 
		
	
		
			
			| 45 |  | -  if ( /^\s*PCI_ROM\s*\(
 | 
		
	
		
			
			| 46 |  | -         \s*0x([0-9A-Fa-f]{4})\s*, # PCI vendor
 | 
		
	
		
			
			| 47 |  | -         \s*0x([0-9A-Fa-f]{4})\s*, # PCI device
 | 
		
	
		
			
			| 48 |  | -         \s*\"([^\"]*)\"\s*,	   # Image
 | 
		
	
		
			
			| 49 |  | -         \s*\"([^\"]*)\"\s*,	   # Description
 | 
		
	
		
			
			| 50 |  | -         \s*.*\s*		   # Driver data
 | 
		
	
		
			
			| 51 |  | -       \)/x ) {
 | 
		
	
		
			
			| 52 |  | -    ( my $vendor, my $device, my $image, my $desc ) = ( lc $1, lc $2, $3, $4 );
 | 
		
	
		
			
			| 53 |  | -    rom ( "pci", lc "${vendor}${device}", $desc, $vendor, $device );
 | 
		
	
		
			
			| 54 |  | -    rom ( "pci", $image, $desc, $vendor, $device, 1 );
 | 
		
	
		
			
			| 55 |  | -  } elsif ( /^\s*ISA_ROM\s*\(
 | 
		
	
		
			
			| 56 |  | -	      \s*\"([^\"]*)\"\s*,  # Image
 | 
		
	
		
			
			| 57 |  | -	      \s*\"([^\"]*)\"\s*   # Description
 | 
		
	
		
			
			| 58 |  | -	    \)/x ) {
 | 
		
	
		
			
			| 59 |  | -    ( my $image, my $desc ) = ( $1, $2 );
 | 
		
	
		
			
			| 60 |  | -    rom ( "isa", $image, $desc );
 | 
		
	
		
			
			| 61 |  | -  } else {
 | 
		
	
		
			
			| 62 |  | -    warn "Malformed PCI_ROM or ISA_ROM macro on line $. of $source\n";
 | 
		
	
		
			
			| 63 |  | -  }
 | 
		
	
		
			
			|  | 220 | +# Extract a PCI vendor/device ID e.g. 0x8086, possibly followed by a comma
 | 
		
	
		
			
			|  | 221 | +# Should always be 4-digit lower-case hex number
 | 
		
	
		
			
			|  | 222 | +sub extract_pci_id {
 | 
		
	
		
			
			|  | 223 | +    my ($str, $label) = @_;
 | 
		
	
		
			
			|  | 224 | +    return "", $str unless defined $str;
 | 
		
	
		
			
			|  | 225 | +    return "", $str unless length $str;
 | 
		
	
		
			
			|  | 226 | +    if ( $str =~ m/$RE{extract_pci_id}/ ) {
 | 
		
	
		
			
			|  | 227 | +        my $id = lc $1;
 | 
		
	
		
			
			|  | 228 | +        log_debug($label, $id);
 | 
		
	
		
			
			|  | 229 | +        return $id, $2;
 | 
		
	
		
			
			|  | 230 | +    }
 | 
		
	
		
			
			|  | 231 | +    return "", $str;
 | 
		
	
		
			
			| 64 | 232 |  }
 | 
		
	
		
			
			| 65 | 233 |  
 | 
		
	
		
			
			| 66 |  | -close DRV;
 | 
		
	
		
			
			|  | 234 | +# Extract a double-quoted string, possibly followed by a comma
 | 
		
	
		
			
			|  | 235 | +sub extract_quoted_string {
 | 
		
	
		
			
			|  | 236 | +    my ($str, $label) = @_;
 | 
		
	
		
			
			|  | 237 | +    return "", $str unless defined $str;
 | 
		
	
		
			
			|  | 238 | +    return "", $str unless length $str;
 | 
		
	
		
			
			|  | 239 | +    if ( $str =~ m/$RE{extract_quoted_string}/ ) {
 | 
		
	
		
			
			|  | 240 | +        log_debug($label, $1);
 | 
		
	
		
			
			|  | 241 | +        return $1, $2;
 | 
		
	
		
			
			|  | 242 | +    }
 | 
		
	
		
			
			|  | 243 | +    return "", $str;
 | 
		
	
		
			
			|  | 244 | +}
 | 
		
	
		
			
			|  | 245 | +
 | 
		
	
		
			
			|  | 246 | +# Output debug info to STDERR (off by default)
 | 
		
	
		
			
			|  | 247 | +sub log_debug {
 | 
		
	
		
			
			|  | 248 | +    my ($label, $str) = @_;
 | 
		
	
		
			
			|  | 249 | +    return unless $debug;
 | 
		
	
		
			
			|  | 250 | +    return unless defined $str;
 | 
		
	
		
			
			|  | 251 | +    print STDERR "\n" if $label eq 'SOURCE_FILE';
 | 
		
	
		
			
			|  | 252 | +    print STDERR "=";
 | 
		
	
		
			
			|  | 253 | +    if ( defined $label ) {
 | 
		
	
		
			
			|  | 254 | +        my $pad_count = 16 - length $label;
 | 
		
	
		
			
			|  | 255 | +        print STDERR $label . ":" . ( " " x $pad_count );
 | 
		
	
		
			
			|  | 256 | +    }
 | 
		
	
		
			
			|  | 257 | +    print STDERR $str . "\n";
 | 
		
	
		
			
			|  | 258 | +    return;
 | 
		
	
		
			
			|  | 259 | +}
 |