Fix warnings.
[build-farm.git] / hostdb.pm
1 #!/usr/bin/perl
2
3 # Samba.org buildfarm
4 # Copyright (C) 2008 Andrew Bartlett <abartlet@samba.org>
5 # Copyright (C) 2008 Jelmer Vernooij <jelmer@samba.org>
6 #   
7 # This program is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #   
12 # This program is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 # GNU General Public License for more details.
16 #   
17 # You should have received a copy of the GNU General Public License
18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
19 #
20
21 package hostdb;
22
23 use DBI;
24 use warnings;
25 use strict;
26
27 sub new($)
28  {
29     my ($class, $filename) = @_;
30     
31     my $dbh = DBI->connect("dbi:SQLite:$filename") or return undef;
32     
33     my $self = { filename => $filename, dbh => $dbh };
34     
35     bless($self, $class);
36 }
37
38 sub provision($)
39 {
40         my ($self) = @_;
41         
42         $self->{dbh}->do("CREATE TABLE host ( name text, owner text, owner_email text, password text, ssh_access int, fqdn text, platform text, permission text );");
43         
44         $self->{dbh}->do("CREATE UNIQUE INDEX unique_hostname ON host (name);");
45 }
46
47 sub createhost($$$$$$)
48 {
49         my ($self, $name, $platform, $owner, $owner_email, $password, $permission) = @_;
50         my $sth = $self->{dbh}->prepare("INSERT INTO host (name, platform, owner, owner_email, password, permission) VALUES (?,?,?,?,?,?)");
51         
52         $sth->execute($name, $platform, $owner, $owner_email, $password, $permission);
53 }
54
55 sub deletehost($$)
56 {
57         my ($self, $name) = @_;
58         
59         my $sth = $self->{dbh}->prepare("DELETE FROM host WHERE name = ?");
60         
61         my $ret = $sth->execute($name);
62         
63         return ($ret == 1);
64 }
65
66 sub hosts($)
67 {
68         my ($self) = @_;
69         
70         return $self->{dbh}->selectall_arrayref("SELECT * FROM host", { Slice => {} });
71 }
72
73 sub host($$)
74 {
75         my ($self, $name) = @_;
76         
77         my $hosts = $self->hosts();
78         
79         foreach (@$hosts) {
80                 return $_ if ($_->{name} eq $name);
81         }
82         
83         return undef;
84 }
85
86 sub update_platform($$$)
87 {
88         my ($self, $name, $new_platform) = @_;
89         
90         my $changed = $self->{dbh}->do("UPDATE host SET platform = ? WHERE name = ?", undef, 
91                 ($new_platform, $name));
92         
93         return ($changed == 1);
94 }
95
96 sub update_owner($$$$)
97 {
98         my ($self, $name, $new_owner, $new_owner_email) = @_;
99         
100         my $changed = $self->{dbh}->do("UPDATE host SET owner = ?, owner_email = ? WHERE name = ?", 
101                                        undef, ($new_owner, $new_owner_email, $name));
102         
103         return ($changed == 1);
104 }
105
106 # Write out the rsyncd.secrets
107 sub create_rsync_secrets($)
108 {
109         my ($db) = @_;
110         
111         my $hosts = $db->hosts();
112         
113         my $res = "";
114         
115         $res .= "# rsyncd.secrets file\n";
116         $res .= "# automatically generated by textfiles.pl. DO NOT EDIT!\n\n";
117         
118         foreach (@$hosts) {
119                 $res .= "# $_->{name}, owner: $_->{owner} <$_->{owner_email}>\n";
120                 $res .= "$_->{name}:$_->{password}\n\n";
121         }
122         
123         return $res;
124 }
125
126 # Write out the web/
127 sub create_hosts_list($)
128 {
129         my ($self) = @_;
130         
131         my $res = ""; 
132         
133         my $hosts = $self->hosts();
134         
135         foreach (@$hosts) {
136                 $res .= "$_->{name}: $_->{platform}\n";
137         }
138         
139         return $res;
140 }
141
142 1;