← Back to branch summary

~ubuntu-branches/ubuntu/quantal/devscripts/quantal

« back to all changes in this revision

Viewing changes to scripts/debdiff.pl

  • Committer: Package Import Robot
  • Author(s): James McCoy, James McCoy, Benjamin Drung
  • Date: 2012-09-24 18:51:12 UTC
  • mfrom: (10.9.19 sid)
  • Revision ID: package-import@ubuntu.com-20120924185112-vjdvq95n3g6cqio2
Tags: 2.12.4
http://bugs.debian.org/687670
http://bugs.debian.org/687964
http://bugs.debian.org/688150
http://bugs.debian.org/687452
[ James McCoy ]
* dget: Avoid an infinite loop when a .changes/.dsc file references itself.
  (Closes: #687670)
* debdiff:
  + Set $TMPDIR when running interdiff so its temp files get cleaned up on
    exit.
  + Fallback to manual diff of source package if interdiff fails.  (Closes:
    #685202)
* dcmd: Don't add "--" to the command being executed.  The user has to know
  where this should be used/if it can be used.  (Closes: #687964)
* debcheckout: Fix collision in short options.  Use -P for --package.
  (Closes: #688150)

[ Benjamin Drung ]
* licensecheck: Recognize licenses in (fixed-form) Fortran code. Thanks to
  Francesco Poli for the patch and the example. (Closes: #687452)

Show diffs side-by-side

added added

removed removed

Lines of Context:
scripts/debdiff.pl
21
21
use Dpkg::Compression;
22
22
use File::Copy qw(cp move);
23
23
use File::Basename;
 
24
use File::Spec;
24
25
use File::Path qw/ rmtree /;
25
26
use File::Temp qw/ tempdir tempfile /;
26
27
use lib '/usr/share/devscripts';
544
545
        and scalar(@excludes) == 0 and $use_interdiff and !$wdiff_source_control) {
545
546
        # same orig tar ball, interdiff exists and not wdiffing
546
547
 
547
 
        spawn(exec => ['interdiff', '-z', @diff_opts, $diffs[1], $diffs[2]],
548
 
              to_file => $filename,
549
 
              wait_child => 1);
550
 
        if ($have_diffstat and $show_diffstat) {
551
 
            my $header = "diffstat for " . basename($diffs[1])
552
 
                            . " " . basename($diffs[2]) . "\n\n";
553
 
            $header =~ s/\.diff\.gz//g;
554
 
            print $header;
555
 
            spawn(exec => ['diffstat', $filename],
556
 
                wait_child => 1);
557
 
            print "\n";
558
 
        }
559
 
 
560
 
        if (-s $filename) {
561
 
            open( INTERDIFF, '<', $filename );
562
 
            while( <INTERDIFF> ) {
563
 
                print $_;
564
 
            }
565
 
            close INTERDIFF;
566
 
 
567
 
            $exit_status = 1;
568
 
        }
569
 
    } else {
570
 
        # Any other situation
571
 
        if ($origs[1] eq $origs[2] and
572
 
            defined $diffs[1] and defined $diffs[2] and
573
 
            scalar(@excludes) == 0 and !$wdiff_source_control) {
574
 
            warn "Warning: You do not seem to have interdiff (in the patchutils package)\ninstalled; this program would use it if it were available.\n";
575
 
        }
576
 
        # possibly different orig tarballs, or no interdiff installed,
577
 
        # or wdiffing debian/control
578
 
        our ($sdir1, $sdir2);
 
548
        my $tmpdir = tempdir(CLEANUP => 1);
 
549
        eval {
 
550
            spawn(exec => ['interdiff', '-z', @diff_opts, $diffs[1], $diffs[2]],
 
551
                  to_file => $filename,
 
552
                  wait_child => 1,
 
553
                  # Make interdiff put its tempfiles in $tmpdir, so they're
 
554
                  # automatically cleaned up
 
555
                  env => { TMPDIR => $tmpdir });
 
556
        };
 
557
 
 
558
        # If interdiff fails for some reason, we'll fall back to our manual
 
559
        # diffing.
 
560
        unless ($@) {
 
561
            if ($have_diffstat and $show_diffstat) {
 
562
                my $header = "diffstat for " . basename($diffs[1])
 
563
                                . " " . basename($diffs[2]) . "\n\n";
 
564
                $header =~ s/\.diff\.gz//g;
 
565
                print $header;
 
566
                spawn(exec => ['diffstat', $filename],
 
567
                    wait_child => 1);
 
568
                print "\n";
 
569
            }
 
570
 
 
571
            if (-s $filename) {
 
572
                open( INTERDIFF, '<', $filename );
 
573
                while( <INTERDIFF> ) {
 
574
                    print $_;
 
575
                }
 
576
                close INTERDIFF;
 
577
 
 
578
                $exit_status = 1;
 
579
            }
 
580
            exit $exit_status;
 
581
        }
 
582
    }
 
583
 
 
584
    # interdiff ran and failed, or any other situation
 
585
    if (!$use_interdiff) {
 
586
        warn "Warning: You do not seem to have interdiff (in the patchutils package)\ninstalled; this program would use it if it were available.\n";
 
587
    }
 
588
    # possibly different orig tarballs, or no interdiff installed,
 
589
    # or wdiffing debian/control
 
590
    our ($sdir1, $sdir2);
 
591
    mktmpdirs();
 
592
    for my $i (1,2) {
 
593
        no strict 'refs';
 
594
        my @opts = ('-x');
 
595
        push (@opts, '--skip-patches') if $dscformats[$i] eq '3.0 (quilt)';
 
596
        my $diri = ${"dir$i"};
 
597
        eval {
 
598
            spawn(exec => ['dpkg-source', @opts, $dscs[$i]],
 
599
                  to_file => '/dev/null',
 
600
                  chdir => $diri,
 
601
                  wait_child => 1);
 
602
        };
 
603
        if ($@) {
 
604
            my $dir = dirname $dscs[1] if $i == 2;
 
605
            $dir = dirname $dscs[2] if $i == 1;
 
606
            cp "$dir/$origs[$i]", $diri || fatal "copy $dir/$origs[$i] $diri: $!";
 
607
            my $dscx = basename $dscs[$i];
 
608
            cp $diffs[$i], $diri || fatal "copy $diffs[$i] $diri: $!";
 
609
            cp $dscs[$i], $diri || fatal "copy $dscs[$i] $diri: $!";
 
610
            spawn(exec => ['dpkg-source', @opts, $dscx],
 
611
                  to_file => '/dev/null',
 
612
                  chdir => $diri,
 
613
                  wait_child => 1);
 
614
        }
 
615
        opendir DIR,$diri;
 
616
        while ($_ = readdir(DIR)) {
 
617
            next if $_ eq '.' || $_ eq '..' || ! -d "$diri/$_";
 
618
            ${"sdir$i"} = $_;
 
619
            last;
 
620
        }
 
621
        closedir(DIR);
 
622
        my $sdiri = ${"sdir$i"};
 
623
 
 
624
        # also unpack tarballs found in the top level source directory so we can compare their contents too
 
625
        next unless $unpack_tarballs;
 
626
        opendir DIR,$diri.'/'.$sdiri;
 
627
 
 
628
        my $tarballs = 1;
 
629
        while ($_ = readdir(DIR)) {
 
630
                my $unpacked = "=unpacked-tar" . $tarballs . "=";
 
631
                my $filename = $_;
 
632
                if ($filename =~ s/\.tar\.$compression_re_file_ext$//) {
 
633
                    my $comp = compression_guess_from_filename($_);
 
634
                    $tarballs++;
 
635
                    spawn(exec => ['tar', "--$comp", '-xf', $_],
 
636
                          to_file => '/dev/null',
 
637
                          wait_child => 1,
 
638
                          chdir => "$diri/$sdiri",
 
639
                          nocheck => 1);
 
640
                    if (-d "$diri/$sdiri/$filename") {
 
641
                        move "$diri/$sdiri/$filename", "$diri/$sdiri/$unpacked";
 
642
                    }
 
643
                }
 
644
        }
 
645
        closedir(DIR);
 
646
    }
 
647
 
 
648
    my @command = ("diff", "-Nru", @diff_opts);
 
649
    for my $exclude (@excludes) {
 
650
        push @command, ("--exclude", $exclude);
 
651
    }
 
652
    push @command, ("$dir1/$sdir1", "$dir2/$sdir2");
 
653
 
 
654
    # Execute diff and remove the common prefixes $dir1/$dir2, so the patch can be used with -p1,
 
655
    # as if when interdiff would have been used:
 
656
    spawn(exec => \@command, to_file => $filename, wait_child => 1, nocheck => 1);
 
657
 
 
658
    if ($have_diffstat and $show_diffstat) {
 
659
        print "diffstat for $sdir1 $sdir2\n\n";
 
660
        spawn(exec => ['diffstat', $filename],
 
661
            wait_child => 1);
 
662
        print "\n";
 
663
    }
 
664
 
 
665
    if ($have_wdiff and $wdiff_source_control) {
 
666
        # Abuse global variables slightly to create some temporary directories
 
667
        my $tempdir1 = $dir1;
 
668
        my $tempdir2 = $dir2;
579
669
        mktmpdirs();
 
670
        our $wdiffdir1 = $dir1;
 
671
        our $wdiffdir2 = $dir2;
 
672
        $dir1 = $tempdir1;
 
673
        $dir2 = $tempdir2;
 
674
        our @cf;
 
675
        if ($controlfiles eq 'ALL') {
 
676
            @cf = ('control');
 
677
        } else {
 
678
            @cf = split /,/, $controlfiles;
 
679
        }
 
680
 
 
681
        no strict 'refs';
580
682
        for my $i (1,2) {
581
 
            no strict 'refs';
582
 
            my @opts = ('-x');
583
 
            push (@opts, '--skip-patches') if $dscformats[$i] eq '3.0 (quilt)';
584
 
            my $diri = ${"dir$i"};
585
 
            eval {
586
 
                spawn(exec => ['dpkg-source', @opts, $dscs[$i]],
587
 
                      to_file => '/dev/null',
588
 
                      chdir => $diri,
589
 
                      wait_child => 1);
590
 
            };
591
 
            if ($@) {
592
 
                my $dir = dirname $dscs[1] if $i == 2;
593
 
                $dir = dirname $dscs[2] if $i == 1;
594
 
                cp "$dir/$origs[$i]", $diri || fatal "copy $dir/$origs[$i] $diri: $!";
595
 
                my $dscx = basename $dscs[$i];
596
 
                cp $diffs[$i], $diri || fatal "copy $diffs[$i] $diri: $!";
597
 
                cp $dscs[$i], $diri || fatal "copy $dscs[$i] $diri: $!";
598
 
                spawn(exec => ['dpkg-source', @opts, $dscx],
599
 
                      to_file => '/dev/null',
600
 
                      chdir => $diri,
601
 
                      wait_child => 1);
602
 
            }
603
 
            opendir DIR,$diri;
604
 
            while ($_ = readdir(DIR)) {
605
 
                next if $_ eq '.' || $_ eq '..' || ! -d "$diri/$_";
606
 
                ${"sdir$i"} = $_;
607
 
                last;
608
 
            }
609
 
            closedir(DIR);
610
 
            my $sdiri = ${"sdir$i"};
611
 
 
612
 
            # also unpack tarballs found in the top level source directory so we can compare their contents too
613
 
            next unless $unpack_tarballs;
614
 
            opendir DIR,$diri.'/'.$sdiri;
615
 
 
616
 
            my $tarballs = 1;
617
 
            while ($_ = readdir(DIR)) {
618
 
                    my $unpacked = "=unpacked-tar" . $tarballs . "=";
619
 
                    my $filename = $_;
620
 
                    if ($filename =~ s/\.tar\.$compression_re_file_ext$//) {
621
 
                        my $comp = compression_guess_from_filename($_);
622
 
                        $tarballs++;
623
 
                        spawn(exec => ['tar', "--$comp", '-xf', $_],
624
 
                              to_file => '/dev/null',
625
 
                              wait_child => 1,
626
 
                              chdir => "$diri/$sdiri",
627
 
                              nocheck => 1);
628
 
                        if (-d "$diri/$sdiri/$filename") {
629
 
                            move "$diri/$sdiri/$filename", "$diri/$sdiri/$unpacked";
630
 
                        }
631
 
                    }
632
 
            }
633
 
            closedir(DIR);
634
 
        }
635
 
 
636
 
        my @command = ("diff", "-Nru", @diff_opts);
637
 
        for my $exclude (@excludes) {
638
 
            push @command, ("--exclude", $exclude);
639
 
        }
640
 
        push @command, ("$dir1/$sdir1", "$dir2/$sdir2");
641
 
 
642
 
        # Execute diff and remove the common prefixes $dir1/$dir2, so the patch can be used with -p1,
643
 
        # as if when interdiff would have been used:
644
 
        spawn(exec => \@command, to_file => $filename, wait_child => 1, nocheck => 1);
645
 
 
646
 
        if ($have_diffstat and $show_diffstat) {
647
 
            print "diffstat for $sdir1 $sdir2\n\n";
648
 
            spawn(exec => ['diffstat', $filename],
649
 
                wait_child => 1);
650
 
            print "\n";
651
 
        }
652
 
 
653
 
        if ($have_wdiff and $wdiff_source_control) {
654
 
            # Abuse global variables slightly to create some temporary directories
655
 
            my $tempdir1 = $dir1;
656
 
            my $tempdir2 = $dir2;
657
 
            mktmpdirs();
658
 
            our $wdiffdir1 = $dir1;
659
 
            our $wdiffdir2 = $dir2;
660
 
            $dir1 = $tempdir1;
661
 
            $dir2 = $tempdir2;
662
 
            our @cf;
663
 
            if ($controlfiles eq 'ALL') {
664
 
                @cf = ('control');
665
 
            } else {
666
 
                @cf = split /,/, $controlfiles;
667
 
            }
668
 
 
669
 
            no strict 'refs';
670
 
            for my $i (1,2) {
671
 
                foreach my $file (@cf) {
672
 
                    cp ${"dir$i"}.'/'.${"sdir$i"}."/debian/$file", ${"wdiffdir$i"};
673
 
                }
674
 
            }
675
 
            use strict 'refs';
676
 
 
677
 
            # We don't support "ALL" for source packages as that would
678
 
            # wdiff debian/*
679
 
            $exit_status = wdiff_control_files($wdiffdir1, $wdiffdir2, $dummyname,
680
 
                $controlfiles eq 'ALL' ? 'control' : $controlfiles,
681
 
                $exit_status);
682
 
            print "\n";
683
 
 
684
 
            # Clean up
685
 
            rmtree([$wdiffdir1, $wdiffdir2]);
686
 
        }
687
 
 
688
 
        if (! -f $filename) {
689
 
            fatal "Creation of diff file $filename failed!";
690
 
        } elsif (-s $filename) {
691
 
            open( DIFF, '<', $filename ) or fatal "Opening diff file $filename failed!";
692
 
 
693
 
            while(<DIFF>) {
694
 
                s/^--- $dir1\//--- /;
695
 
                s/^\+\+\+ $dir2\//+++ /;
696
 
                s/^(diff .*) $dir1\/\Q$sdir1\E/$1 $sdir1/;
697
 
                s/^(diff .*) $dir2\/\Q$sdir2\E/$1 $sdir2/;
698
 
                print;
699
 
            }
700
 
            close DIFF;
701
 
 
702
 
            $exit_status = 1;
703
 
        }
 
683
            foreach my $file (@cf) {
 
684
                cp ${"dir$i"}.'/'.${"sdir$i"}."/debian/$file", ${"wdiffdir$i"};
 
685
            }
 
686
        }
 
687
        use strict 'refs';
 
688
 
 
689
        # We don't support "ALL" for source packages as that would
 
690
        # wdiff debian/*
 
691
        $exit_status = wdiff_control_files($wdiffdir1, $wdiffdir2, $dummyname,
 
692
            $controlfiles eq 'ALL' ? 'control' : $controlfiles,
 
693
            $exit_status);
 
694
        print "\n";
 
695
 
 
696
        # Clean up
 
697
        rmtree([$wdiffdir1, $wdiffdir2]);
 
698
    }
 
699
 
 
700
    if (! -f $filename) {
 
701
        fatal "Creation of diff file $filename failed!";
 
702
    } elsif (-s $filename) {
 
703
        open( DIFF, '<', $filename ) or fatal "Opening diff file $filename failed!";
 
704
 
 
705
        while(<DIFF>) {
 
706
            s/^--- $dir1\//--- /;
 
707
            s/^\+\+\+ $dir2\//+++ /;
 
708
            s/^(diff .*) $dir1\/\Q$sdir1\E/$1 $sdir1/;
 
709
            s/^(diff .*) $dir2\/\Q$sdir2\E/$1 $sdir2/;
 
710
            print;
 
711
        }
 
712
        close DIFF;
 
713
 
 
714
        $exit_status = 1;
704
715
    }
705
716
 
706
717
    exit $exit_status;