lib/PXElator/server.pm

package server;

use warnings;
use strict;

our $base_dir = '/srv/pxelator';

tie our $ip,      'server::tie', 'ip'      => '172.16.10.1';
tie our $netmask, 'server::tie', 'natmask' => '255.255.255.0';
tie our $bcast,   'server::tie', 'bcast'   => '172.16.10.254';
tie our $ip_from, 'server::tie', 'ip_from' => 10;
tie our $ip_to,   'server::tie', 'ip_to'   => 100;
tie our $domain,  'server::tie', 'domain'  => 'pxelator.lan';

warn "DEV $ip $bcast $netmask";

our $conf = "$base_dir/conf/$ip";
mkdir $conf unless -e $conf;

sub conf {
        warn "## conf $conf";
        $conf;
}

use Module::Refresh qw//;
sub refresh {
        Module::Refresh->refresh;
        my $from = (caller(1))[3];
        $from =~ s{^(\w+)::.+$}{$1};
        my $eval = '$' . $from . '::debug = server::debug();';
        warn "refresh $eval\n";
        eval $eval;
        warn $@ if $@;
};

mkdir $_ foreach grep { ! -d $_ } map { "$conf/$_" } ( 'ip', 'mac' );

use File::Slurp;
sub shared {
        my ($name, $value) = @_;

        my $path ="$conf/$name";
        if ( defined $value ) {
                write_file $path, $value;
                warn "update $path = $value";
        } else {
                $value = read_file $path if -e $path;
        }
        return $value;
}

sub conf_default { shared($_[0]) || $_[1] }

sub debug { shared('debug', @_) || 0 }

warn "loaded";


package server::tie;

use File::Slurp;
use Data::Dump qw/dump/;

use server;

sub TIESCALAR {
        warn dump @_;
        my ($class,$name,$default) = @_;

        my $path = $server::base_dir;
        if ( $name eq 'ip' ) {
                $path .= '/conf/' . $ip;
        } else {
                $path .= '/conf/' . $server::ip;
        }

        my $o = {
                path => "$path/$name",
        };
        write_file $o->{path}, $default unless -f $o->{path};

warn "TIESCALAR $name ", $o->{path}, " [$default]";

        bless \$o,$class;
}

sub STORE {
        warn dump @_;
        my ( $self, $value ) = @_;
        write_file $$self->{path}, $value;
}

sub FETCH {
        warn dump @_;
        my $self = shift;
        read_file $$self->{path};
}

3;
1	package server;
2
3	use warnings;
4	use strict;
5
6	our $base_dir = '/srv/pxelator';
7
8	tie our $ip, 'server::tie', 'ip' => '172.16.10.1';
9	tie our $netmask, 'server::tie', 'natmask' => '255.255.255.0';
10	tie our $bcast, 'server::tie', 'bcast' => '172.16.10.254';
11	tie our $ip_from, 'server::tie', 'ip_from' => 10;
12	tie our $ip_to, 'server::tie', 'ip_to' => 100;
13	tie our $domain, 'server::tie', 'domain' => 'pxelator.lan';
14
15	warn "DEV $ip $bcast $netmask";
16
17	our $conf = "$base_dir/conf/$ip";
18	mkdir $conf unless -e $conf;
19
20	sub conf {
21	warn "## conf $conf";
22	$conf;
23	}
24
25	use Module::Refresh qw//;
26	sub refresh {
27	Module::Refresh->refresh;
28	my $from = (caller(1))[3];
29	$from =~ s{^(\w+)::.+$}{$1};
30	my $eval = '$' . $from . '::debug = server::debug();';
31	warn "refresh $eval\n";
32	eval $eval;
33	warn $@ if $@;
34	};
35
36	mkdir $_ foreach grep { ! -d $_ } map { "$conf/$_" } ( 'ip', 'mac' );
37
38	use File::Slurp;
39	sub shared {
40	my ($name, $value) = @_;
41
42	my $path ="$conf/$name";
43	if ( defined $value ) {
44	write_file $path, $value;
45	warn "update $path = $value";
46	} else {
47	$value = read_file $path if -e $path;
48	}
49	return $value;
50	}
51
52	sub conf_default { shared($_[0]) \|\| $_[1] }
53
54	sub debug { shared('debug', @_) \|\| 0 }
55
56	warn "loaded";
57
58
59	package server::tie;
60
61	use File::Slurp;
62	use Data::Dump qw/dump/;
63
64	use server;
65
66	sub TIESCALAR {
67	warn dump @_;
68	my ($class,$name,$default) = @_;
69
70	my $path = $server::base_dir;
71	if ( $name eq 'ip' ) {
72	$path .= '/conf/' . $ip;
73	} else {
74	$path .= '/conf/' . $server::ip;
75	}
76
77	my $o = {
78	path => "$path/$name",
79	};
80	write_file $o->{path}, $default unless -f $o->{path};
81
82	warn "TIESCALAR $name ", $o->{path}, " [$default]";
83
84	bless \$o,$class;
85	}
86
87	sub STORE {
88	warn dump @_;
89	my ( $self, $value ) = @_;
90	write_file $$self->{path}, $value;
91	}
92
93	sub FETCH {
94	warn dump @_;
95	my $self = shift;
96	read_file $$self->{path};
97	}
98
99	3;