289
my $db = $self->get('DB');
293
print "Writing ASCII database to $file..." if $self->get_conf('VERBOSE') >= 1;
294
CORE::open( F, ">$file" ) or
295
die "Can't open database $file: $!\n";
297
foreach $name ($self->list_packages()) {
298
my $pkg = $self->get_package($name);
299
foreach $key (keys %{$pkg}) {
300
my $val = $pkg->{$key};
303
print F "$key: $val\n";
308
foreach my $user ($self->list_users()) {
309
my $ui = $self->get_user($user);
310
print F "User: $user\n"
311
if (!defined($ui->{'User'}));
312
foreach $key (keys %{$ui}) {
313
my $val = $ui->{$key};
316
print F "$key: $val\n";
322
print "done\n" if $self->get_conf('VERBOSE') >= 1;
329
my $db = $self->get('DB');
331
print "Reading ASCII database from $file..." if $self->get_conf('VERBOSE') >= 1;
332
CORE::open( F, "<$file" ) or
333
die "Can't open database $file: $!\n";
335
local($/) = ""; # read in paragraph mode
337
my( %thispkg, $name );
339
s/\n[ \t]+/\376\377/g; # fix continuation lines
340
s/\376\377\s*\376\377/\376\377/og;
342
while( /^(\S+):[ \t]*(.*)[ \t]*$/mg ) {
343
my ($key, $val) = ($1, $2);
344
$val =~ s/\376\377/\n/g;
345
$thispkg{$key} = $val;
347
$self->check_entry( \%thispkg );
349
if (exists($thispkg{'Package'})) {
350
$self->set_package(\%thispkg);
351
} elsif(exists($thispkg{'User'})) {
352
$self->set_user(\%thispkg);
356
print "done\n" if $self->get_conf('VERBOSE') >= 1;
364
# TODO: Why should manual editing disable sanity checking?
365
return if $self->get_conf('DB_OPERATION') eq "manual-edit"; # no checks then
367
# check for required fields
368
if (!exists $pkg->{'Package'} && !exists $pkg->{'User'}) {
369
print STDERR "Bad entry: ",
370
join( "\n", map { "$_: $pkg->{$_}" } keys %$pkg ), "\n";
371
die "Database entry lacks Package or User: field\n";
374
if (exists $pkg->{'Package'}) {
375
if (!exists $pkg->{'Version'}) {
376
die "Database entry for package $pkg->{'Package'} lacks Version: field\n";
378
# if no State: field, generate one (for old db compat)
379
if (!exists($pkg->{'State'})) {
381
exists $pkg->{'Failed'} ? 'Failed' : 'Building';
384
die "Bad state $pkg->{'State'} of package $pkg->{Package}\n"
385
if !isin($pkg->{'State'},
386
qw(Needs-Build Building Built Build-Attempted
387
Uploaded Installed Dep-Wait Failed
388
Failed-Removed Not-For-Us) );
390
if (exists $pkg->{'User'}) {
391
if (!exists $pkg->{'Last-Seen'}) {
392
die "Database entry for user $pkg->{'User'} lacks Last-Seen: field\n";
398
286
my $self = shift;