PciIds/Address/Pci.pm

   1 #       PciIds web database
   2 #       Copyright (C) 2008 Michal Vaner (vorner@ucw.cz)
   3 #
   4 #       This program is free software; you can redistribute it and/or modify
   5 #       it under the terms of the GNU General Public License as published by
   6 #       he Free Software Foundation; either version 2 of the License, or
   7 #       (at your option) any later version.
   8 #
   9 #       This program is distributed in the hope that it will be useful,
  10 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 #
  13 #       GNU General Public License for more details.
  14 #
  15 #       You should have received a copy of the GNU General Public License
  16 #       along with this program; if not, write to the Free Software
  17 #       Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18
  19 package PciIds::Address::Pci;
  20 use strict;
  21 use warnings;
  22 use PciIds::Address::Toplevel;
  23 use base 'PciIds::Address::Base';
  24
  25 sub new( $ ) {
  26         my( $address ) = @_;
  27         return PciIds::Address::Toplevel::new( $address ) if( $address =~ /^PC\/?$/ );
  28         return bless PciIds::Address::Base::new( $address );
  29 }
  30
  31 sub fullPretty( $ ) {
  32         $_ = shift->get();
  33         s/^PC\/?//;
  34         s/\//:/g;
  35         if( /:.*:/ ) {
  36                 s/^/PCI subsystem /;
  37         } elsif( /:/ ) {
  38                 s/^/PCI device /;
  39         } else {
  40                 s/^/PCI vendor /;
  41         }
  42         return $_;
  43 }
  44
  45 sub pretty( $ ) {
  46         my $self = shift;
  47         $_ = $self->get();
  48         s/^PC\/?//;
  49         s/\//:/g;
  50         s/([0-9a-f]{4})([0-9a-f]{4})/$1 $2/g;
  51         my $prefix = '';
  52         if( /:.*:/ ) {
  53                 $prefix = 'Subsystem';
  54         } elsif( /:/ ) {
  55                 $prefix = 'Device';
  56         } else {
  57                 $prefix = 'Vendor';
  58         }
  59         return $prefix.' '. $_;
  60 }
  61
  62 sub tail( $ ) {
  63         my( $new ) = ( shift->get() );
  64         $new =~ s/.*\/(.)/$1/;
  65         $new =~ s/([0-9a-f]{4})([0-9a-f]{4})/$1 $2/g;
  66         return $new;
  67 }
  68
  69 sub restrictRex( $$ ) {
  70         my( $self, $restrict ) = @_;
  71         my( $result ) = ( $restrict =~ /^([a-f0-9]{1,4})/ );#TODO every time?
  72         return $result;
  73 }
  74
  75 sub leaf( $ ) {
  76         return ( shift->get() =~ /\/.*\/.*\// );
  77 }
  78
  79 sub append( $$ ) {
  80         my( $self, $suffix ) = @_;
  81         return ( undef, 'You can not add to leaf node' ) if( $self->leaf() );
  82         $suffix =~ s/ //g;
  83         return ( undef, "Invalid ID syntax" ) unless ( ( ( $self->get() !~ /^PC\/.*\// ) && ( $suffix =~ /^[0-9a-f]{4}$/ ) ) || ( ( $self->get() =~ /^PC\/.*\// ) && ( $suffix =~ /^[0-9a-f]{8}$/ ) ) );
  84         return ( PciIds::Address::new( $self->{'value'} . ( ( $self->{'value'} =~ /\/$/ ) ? '' : '/' ) . $suffix ), undef );
  85 }
  86
  87 sub path( $ ) {
  88         my( $self ) = @_;
  89         my $result = PciIds::Address::Base::path( $self );
  90         my( $vid ) = ( $self->get() =~ /^PC\/[0-9a-f]{4}\/[0-9a-f]{4}\/([0-9a-f]{4})/ );
  91         unshift @{$result}, [ PciIds::Address::new( "PC/$vid" ), 1 ] if( defined $vid );# && ( $result->[1]->[0]->get() ne "PC/$vid" );
  92         return $result;
  93 }
  94
  95 sub helpName( $ ) {
  96         return 'pci';
  97 }
  98
  99 sub addressDeps( $ ) {
 100         my( $addr ) = ( shift->get() =~ /^PC\/....\/....\/(....)/ );
 101         return [] unless defined $addr;
 102         return [ [ PciIds::Address::new( "PC/$addr" ), "Subsystem vendor $addr does not exist" ] ];
 103 }
 104
 105 sub subName( $ ) {
 106         my( $self ) = @_;
 107         return 'Subsystems' if $self->get() =~ /^PC\/....\/..../;
 108         return 'Devices' if $self->get() =~ /^PC\/..../;
 109         die "Can not happend\n";
 110 }
 111
 112 sub subIdSize( $ ) {
 113         my( $self ) = @_;
 114         return 9 if $self->get() =~ /^PC\/....\/..../;
 115         return 4 if $self->get() =~ /^PC\/..../;
 116         die "Can not happen\n";
 117 }
 118
 119 1;