taskd/clone.sh: check for darcs-fast-export exit code
[girocco/radio.git] / Girocco / Notify.pm
blob36f81b463c89f038c91d0ab7c4d19b9b1a4b30ed
1 package Girocco::Notify;
3 use strict;
4 use warnings;
6 BEGIN {
7 use Girocco::Config;
9 use JSON;
10 use LWP::UserAgent;
12 use RPC::XML;
13 use RPC::XML::Client;
17 # This Perl code creates json payload within post-receive hook.
19 sub json_commit {
20 my ($proj, $commit) = @_;
22 my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
23 my $fd;
25 open $fd, '-|', @gcmd, 'log', '-1', '--pretty=format:%ae %an%n%ai%n%s%n%n%b', $commit
26 or die "cannot do git log: $! $?";
27 my @l = <$fd>;
28 chomp @l;
29 close $fd;
30 my ($ae, $an) = ($l[0] =~ /^(.*?) (.*)$/);
31 my ($ai) = $l[1];
32 my $msg = join("\n", splice(@l, 2));
33 # Up to three trailing newlines in case of no body.
34 chomp $msg; chomp $msg; chomp $msg;
36 my ($rf, $af, $mf) = ([], [], []);
37 open $fd, '-|', @gcmd, 'diff-tree', '--name-status', '-r', "$commit^", $commit
38 or die "cannot do git diff-tree: $! $?";
39 while (<$fd>) {
40 chomp;
41 my ($s, $file) = split(/\t/, $_);
42 if ($s eq 'M') {
43 push @$mf, $file;
44 } elsif ($s eq 'A') {
45 push @$af, $file;
46 } elsif ($s eq 'R') {
47 push @$rf, $file;
50 close $fd;
52 return {
53 "removed" => $rf,
54 "message" => $msg,
55 "added" => $af,
56 "timestamp" => $ai,
57 "modified" => $mf,
58 "url" => $Girocco::Config::gitweburl."/".$proj->{name}.".git/commit/".$commit,
59 "author" => { "name" => $an, "email" => $ae },
60 "id" => $commit
61 };
64 sub json {
65 my ($url, $proj, $user, $ref, $oldrev, $newrev) = @_;
67 my $pusher = {};
68 if ($user) {
69 $pusher = { "name" => $user->{name} };
70 if ($user->{name} ne 'mob') {
71 $pusher->{"email"} = $user->{email};
75 my $commits = [];
77 foreach my $commit (get_commits($proj, $ref, $oldrev, $newrev)) {
78 push @$commits, json_commit($proj, $commit);
81 # This is backwards-compatible with GitHub (except the GitHub-specific
82 # full project name construction sometimes performed in clients)
83 my $payload = encode_json {
84 "before" => $oldrev,
85 "after" => $newrev,
86 "ref" => $ref,
88 "repository" => {
89 "name" => $proj->{name},
90 # Girocco extension: full_name is full project name,
91 # equivalent to GitHub's "owner[name]/name".
92 "full_name" => $proj->{name}.".git",
94 "url" => $Girocco::Config::gitweburl.'/'.$proj->{name}.".git",
95 # Girocco extension: Pull URL.
96 "pull_url" => $Girocco::Config::gitpullurl.'/'.$proj->{name}.".git",
98 "owner" => { "name" => "", "email" => $proj->{email} }
101 # Girocco extension
102 "pusher" => $pusher,
104 "commits" => $commits
107 # print "$payload\n";
108 my $ua = LWP::UserAgent->new;
109 $ua->timeout(5);
110 $ua->post($url, { payload => $payload });
114 sub cia_commit {
115 my ($cianame, $proj, $branch, $commit) = @_;
117 my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
118 my $fd;
120 open $fd, '-|', @gcmd, 'log', '-1', '--pretty=format:%an <%ae>%n%at%n%s', $commit
121 or die "cannot do git log: $! $?";
122 my @l = <$fd>;
123 chomp @l;
124 close $fd;
125 foreach (@l) { s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; }
126 my ($a, $at, $subj) = @l;
128 my @f;
129 open $fd, '-|', @gcmd, 'diff-tree', '--name-status', '-r', "$commit^", $commit
130 or die "cannot do git diff-tree: $! $?";
131 while (<$fd>) {
132 chomp;
133 s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g;
134 my ($status, $file) = split(/\t/, $_);
135 push @f, $file;
137 close $fd;
139 my $rev = substr($commit, 0, 12);
141 my $msg = <<EOT;
142 <message>
143 <generator>
144 <name>Girocco::Notify</name>
145 <version>1.0</version>
146 </generator>
147 <source>
148 <project>$cianame</project>
150 if ($branch ne 'master') { # XXX: Check HEAD instead
151 $msg .= "<branch>$branch</branch>";
153 $msg .= "</source>\n";
154 $msg .= "<timestamp>$at</timestamp>\n";
155 $msg .= "<body><commit><author>$a</author><revision>$rev</revision>\n";
156 $msg .= "<url>$Girocco::Config::gitweburl/$proj->{name}.git/commit/$commit</url>\n";
157 $msg .= "<files>\n";
158 foreach (@f) { $msg .= "<file>$_</file>\n"; }
159 $msg .= "</files><log>$subj</log></commit></body></message>\n";
161 # print "$msg\n";
162 my $rpc_client = new RPC::XML::Client "http://cia.vc/RPC2";
163 my $rpc_request = RPC::XML::request->new('hub.deliver', $msg);
164 my $rpc_response = $rpc_client->send_request($rpc_request);
165 ref $rpc_response or print STDERR "XML-RPC Error: $RPC::XML::ERROR\n";
168 sub cia {
169 my ($cianame, $proj, $ref, $oldrev, $newrev) = @_;
171 # CIA notifications for branches only
172 my $branch = $ref;
173 $branch =~ s#^refs/heads/## or return;
175 foreach my $commit (get_commits($proj, $ref, $oldrev, $newrev)) {
176 cia_commit($cianame, $proj, $branch, $commit);
181 sub get_commits {
182 my ($proj, $ref, $oldrev, $newrev) = @_;
184 my @gcmd = ($Girocco::Config::git_bin, '--git-dir='.$proj->{path});
185 my $fd;
187 open $fd, '-|', @gcmd, 'for-each-ref', '--format=%(refname)', 'refs/heads/'
188 or die "cannot do git for-each-ref: $! $?";
189 my @refs = <$fd>;
190 chomp @refs;
191 @refs = grep { $_ ne $ref } @refs;
192 close $fd;
194 my @revlims;
195 if (@refs) {
196 open $fd, '-|', @gcmd, 'rev-parse', '--not', @refs
197 or die "cannot do git rev-list for revlims: $! $?";
198 @revlims = <$fd>;
199 chomp @revlims;
200 close $fd;
203 my $revspec = (($oldrev =~ /^0+$/) ? $newrev : "$oldrev..$newrev");
204 open $fd, '-|', @gcmd, 'rev-list', @revlims, $revspec
205 or die "cannot do git rev-list: $! $?";
206 my @revs = <$fd>;
207 chomp @revs;
208 close $fd;
210 return @revs;
214 sub ref_change {
215 my ($proj, $user, $ref, $oldrev, $newrev) = @_;
217 chdir($proj->{path});
219 # First, possibly send out various mails
220 if ($proj->{notifymail}) {
221 my $sender;
222 if ($user) {
223 if ($user->{name} eq 'mob') {
224 $sender = "The Mob User <$proj->{email}>";
225 } else {
226 $sender = "$user->{name} <$user->{email}>";
228 } else {
229 $sender = "$proj->{name} <$proj->{email}>";
231 system($Girocco::Config::basedir.'/taskd/mail.sh',
232 "$ref", "$oldrev", "$newrev", $proj->{name},
233 $sender)
234 and warn "mail.sh failed";
237 # Next, send JSON packet to given URL if enabled.
238 if ($proj->{notifyjson}) {
239 json($proj->{notifyjson}, $proj, $user, $ref, $oldrev, $newrev);
242 # Also send CIA notifications.
243 if ($proj->{notifycia}) {
244 cia($proj->{notifycia}, $proj, $ref, $oldrev, $newrev);