view release on metacpan or  search on metacpan

scripts/apc2svn  view on Meta::CPAN

             "$Opt{wc} $tardir > $mpfile")
        or die "Could not run makepatch";
    print "Makepatch $pver done\n";
    rmtree $tardir;

    # APPLYPATCH

    {
      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";
      }

      # applypatch is at the mercy of patch and sometimes exits with
      # error code although we're fine:-( So no check for the return
      # value here:
      mysystem "applypatch $mpfile";

      #### svn add/delete:
      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);

      # so that commit always has something to do:
      mysystem svn => "propset", "perl:release", $pver, ".";

      # why native? so that Windows people get what they need.
      # why not CRLF? so that even Unix people can patch the file.
      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/?$|){
      # warn "Info ls: $ls exists\n";
      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 / ^ \#\#\#\# \s ApplyPatch \s data \s follows /x;
    last;
  }
  while (<$fh>) {
    last if / ^ \#\#\#\# \s End \s of \s ApplyPatch \s data /x;
    next unless / ^ \# \s ([cr]) \s (.*) /x;
    my $spec1 = $1;
    my $spec2 = $2;
    require Text::ParseWords;
    my(@spec2) = Text::ParseWords::shellwords($spec2);
    if ($spec1 eq "c") {
      push @crea, $spec2[0];