gpu-info.pl

#!/usr/bin/perl

use strict;
use warnings;

use Cwd;
use Data::Dumper;

my $DEBUG = 1;

my @cards;

sub check_deps {
    
}

sub debug {
    if ( $DEBUG >= $_[0] ) {
        print $_[1]."\n";
    }
}

sub list_cards {
    my @paths = </sys/class/drm/card?/>;
    for my $path ( @paths ) {
        #print $path."\n";
        if ( $path =~ /\/sys\/class\/drm\/card(\d+)/ ) {
            my %card;
            $card{ 'id' }       = $1;
            $card{ 'drm_path' } = $path;
            $card{ 'dev_path' } = readlink $path.'device';
            chdir $path;
            chdir $card{ 'dev_path' };
            my $tpath = getcwd();
            my $list = `ls -alh $tpath`;
            chomp $list;
            #$card{ 'files' } = $list;
            $card{ 'pci_path' } = $tpath;
            if ( $card{ 'dev_path' } =~ /(\S{4}:\S{2}:\S{2}.\S)$/ ) {
                $card{ 'pci_addr' } = $1;
                my $lspci_cmd = "lspci -s $card{'pci_addr'} -v";
                my $lspci = `$lspci_cmd`;
                chomp $lspci;
                $card{ 'lspci_cmd' } = $lspci_cmd;
                $card{ 'lspci' }     = $lspci;
                my $pci_ids = `lspci -n -s $card{'pci_addr'}`;
                my $t_pci_vendor_id;
                my $t_pci_device_id;
                my ( $t_pci_addr, undef, $t_pci_vendev_id, $t_pci_dev_rev, $t_pci_dev_rev_end ) = split /\s/, $pci_ids;
                #if ( $t_pci_addr eq $card{'pci_short_addr'} ) {
                    ( $t_pci_vendor_id, $t_pci_device_id ) = split ':', $t_pci_vendev_id;
                    $card{ 'vendor_id' }  = $t_pci_vendor_id;
                    $card{ 'device_id' }  = $t_pci_device_id;
                    $t_pci_dev_rev .= $t_pci_dev_rev_end;
                    $t_pci_dev_rev = ( $t_pci_dev_rev =~ /\((.*)\)/ );
                    #print "Device revision: $t_pci_dev_rev\n";
                    $card{ 'device_rev' } = $t_pci_dev_rev;
                #}
                # Parse lspci
                my @lines = split "\n", $lspci;
                $card{ 'pci_name' }   = $lines[0];
                $card{ 'pci_subsys' } = $lines[1];
                $card{ 'pci_subsys' } =~ s/^\s+Subsystem:\s+//;
                my $sample = 'Kernel driver in use:';
                my @some_lines = grep /$sample/, @lines;
                #debug( 1, 'Some lines: '.Dumper( \@some_lines ) );
                ($card{ 'kernel_using_driver' }) = ( $some_lines[0] =~ /$sample\s(\S+)$/ );
            }
            #'/sys/devices/pci0000:00/0000:00:02.0'
            push @cards, \%card;
        }
        #debug 2, Dumper( \%card );
        #
    }
    #debug 1, Dumper( \@cards );
    for my $card ( @cards ) {
        #print 'Card-'.$card->{'id'}.":\n";
        print "GPU-$card->{'id'}:\tDevice name: ".$card->{'pci_name'}."\n";
        print "GPU-$card->{'id'}:\tDevice vendor: ".$card->{'pci_subsys'}."\n";
        print "GPU-$card->{'id'}:\tPCI path: ".$card->{'pci_path'}."\n";
        print "\n";
    }
}

sub main {
    check_deps();
    list_cards();
}

exit main();