File Coverage

blib/lib/Tie/Sysctl.pm

Criterion	Covered	Total	%
statement	3	81	3.7
branch	0	28	0.0
condition	0	2	0.0
subroutine	1	11	9.0
pod	0	5	0.0
total	4	127	3.1

package Tie::Sysctl;

use base 'Tie::Hash';

our $VERSION = 0.05;

sub TIEHASH {
    my $cls = shift;
    my $self = {};
    if ($^O ne 'linux') { warn "try linux instead:)\n";return }
    $self->{node} = $_[0] || '/';
    $self->{basedir} = '/proc/sys';
    unless (-d $self->{basedir}) {
        warn "basedir $self->{basedir} not mounted\n";
        return;
    }
    bless $self => $cls;
}

sub FETCH {
    my $self = shift;
    my $key = shift;
    my @files = grep {$_ eq $key} $self->ls;
    unless (defined $files[0]) {
        return;
    }
    my $t = $self->type($key);
    unless (defined $t) {
        return;
    }
    if ($t eq 'file') {
        my $data = $self->rd($key);
        chomp($data);
        return $data;
    }
    my %h;
    tie %h, __PACKAGE__, $self->{node}.'/'.$key;
    \%h;
}

sub STORE {
    my $self = shift;
    my $key = shift;
    my $val = shift;
    unless ($self->type($key)eq'file') { return }
    $self->wrt($key,$val);
}

sub type {
    my $self = shift;
    if (-d $self->file(@_)) {
        return 'dir';
    }
    elsif (-f $self->file(@_)) {
        return 'file';
    }
    return;
}

sub file {
    my $self = shift;
    my $f = $self->{basedir}.$self->{node};
    if (@_) {
        map {$f .= '/'.$_} @_;
    }
    $f =~ s{//}{/}g;
    $f;
}

sub ls {
    my $self = shift;
    unless ($self->type eq 'dir') {
        return ();
    }
    opendir(DIR,$self->file);
    my @d = readdir(DIR);
    closedir(DIR);
    shift@d;shift@d;
    @d;
}

sub rd {
    my $self = shift;
    unless ($self->type(@_)eq'file') { return }
    open(DUS,$self->file(@_)) or return;
    my $d;
    while () { $d .= $_ }
    close DUS;
    $d;
}

sub wrt {
    my $self = shift;
    my $data = pop;
    my $f = $self->file(@_);
    unless ($self->type(@_)eq'file') { return }
    open(DUS,">".$self->file(@_))or return;
    my $ret = print DUS $data;
    close DUS;
    $ret;
}

sub FIRSTKEY {
    my $self = shift;
    $self->{_ls} = [$self->ls];
    $self->NEXTKEY;
}

sub NEXTKEY {
    my $self = shift;
    shift@{$self->{_ls}};
}

1;
__END__