#!/usr/bin/perl -w
my
$Id
=
q$Id: apc2svn 201 2006-02-25 06:29:11Z k $
;
warn
"WARNING: script is not maintained anymore; please file a feature
request on rt.cpan.org
if
you want to
continue
to
use
it and indicate
if
you can take it over\n";
sleep
3;
get_dirs_to_delete delete_empty_dirs)
;
our
$Signal
= 0;
our
$MPV
;
$SIG
{INT} =
$SIG
{TERM} =
sub
{
print
"Caught SIG$_[0]; please stand by, I'm leaving as soon as possible...\n"
;
$Signal
++;
};
our
%Opt
;
sub
Usage (){
qq{Usage: $0 OPTIONS
--apc # APC base directory
--debug # be more verbose
--h # this help page
--password # password (not needed for file: URLs)
--q # quiet
--singlestep # feed the patches one at a time to perlpatch2svn
--sw_or_co # set to "co" (default) to prefer checkout over switch
# set to "sw" otherwise
--wc # directory of the working copy
}
;
}
GetOptions(\
%Opt
,
"apc=s"
,
"bounds=s"
,
"debug!"
,
"h!"
,
"password=s"
,
"q!"
,
"singlestep!"
,
"sw_or_co=s"
,
"url=s"
,
"wc=s"
,
) or
die
Usage;
if
(
$Opt
{h}) {
print
Usage;
exit
;
}
sub
mysystem (@);
sub
contains_cr ($);
sub
svn_mkdir_minus_p ($$);
sub
makepatch_version ();
sub
myls ($);
$Opt
{wc} ||=
"perl-wc"
;
my
@passwordarg
;
$Opt
{password} and
@passwordarg
=
"--password=$Opt{password}"
;
$Opt
{apc} ||=
"APC"
;
for
my
$option
(
qw(apc wc)
) {
if
(File::Spec->file_name_is_absolute(
$Opt
{
$option
})) {
$Opt
{
$option
} = File::Spec->abs2rel(
$Opt
{
$option
});
}
}
$Opt
{singlestep} = 0
unless
defined
$Opt
{singlestep};
$Opt
{sw_or_co} ||=
"co"
;
unless
(
$Opt
{sw_or_co} =~ /^(co|sw)$/) {
die
"Illegal value for sw_or_co[$Opt{sw_or_co}]: only 'co' or 'sw' are allowed"
;
}
if
(
$Opt
{debug}) {
our
$DEBUG
= 1;
}
my
$owning_wc
= 0;
my
(
%latest_change
);
my
$apc_repo
= Perl::Repository::APC->new(
$Opt
{apc});
APCDIR:
for
my
$apcdir
(
$apc_repo
->apcdirs){
my
(
$apc_branch
,
$pver
,
@patches
) =
@$apcdir
;
exit
if
$Signal
;
if
(
$latest_change
{
$apc_branch
}
&&
$latest_change
{
$apc_branch
} >
$patches
[-1]
) {
next
APCDIR;
}
my
(
$work_branch
,
$park_branch_parent
);
my
$tag_branch_parent
=
"tags/branchpoints"
;
my
$rel_branch_parent
=
"tags/releases"
;
if
(
$apc_branch
eq
"perl"
) {
$work_branch
=
"trunk"
;
$park_branch_parent
=
"branches/perl"
;
}
else
{
$work_branch
=
"branches/$apc_branch/mbranch"
;
$park_branch_parent
=
"branches/$apc_branch/rel"
;
if
(
$pver
eq
"5.004_00"
) {
}
elsif
(myls
"$Opt{url}/$work_branch"
) {
}
else
{
svn_mkdir_minus_p
$Opt
{url},
"branches/$apc_branch"
;
my
$from
=
$pver
;
if
(
index
(
$apc_branch
,
"/"
) > 0) {
if
(
$apc_branch
eq
"maint-5.6/perl-5.6.2"
) {
$from
=
"5.6.1"
;
}
else
{
die
"PANIC ($0): Unknown apc_branch[$apc_branch]"
;
}
}
else
{
$from
=~ s/1$/0/;
}
mysystem
svn
=>
"cp"
,
@passwordarg
,
"-m"
,
"Generating maint branch $apc_branch from $from for $pver"
,
"$Opt{url}/tags/branchpoints/$from"
,
"$Opt{url}/branches/$apc_branch/mbranch"
;
}
}
exit
if
$Signal
;
$latest_change
{
$apc_branch
} = url_latest_change(
"$Opt{url}/$work_branch"
);
if
(
$latest_change
{
$apc_branch
} >
$patches
[-1]) {
next
APCDIR;
}
for
my
$dir
(
$work_branch
,
$park_branch_parent
,
$tag_branch_parent
,
$rel_branch_parent
) {
die
"dir empty value"
unless
$dir
;
svn_mkdir_minus_p
$Opt
{url},
$dir
;
}
warn
sprintf
"#### %-15s %10s %6d %6d ####\n"
,
$apc_branch
,
$pver
,
$patches
[0],
$patches
[-1];
if
(
$latest_change
{
$apc_branch
} <
$patches
[-1]) {
if
(
$owning_wc
&&
$Opt
{sw_or_co} eq
"sw"
) {
chdir
$Opt
{wc};
mysystem
svn
=>
"switch"
,
"-q"
,
"$Opt{url}/$work_branch"
or
die
;
chdir
".."
;
}
else
{
rmtree
$Opt
{wc};
mysystem
svn
=>
"co"
,
"-q"
,
@passwordarg
,
"$Opt{url}/$work_branch"
,
$Opt
{wc} or
die
;
$owning_wc
=1;
}
exit
if
$Signal
;
{
chdir
$Opt
{wc} or
die
"Could not chdir to $Opt{wc}: $!"
;
my
$brancharg
;
if
(
$apc_branch
eq
"perl"
) {
$brancharg
=
""
;
}
elsif
(
index
(
$apc_branch
,
"/"
) > 0) {
$brancharg
=
" --branch $apc_branch"
;
}
else
{
$brancharg
=
" --branch $apc_branch/perl"
;
}
our
$DEBUG
;
my
$debugarg
=
$DEBUG
?
" --debug"
:
""
;
my
$want_singlestep
;
if
(
$Opt
{singlestep}
||
(
$latest_change
{
$apc_branch
} >=
$patches
[0]
&&
$latest_change
{
$apc_branch
} <
$patches
[-1]
)
) {
$want_singlestep
= 1;
}
if
(
$want_singlestep
) {
PATCH:
for
my
$patch
(0..
$#patches
){
my
$nr
=
$patches
[
$patch
];
next
PATCH
if
$latest_change
{
$apc_branch
} >=
$nr
;
my
$gz
= File::Spec->catfile(
$Opt
{apc},
$pver
,
"diffs"
,
"$nr.gz"
);
my
$upgz
= File::Spec->catfile(File::Spec->updir,
$gz
);
if
(
$Opt
{bounds}) {
die
"Illegal arguments[$Opt{bounds}] to bounds"
unless
$Opt
{bounds} =~ /^(\d+)-(\d+)$/;
my
(
$lower
,
$upper
) = ($1,$2);
next
PATCH
if
$nr
<
$lower
or
$nr
>
$upper
;
}
printf
"Trying %s (%sb)\n"
,
$gz
, -s
$upgz
;
my
(
$n
) =
$nr
;
$n
=
sprintf
"%05d"
,
$n
;
mysystem(
"zcat $upgz | perlpatch2svn -f$brancharg$debugarg"
) or
die
;
exit
if
$Signal
;
}
}
else
{
mysystem(
"zcat ../$Opt{apc}/$pver/diffs/*.gz | "
.
"perlpatch2svn$brancharg$debugarg"
)
or
die
;
}
printf
"Finished checkin of %s\n"
,
$pver
;
$latest_change
{
$apc_branch
} =
$patches
[-1];
chdir
".."
;
exit
if
$Signal
;
}
}
opendir
my
$DIR
,
"$Opt{apc}/$pver"
or
die
;
my
(
@dirent
) =
grep
!/RC|TRIAL/,
grep
/^perl.*\.tar\.gz$/,
readdir
$DIR
;
closedir
$DIR
;
die
"\aALERT: (\@dirent > 1: @dirent) in $Opt{apc}/$pver"
if
@dirent
>1;
if
(
@dirent
) {
unless
(myls
"$Opt{url}/$park_branch_parent/$pver"
) {
chdir
$Opt
{wc} or
die
"Could not chdir to $Opt{wc}: $!"
;
mysystem
svn
=>
"cp"
,
@passwordarg
,
"-m"
,
"Branching $pver"
,
"$Opt{url}/$work_branch"
,
"$Opt{url}/$park_branch_parent/$pver"
;
print
"Branched $pver\n"
;
chdir
".."
;
}
unless
(myls
"$Opt{url}/$tag_branch_parent/$pver"
) {
chdir
$Opt
{wc} or
die
"Could not chdir to $Opt{wc}: $!"
;
mysystem
svn
=>
"cp"
,
@passwordarg
,
"-m"
,
"Tagging branching point $pver"
,
"$Opt{url}/$work_branch"
,
"$Opt{url}/$tag_branch_parent/$pver"
;
print
"Tagged branching point $pver\n"
;
chdir
".."
;
}
my
$tarball
=
$dirent
[0];
if
(myls
"$Opt{url}/$rel_branch_parent/$tarball"
) {
next
APCDIR;
}
open
my
$TAR
,
"tar tzf $Opt{apc}/$pver/$tarball |"
or
die
;
my
$tardir
= <
$TAR
>;
chomp
$tardir
;
$tardir
=~ s|^\./||;
$tardir
=~ s|/.*$||;
close
$TAR
;
print
"dirent[@dirent]tardir[$tardir]\n"
;
rmtree
$tardir
;
mysystem
tar
=>
"xzf"
,
"$Opt{apc}/$pver/$tarball"
or
die
"Could not run tar"
;
my
@ccr
= mani_unCR(
$tardir
);
unless
(
$MPV
) {
$MPV
= makepatch_version;
die
"Your version of makepatch ($MPV) is not recent enough, 2.00 is needed"
unless
$MPV
>= 2.00;
}
my
(
undef
,
$mpfile
) = File::Temp::tempfile;
$mpfile
= File::Spec->rel2abs(
$mpfile
);
mysystem(
"makepatch '-diff=diff -u' -nomanifest "
.
"-description '$park_branch_parent/$pver vs. $tardir' "
.
"-exclude .svn "
.
"$Opt{wc} $tardir > $mpfile"
)
or
die
"Could not run makepatch"
;
print
"Makepatch $pver done\n"
;
rmtree
$tardir
;
{
if
(
$Opt
{sw_or_co} eq
"co"
) {
rmtree
$Opt
{wc};
mysystem
svn
=>
"co"
,
"-q"
,
"$Opt{url}/$park_branch_parent/$pver"
,
$Opt
{wc}
or
die
"Could not co"
;
chdir
$Opt
{wc};
}
else
{
chdir
$Opt
{wc};
mysystem
svn
=>
"switch"
,
"-q"
,
"$Opt{url}/$park_branch_parent/$pver"
or
die
"Could not switch"
;
}
mysystem
"applypatch $mpfile"
;
my
(
$adds
,
$deletes
) = parse_applypatch_data(
$mpfile
);
unlink
$mpfile
;
if
(
@$adds
){
unshift
@$adds
, get_dirs_to_add(
@$adds
) ;
mysystem
svn
=>
"add"
,
@$adds
;
}
mysystem
svn
=>
"rm"
,
@$deletes
if
@$deletes
;
delete_empty_dirs(
@$deletes
);
mysystem
svn
=>
"propset"
,
"perl:release"
,
$pver
,
"."
;
mysystem
svn
=>
"propset"
,
"svn:eol-style"
,
"native"
,
@ccr
if
@ccr
;
mysystem
svn
=>
"ci"
,
"-m"
,
"Released as $tarball with rootdir $tardir branched at $pver"
;
mysystem
svn
=>
"cp"
,
@passwordarg
,
"-m"
,
"Release"
,
"$Opt{url}/$work_branch"
,
"$Opt{url}/$rel_branch_parent/$tarball"
;
chdir
".."
;
}
}
else
{
print
"For $pver there is no tarfile to check in; nothing left to do.\n"
;
}
exit
if
$Signal
;
}
sub
svn_mkdir_minus_p ($$) {
my
(
$root
,
$mkdir
) =
@_
;
die
"mkdir no value"
unless
$mkdir
;
my
$ipath
=
""
;
for
my
$idir
(
split
m|/|,
$mkdir
) {
$ipath
=
$ipath
?
"$ipath/$idir"
:
$idir
;
my
$urlipath
=
"$root/$ipath"
;
unless
(myls
$urlipath
) {
mysystem(
svn
=>
"mkdir"
,
"-m"
=>
"mkdir $ipath"
,
$urlipath
) or
die
;
}
}
}
sub
myls ($) {
my
$ls
=
shift
;
die
"myls() called with illegal argument [$ls]: must be a URL"
unless
index
(
$ls
,
"/"
) > -1;
my
(
$parent
,
$child
) =
$ls
=~ m|^(.+/)([^/]+)$|;
open
my
$fh
,
"svn ls $parent|"
or
return
0;
while
(<
$fh
>) {
chomp
;
if
(m|^\Q
$child
\E/?$|){
return
1;
}
}
close
$fh
;
return
0;
}
sub
contains_cr ($) {
my
(
$file
) =
shift
;
open
my
$fh
,
$file
or
die
"Couldn't open $file: $!"
;
local
($/) =
"\n"
;
my
$firstline
= <
$fh
>;
defined
$firstline
&&
$firstline
=~ /\cM/;
}
sub
mysystem (@) {
my
@system
=
@_
;
warn
sprintf
(
"%s: Running (%s)\n"
,
scalar
(
localtime
),
join
(
","
,
map
{
"\"$_\""
}
@system
),
)
unless
$Opt
{
"q"
};
system
(
@system
)==0;
}
sub
parse_applypatch_data {
my
$file
=
shift
;
my
(
@crea
,
@remo
);
open
my
$fh
,
$file
or
die
"Could not open $file: $!"
;
while
(<
$fh
>) {
next
unless
/ ^ \
last
;
}
while
(<
$fh
>) {
last
if
/ ^ \
next
unless
/ ^ \
my
$spec1
= $1;
my
$spec2
= $2;
my
(
@spec2
) = Text::ParseWords::shellwords(
$spec2
);
if
(
$spec1
eq
"c"
) {
push
@crea
,
$spec2
[0];
}
else
{
push
@remo
,
$spec2
[0];
}
}
(\
@crea
,\
@remo
);
}
sub
mani_unCR {
my
(
$tardir
) =
@_
;
my
@ccr
;
my
$mani
=
"$tardir/MANIFEST"
;
open
my
$fh
,
$mani
or
die
"Could not open $mani: $!"
;
while
(<
$fh
>) {
my
(
$file
) = /(\S+)/ or
next
;
my
$intar_file
=
$file
;
$intar_file
=~ s|^|
$tardir
/|;
next
unless
contains_cr
$intar_file
;
push
@ccr
,
$file
;
@ARGV
=
$intar_file
;
$^I=
""
;
while
(<>) {
s/[\r\n]+\z/\n/;
print
;
}
}
close
$fh
;
@ccr
;
}
sub
makepatch_version () {
open
my
$fh
,
"makepatch --version 2>&1 |"
or
die
"Could not run makepatch"
;
local
$/ =
"\n"
;
my
$v
;
while
(<
$fh
>) {
next
unless
/^This is makepatch version ([\d\.]+)/;
$v
= $1;
}
close
$fh
;
$v
;
}