2
# Base.pm: Base class for database abstraction
3
# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
4
# Copyright © 2005 Ryan Murray <rmurray@debian.org>
5
# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org>
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 2 of the License, or
10
# (at your option) any later version.
12
# This program is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15
# General Public License for more details.
17
# You should have received a copy of the GNU General Public License
18
# along with this program. If not, see
19
# <http://www.gnu.org/licenses/>.
21
#######################################################################
23
package Sbuild::DB::Base;
28
use Sbuild qw(debug isin);
35
@ISA = qw(Exporter Sbuild::Base);
44
my $db = $self->get('DB');
48
print "Writing ASCII database to $file..." if $self->get_conf('VERBOSE') >= 1;
49
CORE::open( F, ">$file" ) or
50
die "Can't open database $file: $!\n";
52
foreach $name ($self->list_packages()) {
53
my $pkg = $self->get_package($name);
54
foreach $key (keys %{$pkg}) {
55
my $val = $pkg->{$key};
58
print F "$key: $val\n";
63
foreach my $user ($self->list_users()) {
64
my $ui = $self->get_user($user);
65
print F "User: $user\n"
66
if (!defined($ui->{'User'}));
67
foreach $key (keys %{$ui}) {
68
my $val = $ui->{$key};
71
print F "$key: $val\n";
77
print "done\n" if $self->get_conf('VERBOSE') >= 1;
84
my $db = $self->get('DB');
86
print "Reading ASCII database from $file..." if $self->get_conf('VERBOSE') >= 1;
87
CORE::open( F, "<$file" ) or
88
die "Can't open database $file: $!\n";
90
local($/) = ""; # read in paragraph mode
92
my( %thispkg, $name );
94
s/\n[ \t]+/\376\377/g; # fix continuation lines
95
s/\376\377\s*\376\377/\376\377/og;
97
while( /^(\S+):[ \t]*(.*)[ \t]*$/mg ) {
98
my ($key, $val) = ($1, $2);
99
$val =~ s/\376\377/\n/g;
100
$thispkg{$key} = $val;
102
$self->check_entry( \%thispkg );
104
if (exists($thispkg{'Package'})) {
105
$self->set_package(\%thispkg);
106
} elsif(exists($thispkg{'User'})) {
107
$self->set_user(\%thispkg);
111
print "done\n" if $self->get_conf('VERBOSE') >= 1;
119
# TODO: Why should manual editing disable sanity checking?
120
return if $self->get_conf('DB_OPERATION') eq "manual-edit"; # no checks then
122
# check for required fields
123
if (!exists $pkg->{'Package'} && !exists $pkg->{'User'}) {
124
print STDERR "Bad entry: ",
125
join( "\n", map { "$_: $pkg->{$_}" } keys %$pkg ), "\n";
126
die "Database entry lacks Package or User: field\n";
129
if (exists $pkg->{'Package'}) {
130
if (!exists $pkg->{'Version'}) {
131
die "Database entry for package $pkg->{'Package'} lacks Version: field\n";
133
# if no State: field, generate one (for old db compat)
134
if (!exists($pkg->{'State'})) {
136
exists $pkg->{'Failed'} ? 'Failed' : 'Building';
139
die "Bad state $pkg->{'State'} of package $pkg->{Package}\n"
140
if !isin($pkg->{'State'},
141
qw(Needs-Build Building Built Build-Attempted
142
Uploaded Installed Dep-Wait Failed
143
Failed-Removed Not-For-Us) );
145
if (exists $pkg->{'User'}) {
146
if (!exists $pkg->{'Last-Seen'}) {
147
die "Database entry for user $pkg->{'User'} lacks Last-Seen: field\n";