File: Propset.pm

package info (click to toggle)
svk 1.08-2
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 1,480 kB
  • ctags: 960
  • sloc: perl: 18,811; lisp: 63; makefile: 43; sh: 10
file content (171 lines) | stat: -rw-r--r-- 4,934 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
package SVK::Command::Propset;
use strict;
use SVK::Version;  our $VERSION = $SVK::VERSION;
use base qw( SVK::Command::Commit SVK::Command::Proplist );
use constant opt_recursive => 0;
use SVK::Util qw ( abs2rel );
use SVK::XD;
use SVK::I18N;

sub options {
    ($_[0]->SUPER::options,
     'r|revision=i' => 'rev',
     'revprop' => 'revprop',
     'q|quiet' => 'quiet',
    );
}

sub parse_arg {
    my ($self, @arg) = @_;
    return if @arg < 2;
    push @arg, ('') if @arg == 2;
    return (@arg[0,1], map {$self->_arg_revprop ($_)} @arg[2..$#arg]);
}

sub lock {
    my $self = shift;
    my @paths = @_[2..$#_];
    return unless grep {$_->copath} @paths;
    $self->lock_target ($self->arg_condensed (map {$_->{report}} @_[2..$#_]));
}

sub do_propset_direct {
    my ($self, $target, $propname, $propvalue) = @_;

    if ($self->{revprop}) {
	my $fs = $target->{repos}->fs;
        my $rev = (defined($self->{rev}) ? $self->{rev} : $target->{revision});
        $fs->change_rev_prop ($rev, $propname => $propvalue);
	unless ($self->{quiet}) {
	    if (defined $propvalue) {
		print loc("Property '%1' set on repository revision %2.\n",
		    $propname, $rev);
	    } else {
		print loc("Property '%1' deleted from repository revision %2.\n",
		    $propname, $rev);
	    }
	}
        return;
    }

    $target->normalize; # so find_remove_rev is used with right revision.
    my $root = $target->root;
    my $kind = $root->check_path ($target->path);

    die loc("path %1 does not exist.\n", $target->path) if $kind == $SVN::Node::none;

    my ($anchor, $editor) = $self->get_dynamic_editor ($target);
    my $func = $kind == $SVN::Node::dir ? 'change_dir_prop' : 'change_file_prop';
    my $path = abs2rel ($target->path, $anchor => undef, '/');

    my $m = $self->under_mirror ($target);
    my $rev = $target->{revision};
    $rev = $m->find_remote_rev ($rev) if $m;
    if ($kind == $SVN::Node::dir) {
	if ($anchor eq $target->path) {
	    $editor->change_dir_prop ($editor->{_root_baton}, $propname, $propvalue);
	}
	else {
	    my $baton = $editor->open_directory ($path, 0, $rev);
	    $editor->change_dir_prop ($baton, $propname, $propvalue);
	    $editor->close_directory ($baton);
	}
    }
    else {
	my $baton = $editor->open_file ($path, 0, $rev);
	$editor->change_file_prop ($baton, $propname, $propvalue);
	$editor->close_file ($baton, undef);
    }
    $self->adjust_anchor ($editor)
	unless $anchor eq $target->path;
    $self->finalize_dynamic_editor ($editor);
    return;
}

sub do_propset {
    my ($self, $pname, $pvalue, $target) = @_;

    if ($target->{copath}) {
	die loc("-r not allowed for propset copath.\n")
	    if $self->{rev};
	# verify the content is not with mixed line endings.
	if ($pname eq 'svn:eol-style') {
	    my $xdroot = $target->root ($self->{xd});
	    my $fh = SVK::XD::get_fh ($xdroot, '<', $target->{path}, $target->{copath},
				      { 'svn:eol-style' => $pvalue }, '',
				      undef, 1);
	    eval {
		local $/ = \16384;
		while (<$fh>) { };
	    };
	    if ($@ =~ m/Mixed/) {
		die loc ("File %1 has inconsistent newlines.\n", $target->{report});
	    }
	    elsif ($@) {
		die $@;
	    }
	}

	$self->{xd}->do_propset
	    ( %$target,
	      propname => $pname,
	      propvalue => $pvalue,
	      quiet => $self->{quiet},
	    );
    }
    else {
	# XXX: forbid special props on mirror anchor
	die loc ("Can't set svn:eol-style on depotpath.\n")
	    if $pname eq 'svn:eol-style';
	$self->get_commit_message () unless $self->{revprop};
	$self->do_propset_direct ( $target, $pname => $pvalue );
    }
}

sub run {
    my ($self, $pname, $pvalue, @targets) = @_;
    $self->do_propset ($pname, $pvalue, $_) for @targets;
    return;
}

1;

__DATA__

=head1 NAME

SVK::Command::Propset - Set a property on path

=head1 SYNOPSIS

 propset PROPNAME PROPVAL [DEPOTPATH | PATH...]

=head1 OPTIONS

 -R [--recursive]       : descend recursively
 -r [--revision] REV    : act on revision REV instead of the head revision
 --revprop              : operate on a revision property (use with -r)
 -m [--message] MESSAGE : specify commit message MESSAGE
 -F [--file] FILENAME   : read commit message from FILENAME
 --template             : use the specified message as the template to edit
 --encoding ENC         : treat -m/-F value as being in charset encoding ENC
 -P [--patch] NAME      : instead of commit, save this change as a patch
 -S [--sign]            : sign this change
 -C [--check-only]      : try operation but make no changes
 -q [--quiet]           : print as little as possible
 --direct               : commit directly even if the path is mirrored

=head1 AUTHORS

Chia-liang Kao E<lt>clkao@clkao.orgE<gt>

=head1 COPYRIGHT

Copyright 2003-2005 by Chia-liang Kao E<lt>clkao@clkao.orgE<gt>.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut