Nous allons créer un répertoire DHCP, pour y mettre les définitions de classes. Ces fichiers auront pour extension .pm. Nous utiliserons use lib pour indiquer d'aller chercher les classes dans ce répertoire.
1: package DHCP::Host ; 2: 3: require Exporter ; 4: our @ISA = qw(Exporter); 5: our @EXPORT=qw() ; 6: 7: sub new 8: { 9: my($type,$key,$h) = @_ ; 10: my($this) ; 11: 12: $this->{"host"} = $key ; 13: $this->{"attr"} = $h ; 14: 15: bless $this,$type ; 16: 17: return $this ; 18: }
Remarques
new
est conventionnellement le constructeur (mais pourrait aussi bien s'appeler autrement)this
est une référence de hash, qui va devenir l'objet courant de type $type
après le bless
(en réalité, cela pourrait une référence de n'importe quoi, une référence de liste, par exemple)1: package DHCP::Database ; 2: 3: require Exporter ; 4: our @ISA = qw(Exporter); 5: our @EXPORT=qw() ; 6: 7: use Data::Dumper ; 8: use FileHandler ; 9: use strict ; 10: 11: sub new 12: { 13: my($type) = @_ ; 14: my($this) ; 15: 16: $this->{pattern} = {} ; 17: $this->{host} = () ; 18: 19: bless $this,$type ; 20: 21: return $this ; 22: } 23: 24: sub addPattern 25: { 26: my ($this,$key,$patt) = @_ ; 27: 28: $this->{pattern}{$key} = $patt ; 29: } 30: 31: sub load 32: { 33: my ($this,$filename) = @_ ; 34: 35: my $fh = new FileHandle($filename) or die $! ; 36: 37: my $lines ; 38: while (<$fh>) 39: { 40: chomp ; 41: s/#.*// ; 42: next unless /\S/ ; 43: 44: $lines .= $_ ; 45: } 46: $fh->close() ; 47: 48: my @lines = $lines=~/(host\s.*?})/g ; 49: my $info ; 50: for my $l (@lines) 51: { 52: my $item ; 53: 54: my ($host,$rest) = $l=~/host\s*(\S+)\s*\{\s*(.*?)\s*\}/ ; 55: 56: # recherche des pattern 57: my ($key,$re) ; 58: while (($key,$re)=each %{$this->{pattern}}) 59: { 60: if ($rest=~$re) 61: { 62: ($item->{$key}) = $rest=~/$re/ ; 63: $rest =~ s/$re// ; 64: } 65: } 66: 67: $host = new DHCP::Host($host,$item) ; 68: push(@{$this->{host}},$host) ; 69: } 70: } 71: 72: sub dump 73: { 74: my ($this) = @_ ; 75: 76: print Data::Dumper $this ; 77: } 78: 79: 1;
Remarques :
addPattern
, load
, dump
) ont un premier paramètre qui reçoit l'objet courant$this->{pattern}{$key}
c'est un hash à 2 niveaux, l'élément de clé pattern
est un hash dont on utilise ici l'élement de clé $key
1: #!/usr/bin/perl 2: 3: use lib "." ; 4: use DHCP::Host ; 5: use DHCP::Database ; 6: 7: use strict ; 8: 9: my $db = new DHCP::Database ; 10: 11: # ce qu'il faut extraire, et comment le faire 12: $db->addPattern("mac",qr/hardware\s+ethernet\s+(\S+?)\s*;/) ; 13: $db->addPattern("ip",qr/fixed-address\s+(\S+?)\s*;/) ; 14: 15: $db->load("dhcpd.conf") ; 16: $db->dump() ;
Remarques :
qr
permet de quoter les RE. Le caractère suivant est le déliminteur, et peut être n'importe quel caractèreq
(quote), qq
(guillemet), qw
(quote word) et qx
(quote execution)