tlp-pcilist

#!/usr/bin/perl
# tlp-pcilist - list pci devices with runtime pm mode and device class
#
# Copyright (c) 2024 Thomas Koch <linrunner at gmx.net> and others.
# SPDX-License-Identifier: GPL-2.0-or-later

# Cmdline options
#   --verbose: show Runtime PM device status

package tlp_pcilist;
use strict;
use warnings;

# --- Modules
use Getopt::Long;

# --- Global vars
my $verbose = 0;

# --- Subroutines

# Read content from a sysfile
# $_[0]: input file
# return: content / empty string if nonexistent or not readable
sub catsysf {
    my $fname = "$_[0]";
    my $sysval = "";
    if (open my $sysf, "<", $fname) {
        chomp ($sysval = <$sysf>);
        close $sysf;
    }
    return $sysval;
}

# Read device driver from DEVICE/uevent
# $_[0]: (sub)device base path
# return: driver / empty string if uevent nonexistent or not readable
sub getdriver {
    my $dpath = "$_[0]";
    my $driver = "";
    if ( open (my $sysf, "<", $dpath . "/uevent") ) {
        # read file line by line
        while (<$sysf>) {
            # match line content and return DRIVER= value
            if ( s/^DRIVER=(.*)/$1/ ) {
                chomp ($driver = $_);
                last; # break loop
            }
        }
        close ($sysf);
    }
    return $driver
}

# --- MAIN
# parse arguments
GetOptions ('verbose' => \$verbose);

# Output device list with Runtime PM mode, status and device class
foreach (`lspci -m`) {
    # parse lspci output: get short PCI(e) id and long description of device
    my ($dev, $classdesc) = /(\S+) \"(.+?)\"/;
    # join device path
    my $devp = "/sys/bus/pci/devices/0000:$dev";
    # control file for Runtime PM
    my $devc = "$devp/power/control";
    # status file for Runtime PM
    my $devs = "$devp/power/runtime_status";
    # get device class
    my $class = catsysf ("$devp/class");
    # get device driver
    my $driver = getdriver ("$devp") || "no driver";

    if (-f $devc) { # control file exists
        # get device mode
        my $pmode = catsysf ("$devc");
        if ( $verbose ) {
            # get device status
            my $pstatus = catsysf ("$devs");
            # output device mode, status and data
            printf "%s/power/control = %-4s, runtime_status = %-9s (%s, %s, %s)\n", $devp, $pmode, $pstatus, $class, $classdesc, $driver;
        } else {
            # output device mode and data
            printf "%s/power/control = %-4s (%s, %s, %s)\n", $devp, $pmode, $class, $classdesc, $driver;
        }
    } else { # control file missing --> output device data only
        printf "%s/power/control = (not available) (%s, %s, %s)\n", $devp, $class, $classdesc, $driver;
    }
}

exit 0;