@@ -1178,7 +1178,7 @@ sub find_parent_branch {
1178
1178
or die " SVN connection failed somewhere...\n " ;
1179
1179
}
1180
1180
print STDERR " Successfully followed parent\n " unless $: :_q > 1;
1181
- return $self -> make_log_entry($rev , [$parent ], $ed );
1181
+ return $self -> make_log_entry($rev , [$parent ], $ed , $r0 , $branch_from );
1182
1182
}
1183
1183
return undef ;
1184
1184
}
@@ -1210,7 +1210,7 @@ sub do_fetch {
1210
1210
unless ($self -> ra-> gs_do_update($last_rev , $rev , $self , $ed )) {
1211
1211
die " SVN connection failed somewhere...\n " ;
1212
1212
}
1213
- $self -> make_log_entry($rev , \@parents , $ed );
1213
+ $self -> make_log_entry($rev , \@parents , $ed , $last_rev , $self -> path );
1214
1214
}
1215
1215
1216
1216
sub mkemptydirs {
@@ -1433,7 +1433,7 @@ sub check_author {
1433
1433
}
1434
1434
1435
1435
sub find_extra_svk_parents {
1436
- my ($self , $ed , $ tickets , $parents ) = @_ ;
1436
+ my ($self , $tickets , $parents ) = @_ ;
1437
1437
# aha! svk:merge property changed...
1438
1438
my @tickets = split " \n " , $tickets ;
1439
1439
my @known_parents ;
@@ -1478,9 +1478,9 @@ sub find_extra_svk_parents {
1478
1478
sub lookup_svn_merge {
1479
1479
my $uuid = shift ;
1480
1480
my $url = shift ;
1481
- my $merge = shift ;
1481
+ my $source = shift ;
1482
+ my $revs = shift ;
1482
1483
1483
- my ($source , $revs ) = split " :" , $merge ;
1484
1484
my $path = $source ;
1485
1485
$path =~ s { ^/} {} ;
1486
1486
my $gs = Git::SVN-> find_by_url($url .$source , $url , $path );
@@ -1537,7 +1537,7 @@ sub _rev_list {
1537
1537
@rv ;
1538
1538
}
1539
1539
1540
- sub check_cherry_pick {
1540
+ sub check_cherry_pick2 {
1541
1541
my $base = shift ;
1542
1542
my $tip = shift ;
1543
1543
my $parents = shift ;
@@ -1552,7 +1552,8 @@ sub check_cherry_pick {
1552
1552
delete $commits {$commit };
1553
1553
}
1554
1554
}
1555
- return (keys %commits );
1555
+ my @k = (keys %commits );
1556
+ return (scalar @k , $k [0]);
1556
1557
}
1557
1558
1558
1559
sub has_no_changes {
@@ -1597,9 +1598,8 @@ sub tie_for_persistent_memoization {
1597
1598
mkpath([$cache_path ]) unless -d $cache_path ;
1598
1599
1599
1600
my %lookup_svn_merge_cache ;
1600
- my %check_cherry_pick_cache ;
1601
+ my %check_cherry_pick2_cache ;
1601
1602
my %has_no_changes_cache ;
1602
- my %_rev_list_cache;
1603
1603
1604
1604
tie_for_persistent_memoization(\%lookup_svn_merge_cache ,
1605
1605
" $cache_path /lookup_svn_merge" );
@@ -1608,11 +1608,11 @@ sub tie_for_persistent_memoization {
1608
1608
LIST_CACHE => [' HASH' => \%lookup_svn_merge_cache ],
1609
1609
;
1610
1610
1611
- tie_for_persistent_memoization(\%check_cherry_pick_cache ,
1612
- " $cache_path /check_cherry_pick " );
1613
- memoize ' check_cherry_pick ' ,
1611
+ tie_for_persistent_memoization(\%check_cherry_pick2_cache ,
1612
+ " $cache_path /check_cherry_pick2 " );
1613
+ memoize ' check_cherry_pick2 ' ,
1614
1614
SCALAR_CACHE => ' FAULT' ,
1615
- LIST_CACHE => [' HASH' => \%check_cherry_pick_cache ],
1615
+ LIST_CACHE => [' HASH' => \%check_cherry_pick2_cache ],
1616
1616
;
1617
1617
1618
1618
tie_for_persistent_memoization(\%has_no_changes_cache ,
@@ -1621,24 +1621,15 @@ sub tie_for_persistent_memoization {
1621
1621
SCALAR_CACHE => [' HASH' => \%has_no_changes_cache ],
1622
1622
LIST_CACHE => ' FAULT' ,
1623
1623
;
1624
-
1625
- tie_for_persistent_memoization(\%_rev_list_cache,
1626
- " $cache_path /_rev_list" );
1627
- memoize ' _rev_list' ,
1628
- SCALAR_CACHE => ' FAULT' ,
1629
- LIST_CACHE => [' HASH' => \%_rev_list_cache],
1630
- ;
1631
-
1632
1624
}
1633
1625
1634
1626
sub unmemoize_svn_mergeinfo_functions {
1635
1627
return if not $memoized ;
1636
1628
$memoized = 0;
1637
1629
1638
1630
Memoize::unmemoize ' lookup_svn_merge' ;
1639
- Memoize::unmemoize ' check_cherry_pick ' ;
1631
+ Memoize::unmemoize ' check_cherry_pick2 ' ;
1640
1632
Memoize::unmemoize ' has_no_changes' ;
1641
- Memoize::unmemoize ' _rev_list' ;
1642
1633
}
1643
1634
1644
1635
sub clear_memoized_mergeinfo_caches {
@@ -1648,7 +1639,8 @@ sub tie_for_persistent_memoization {
1648
1639
return unless -d $cache_path ;
1649
1640
1650
1641
for my $cache_file ((" $cache_path /lookup_svn_merge" ,
1651
- " $cache_path /check_cherry_pick" ,
1642
+ " $cache_path /check_cherry_pick" , # old
1643
+ " $cache_path /check_cherry_pick2" ,
1652
1644
" $cache_path /has_no_changes" )) {
1653
1645
for my $suffix (qw( yaml db) ) {
1654
1646
my $file = " $cache_file .$suffix " ;
@@ -1702,11 +1694,49 @@ sub parents_exclude {
1702
1694
return @excluded ;
1703
1695
}
1704
1696
1697
+ # Compute what's new in svn:mergeinfo.
1698
+ sub mergeinfo_changes {
1699
+ my ($self , $old_path , $old_rev , $path , $rev , $mergeinfo_prop ) = @_ ;
1700
+ my %minfo = map {split " :" , $_ } split " \n " , $mergeinfo_prop ;
1701
+ my $old_minfo = {};
1702
+
1703
+ my $ra = $self -> ra;
1704
+ # Give up if $old_path isn't in the repo.
1705
+ # This is probably a merge on a subtree.
1706
+ if ($ra -> check_path($old_path , $old_rev ) != $SVN::Node::dir ) {
1707
+ warn " W: ignoring svn:mergeinfo on $old_path , " ,
1708
+ " directory didn't exist in r$old_rev \n " ;
1709
+ return {};
1710
+ }
1711
+ my (undef , undef , $props ) = $ra -> get_dir($old_path , $old_rev );
1712
+ if (defined $props -> {" svn:mergeinfo" }) {
1713
+ my %omi = map {split " :" , $_ } split " \n " ,
1714
+ $props -> {" svn:mergeinfo" };
1715
+ $old_minfo = \%omi ;
1716
+ }
1717
+
1718
+ my %changes = ();
1719
+ foreach my $p (keys %minfo ) {
1720
+ my $a = $old_minfo -> {$p } || " " ;
1721
+ my $b = $minfo {$p };
1722
+ # Omit merged branches whose ranges lists are unchanged.
1723
+ next if $a eq $b ;
1724
+ # Remove any common range list prefix.
1725
+ ($a ^ $b ) =~ / ^[\0 ]*/ ;
1726
+ my $common_prefix = rindex $b , " ," , $+ [0] - 1;
1727
+ $changes {$p } = substr $b , $common_prefix + 1;
1728
+ }
1729
+ print STDERR " Checking svn:mergeinfo changes since r$old_rev : " ,
1730
+ scalar (keys %minfo ), " sources, " ,
1731
+ scalar (keys %changes ), " changed\n " ;
1732
+
1733
+ return \%changes ;
1734
+ }
1705
1735
1706
1736
# note: this function should only be called if the various dirprops
1707
1737
# have actually changed
1708
1738
sub find_extra_svn_parents {
1709
- my ($self , $ed , $ mergeinfo , $parents ) = @_ ;
1739
+ my ($self , $mergeinfo , $parents ) = @_ ;
1710
1740
# aha! svk:merge property changed...
1711
1741
1712
1742
memoize_svn_mergeinfo_functions();
@@ -1715,14 +1745,15 @@ sub find_extra_svn_parents {
1715
1745
# history. Then, we figure out which git revisions are in
1716
1746
# that tip, but not this revision. If all of those revisions
1717
1747
# are now marked as merge, we can add the tip as a parent.
1718
- my @merges = split " \n " , $mergeinfo ;
1748
+ my @merges = sort keys % $mergeinfo ;
1719
1749
my @merge_tips ;
1720
1750
my $url = $self -> url;
1721
1751
my $uuid = $self -> ra_uuid;
1722
1752
my @all_ranges ;
1723
1753
for my $merge ( @merges ) {
1724
1754
my ($tip_commit , @ranges ) =
1725
- lookup_svn_merge( $uuid , $url , $merge );
1755
+ lookup_svn_merge( $uuid , $url ,
1756
+ $merge , $mergeinfo -> {$merge } );
1726
1757
unless (!$tip_commit or
1727
1758
grep { $_ eq $tip_commit } @$parents ) {
1728
1759
push @merge_tips , $tip_commit ;
@@ -1738,8 +1769,9 @@ sub find_extra_svn_parents {
1738
1769
# check merge tips for new parents
1739
1770
my @new_parents ;
1740
1771
for my $merge_tip ( @merge_tips ) {
1741
- my $spec = shift @merges ;
1772
+ my $merge = shift @merges ;
1742
1773
next unless $merge_tip and $excluded {$merge_tip };
1774
+ my $spec = " $merge :$mergeinfo ->{$merge }" ;
1743
1775
1744
1776
# check out 'new' tips
1745
1777
my $merge_base ;
@@ -1759,19 +1791,17 @@ sub find_extra_svn_parents {
1759
1791
}
1760
1792
1761
1793
# double check that there are no missing non-merge commits
1762
- my (@incomplete ) = check_cherry_pick (
1794
+ my ($ninc , $ifirst ) = check_cherry_pick2 (
1763
1795
$merge_base , $merge_tip ,
1764
1796
$parents ,
1765
1797
@all_ranges ,
1766
1798
);
1767
1799
1768
- if ( @incomplete ) {
1769
- warn " W:svn cherry-pick ignored ($spec ) - missing "
1770
- . @incomplete . " commit(s) (eg $incomplete [0] )\n " ;
1800
+ if ($ninc ) {
1801
+ warn " W: svn cherry-pick ignored ($spec ) - missing " .
1802
+ " $ninc commit(s) (eg $ifirst )\n " ;
1771
1803
} else {
1772
- warn
1773
- " Found merge parent (svn:mergeinfo prop): " ,
1774
- $merge_tip , " \n " ;
1804
+ warn " Found merge parent ($spec ): " , $merge_tip , " \n " ;
1775
1805
push @new_parents , $merge_tip ;
1776
1806
}
1777
1807
}
@@ -1797,23 +1827,20 @@ sub find_extra_svn_parents {
1797
1827
}
1798
1828
1799
1829
sub make_log_entry {
1800
- my ($self , $rev , $parents , $ed ) = @_ ;
1830
+ my ($self , $rev , $parents , $ed , $parent_rev , $parent_path ) = @_ ;
1801
1831
my $untracked = $self -> get_untracked($ed );
1802
1832
1803
1833
my @parents = @$parents ;
1804
- my $ps = $ed -> {path_strip } || " " ;
1805
- for my $path ( grep { m /$ps / } %{$ed -> {dir_prop }} ) {
1806
- my $props = $ed -> {dir_prop }{$path };
1807
- if ( $props -> {" svk:merge" } ) {
1808
- $self -> find_extra_svk_parents
1809
- ($ed , $props -> {" svk:merge" }, \@parents );
1810
- }
1811
- if ( $props -> {" svn:mergeinfo" } ) {
1812
- $self -> find_extra_svn_parents
1813
- ($ed ,
1814
- $props -> {" svn:mergeinfo" },
1815
- \@parents );
1816
- }
1834
+ my $props = $ed -> {dir_prop }{$self -> path};
1835
+ if ( $props -> {" svk:merge" } ) {
1836
+ $self -> find_extra_svk_parents($props -> {" svk:merge" }, \@parents );
1837
+ }
1838
+ if ( $props -> {" svn:mergeinfo" } ) {
1839
+ my $mi_changes = $self -> mergeinfo_changes
1840
+ ($parent_path , $parent_rev ,
1841
+ $self -> path, $rev ,
1842
+ $props -> {" svn:mergeinfo" });
1843
+ $self -> find_extra_svn_parents($mi_changes , \@parents );
1817
1844
}
1818
1845
1819
1846
open my $un , ' >>' , " $self ->{dir}/unhandled.log" or croak $! ;
0 commit comments