PciIds/Address/PciClass.pm

   1 package PciIds::Address::PciClass;
   2 use strict;
   3 use warnings;
   4 use PciIds::Address::Toplevel;
   5 use base 'PciIds::Address::Base';
   6
   7 sub new( $ ) {
   8         my( $address ) = @_;
   9         return PciIds::Address::Toplevel::new( $address ) if( $address =~ /^PD\/?$/ );
  10         return bless PciIds::Address::Base::new( $address );
  11 }
  12
  13 sub pretty( $ ) {
  14         my $self = shift;
  15         $_ = $self->get();
  16         s/^PD\/?//;
  17         s/\//:/g;
  18         my $prefix;
  19         if( /:.*:/ ) {
  20                 $prefix = 'Program interface';
  21         } elsif( /:/ ) {
  22                 $prefix = 'Device subclass';
  23         } else {
  24                 $prefix = 'Device class';
  25         }
  26         #TODO Other levels? Are the names OK?
  27         return $prefix.' '.$_;
  28 }
  29
  30 sub restrictRex( $$ ) {
  31         my( $self, $restrict ) = @_;
  32         my( $result ) = ( $restrict =~ /^([a-f0-9]{1,2})/ );#TODO every time?
  33         return $result;
  34 }
  35
  36 sub leaf( $ ) {
  37         return shift->get() =~ /\/.*\/.*\//;
  38 }
  39
  40 sub append( $$ ) {
  41         my( $self, $suffix ) = @_;
  42         return ( undef, 'You can not add to leaf node' ) if( $self->leaf() );
  43         return ( undef, "Invalid ID syntax" ) unless ( $suffix =~ /^[0-9a-f]{2,2}$/ );
  44         return ( PciIds::Address::new( $self->{'value'} . ( ( $self->{'value'} =~ /\/$/ ) ? '' : '/' ) . $suffix ), undef );
  45 }
  46
  47 1;