~ubuntu-branches/ubuntu/lucid/sbuild/lucid

« back to all changes in this revision

Viewing changes to lib/Sbuild/DB/MLDBM.pm

  • Committer: Bazaar Package Importer
  • Author(s): Bhavani Shankar
  • Date: 2009-08-03 19:35:15 UTC
  • mfrom: (8.1.11 upstream) (3.3.2 sid)
  • Revision ID: james.westby@ubuntu.com-20090803193515-mi2b8xkpf0w3qr62
Tags: 0.59.0-1ubuntu1
* Merge from debian unstable, remaining changes: LP: #408390
  - Do not install debfoster into the chroots because it is in universe
    and not needed for package building itself.
* Modify Maintainer value to match the DebianMaintainerField
  specification.

Show diffs side-by-side

added added

removed removed

Lines of Context:
282
282
    return $success
283
283
}
284
284
 
285
 
sub dump {
286
 
    my $self = shift;
287
 
    my $file = shift;
288
 
 
289
 
    my $db = $self->get('DB');
290
 
 
291
 
    my($name,$pkg,$key);
292
 
 
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";
296
 
 
297
 
    foreach $name ($self->list_packages()) {
298
 
        my $pkg = $self->get_package($name);
299
 
        foreach $key (keys %{$pkg}) {
300
 
            my $val = $pkg->{$key};
301
 
            chomp( $val );
302
 
            $val =~ s/\n/\n /g;
303
 
            print F "$key: $val\n";
304
 
        }
305
 
        print F "\n";
306
 
    }
307
 
 
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};
314
 
            chomp($val);
315
 
            $val =~ s/\n/\n /g;
316
 
            print F "$key: $val\n";
317
 
        }
318
 
        print F "\n";
319
 
    }
320
 
 
321
 
    CORE::close(F);
322
 
    print "done\n" if $self->get_conf('VERBOSE') >= 1;
323
 
}
324
 
 
325
 
sub restore {
326
 
    my $self = shift;
327
 
    my $file = shift;
328
 
 
329
 
    my $db = $self->get('DB');
330
 
 
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";
334
 
 
335
 
    local($/) = ""; # read in paragraph mode
336
 
    while( <F> ) {
337
 
        my( %thispkg, $name );
338
 
        s/[\s\n]+$//;
339
 
        s/\n[ \t]+/\376\377/g;  # fix continuation lines
340
 
        s/\376\377\s*\376\377/\376\377/og;
341
 
 
342
 
        while( /^(\S+):[ \t]*(.*)[ \t]*$/mg ) {
343
 
            my ($key, $val) = ($1, $2);
344
 
            $val =~ s/\376\377/\n/g;
345
 
            $thispkg{$key} = $val;
346
 
        }
347
 
        $self->check_entry( \%thispkg );
348
 
        # add to db
349
 
        if (exists($thispkg{'Package'})) {
350
 
            $self->set_package(\%thispkg);
351
 
        } elsif(exists($thispkg{'User'})) {
352
 
            $self->set_user(\%thispkg);
353
 
        }
354
 
    }
355
 
    CORE::close( F );
356
 
    print "done\n" if $self->get_conf('VERBOSE') >= 1;
357
 
}
358
 
 
359
 
sub check_entry {
360
 
    my $self = shift;
361
 
    my $pkg = shift;
362
 
    my $field;
363
 
 
364
 
    # TODO: Why should manual editing disable sanity checking?
365
 
    return if $self->get_conf('DB_OPERATION') eq "manual-edit"; # no checks then
366
 
 
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";
372
 
    }
373
 
 
374
 
    if (exists $pkg->{'Package'}) {
375
 
        if (!exists $pkg->{'Version'}) {
376
 
            die "Database entry for package $pkg->{'Package'} lacks Version: field\n";
377
 
        }
378
 
        # if no State: field, generate one (for old db compat)
379
 
        if (!exists($pkg->{'State'})) {
380
 
            $pkg->{'State'} =
381
 
                exists $pkg->{'Failed'} ? 'Failed' : 'Building';
382
 
        }
383
 
        # check state field
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) );
389
 
    }
390
 
    if (exists $pkg->{'User'}) {
391
 
        if (!exists $pkg->{'Last-Seen'}) {
392
 
            die "Database entry for user $pkg->{'User'} lacks Last-Seen: field\n";
393
 
        }
394
 
    }
395
 
}
396
 
 
397
285
sub clean {
398
286
    my $self = shift;
399
287