view release on metacpan or  search on metacpan

FR/perltie.pod  view on Meta::CPAN

            $f, length $him{$f};
    }

Dans notre exemple de table de hachage liée DotFiles, nous utilisons une table
de hachage normale pour stocker dans l'objet plusieurs champs importants dont
le champ C<{LIST}> qui apparaît à l'utilisateur comme le contenu réel de la
table.

=over 5

=item USER

l'utilisateur pour lequel l'objet représente les fichiers .*

=item HOME

l'endroit où se trouve ces fichiers

=item CLOBBER

si nous pouvons essayer de modifier ou de supprimer ces fichiers.

=item LIST

la table de hachage des noms des fichiers .* et de leur contenu

=back

Voici le début de S<F<Dotfiles.pm> :>

    package DotFiles;
    use Carp;
    sub whowasi { (caller(1))[3] . '()' }
    my $DEBUG = 0;
    sub debug { $DEBUG = @_ ? shift : 1 }

Dans notre exemple, nous voulons avoir la possibilité d'émettre des
informations de debug pour aider au développement. Nous fournissons aussi une
fonction pratique pour aider à l'affichage des messages S<d'avertissements ;>
whowasi() retourne le nom de la fonction qui l'a appelé.

Voici les méthodes pour la table de hachage DotFiles.

=over 4

=item TIEHASH classname, LIST
X<TIEHASH>

C'est le constructeur de la classe. Cela signifie qu'il est supposé retourner
une référence bénie (par bless()) au travers de laquelle on peut accéder au
nouvel objet (probablement mais pas nécessairement une table de hachage
anonyme).

Voici le S<constructeur :>

    sub TIEHASH {
        my $self = shift;
        my $user = shift || $>;
        my $dotdir = shift || '';
        croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_;
        $user = getpwuid($user) if $user =~ /^\d+$/;
        my $dir = (getpwnam($user))[7]
                || croak "@{[&whowasi]}: no user $user";
        $dir .= "/$dotdir" if $dotdir;

        my $node = {
            USER    => $user,
            HOME    => $dir,
            LIST    => {},
            CLOBBER => 0,
        };

        opendir(DIR, $dir)
                || croak "@{[&whowasi]}: can't opendir $dir: $!";
        foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {
            $dot =~ s/^\.//;
            $node->{LIST}{$dot} = undef;
        }
        closedir DIR;
        return bless $node, $self;
    }

Il n'est pas inutile de préciser que, si vous voulez tester un fichier dont le
nom est produit par readdir, vous devez la précéder du nom du répertoire en
question. Sinon, puisque nous ne faisons pas de chdir() ici, il ne testera
sans doute pas le bon fichier.

=item FETCH this, key
X<FETCH>

Cette méthode est appelée à chaque fois qu'on accède (en lecture) à un élément
d'une table de hachage liée. Elle prend un argument en plus de sa propre
S<référence :> la clé d'accès à la valeur que l'on cherche à lire.

Voici le code FETCH pour notre exemple DotFiles.

    sub FETCH {
        carp &whowasi if $DEBUG;
        my $self = shift;
        my $dot = shift;
        my $dir = $self->{HOME};
        my $file = "$dir/.$dot";

        unless (exists $self->{LIST}->{$dot} || -f $file) {
            carp "@{[&whowasi]}: no $dot file" if $DEBUG;
            return undef;
        }

        if (defined $self->{LIST}->{$dot}) {
            return $self->{LIST}->{$dot};
        } else {
            return $self->{LIST}->{$dot} = `cat $dir/.$dot`;
        }
    }

C'est facile à écrire en lui faisant appeler la commande Unix cat(1) mais ce
serait probablement plus portable d'ouvrir le fichier manuellement (et
peut-être plus efficace). Bien sûr, puisque les fichiers .* sont un concept
Unix, nous ne sommes pas concernés.

=item STORE this, key, value