lib/PXElator/server.pm

package server;

use warnings;
use strict;

our $base_dir = '/srv/pxelator';

tie our $ip,      'server::tie', 'server_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';
tie our $new_clients, 'server::tie', 'new_clients' => $ip_to - $ip_from;

warn "DEV $ip $bcast $netmask";

our $conf = "$base_dir/conf";
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 . '/conf/' . $name;

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