0a0455d8e762304b4f45f334c4f367cc6a6dc353
[pxelator] / lib / PXElator / server.pm
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
15 warn "DEV $ip $bcast $netmask";
16
17 our $conf = "$base_dir/conf";
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 . '/conf/' . $name;
71
72         my $o = {
73                 path => $path,
74         };
75         write_file $o->{path}, $default unless -f $o->{path};
76
77 warn "TIESCALAR $name ", $o->{path}, " [$default]";
78
79         bless \$o,$class;
80 }
81
82 sub STORE {
83         warn dump @_;
84         my ( $self, $value ) = @_;
85         write_file $$self->{path}, $value;
86 }
87
88 sub FETCH {
89         warn dump @_;
90         my $self = shift;
91         read_file $$self->{path};
92 }
93
94 3;