view release on metacpan or  search on metacpan

scripts/apc2svn  view on Meta::CPAN

    print "dirent[@dirent]tardir[$tardir]\n";

    # $tardir/ is the directory that we get if we untar the ball now
    # and "$Opt{wc}/ is the directory we have to compare against. Note
    # that we have to eliminate CR in tardir/

    # HANDLE TARBALL COMPARISON AND PATCH SVN's COPY

    # MAKEPATCH

    rmtree $tardir;
    mysystem tar => "xzf", "$Opt{apc}/$pver/$tarball"
        or die "Could not run tar";
    my @ccr = mani_unCR($tardir);
    # must be nomanifest because either manifest may be wrong
    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;

    # 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),