9 hook(type => "getsetup", id => "tla", call => sub { #{{{
14 #example => "", # TODO example
15 description => "url to show file history ([[file]] substituted)",
22 #example => "", # TODO example
23 description => "url to show a diff ([[file]] and [[rev]] substituted)",
29 sub quiet_system (@) {
30 # See Debian bug #385939.
31 open (SAVEOUT, ">&STDOUT");
33 open (STDOUT, ">/dev/null");
36 open (STDOUT, ">&SAVEOUT");
41 sub rcs_update () { #{{{
42 if (-d "$config{srcdir}/{arch}") {
43 if (quiet_system("tla", "replay", "-d", $config{srcdir}) != 0) {
44 warn("tla replay failed\n");
49 sub rcs_prepedit ($) { #{{{
52 if (-d "$config{srcdir}/{arch}") {
53 # For Arch, return the tree-id of archive when
55 my $rev=`tla tree-id $config{srcdir}`;
56 return defined $rev ? $rev : "";
60 sub rcs_commit ($$$;$$) { #{{{
68 $message="web commit by $user".(length $message ? ": $message" : "");
70 elsif (defined $ipaddr) {
71 $message="web commit from $ipaddr".(length $message ? ": $message" : "");
74 if (-d "$config{srcdir}/{arch}") {
75 # Check to see if the page has been changed by someone
76 # else since rcs_prepedit was called.
77 my ($oldrev)=$rcstoken=~/^([A-Za-z0-9@\/._-]+)$/; # untaint
78 my $rev=`tla tree-id $config{srcdir}`;
79 if (defined $rev && defined $oldrev && $rev ne $oldrev) {
80 # Merge their changes into the file that we've
82 if (quiet_system("tla", "update", "-d",
83 "$config{srcdir}") != 0) {
84 warn("tla update failed\n");
88 if (quiet_system("tla", "commit",
89 "-L".possibly_foolish_untaint($message),
90 '-d', $config{srcdir}) != 0) {
91 my $conflict=readfile("$config{srcdir}/$file");
92 if (system("tla", "undo", "-n", "--quiet", "-d", "$config{srcdir}") != 0) {
93 warn("tla undo failed\n");
98 return undef # success
101 sub rcs_commit_staged ($$$) {
102 # Commits all staged changes. Changes can be staged using rcs_add,
103 # rcs_remove, and rcs_rename.
104 my ($message, $user, $ipaddr)=@_;
106 error("rcs_commit_staged not implemented for tla"); # TODO
109 sub rcs_add ($) { #{{{
112 if (-d "$config{srcdir}/{arch}") {
113 if (quiet_system("tla", "add", "$config{srcdir}/$file") != 0) {
114 warn("tla add failed\n");
119 sub rcs_remove ($) { # {{{
122 error("rcs_remove not implemented for tla"); # TODO
125 sub rcs_rename ($$) { # {{{a
126 my ($src, $dest) = @_;
128 error("rcs_rename not implemented for tla"); # TODO
131 sub rcs_recentchanges ($) {
135 return unless -d "$config{srcdir}/{arch}";
137 eval q{use Date::Parse};
139 eval q{use Mail::Header};
142 my $logs = `tla logs -d $config{srcdir}`;
143 my @changesets = reverse split(/\n/, $logs);
145 for (my $i=0; $i<$num && $i<$#changesets; $i++) {
146 my ($change)=$changesets[$i]=~/^([A-Za-z0-9@\/._-]+)$/; # untaint
148 open(LOG, "tla cat-log -d $config{srcdir} $change|");
149 my $head = Mail::Header->new(\*LOG);
152 my $rev = $head->get("Revision");
153 my $summ = $head->get("Summary");
154 my $newfiles = $head->get("New-files");
155 my $modfiles = $head->get("Modified-files");
156 my $remfiles = $head->get("Removed-files");
157 my $user = $head->get("Creator");
159 my @paths = grep { !/^(.*\/)?\.arch-ids\/.*\.id$/ }
160 split(/ /, "$newfiles $modfiles .arch-ids/fake.id");
162 my $sdate = $head->get("Standard-date");
163 my $when = str2time($sdate, 'UTC');
165 my $committype = "web";
166 if (defined $summ && $summ =~ /$config{web_commit_regexp}/) {
167 $user = defined $2 ? "$2" : "$3";
175 push @message, { line => $summ };
179 foreach my $file (@paths) {
180 my $diffurl=$config{diffurl};
181 $diffurl=~s/\[\[file\]\]/$file/g;
182 $diffurl=~s/\[\[rev\]\]/$change/g;
184 page => pagename($file),
191 committype => $committype,
193 message => [@message],
203 sub rcs_diff ($) { #{{{
205 my $logs = `tla logs -d $config{srcdir}`;
206 my @changesets = reverse split(/\n/, $logs);
209 for($i=0;$i<$#changesets;$i++) {
210 last if $changesets[$i] eq $rev;
213 my $revminusone = $changesets[$i+1];
214 return `tla diff -d $config{srcdir} $revminusone`;
217 sub rcs_getctime ($) { #{{{
219 eval q{use Date::Parse};
221 eval q{use Mail::Header};
224 my $logs = `tla logs -d $config{srcdir}`;
225 my @changesets = reverse split(/\n/, $logs);
228 for (my $i=0; $i<$#changesets; $i++) {
229 my $change = $changesets[$i];
231 open(LOG, "tla cat-log -d $config{srcdir} $change|");
232 my $head = Mail::Header->new(\*LOG);
235 $sdate = $head->get("Standard-date");
236 my $newfiles = $head->get("New-files");
238 my ($lastcreation) = grep {/^$file$/} split(/ /, "$newfiles");
239 last if defined($lastcreation);
242 my $date=str2time($sdate, 'UTC');
243 debug("found ctime ".localtime($date)." for $file");