1 package Girocco
::Notify
;
13 # This Perl code creates json payload within post-receive hook.
16 my ($proj, $commit) = @_;
18 my @gcmd = ($Girocco::Config
::git_bin
, '--git-dir='.$proj->{path
});
21 open $fd, '-|', @gcmd, 'log', '-1', '--pretty=format:%ae %an%n%ai%n%s%n%n%b', $commit
22 or die "cannot do git log: $! $?";
26 my ($ae, $an) = ($l[0] =~ /^(.*?) (.*)$/);
28 my $msg = join("\n", splice(@l, 2));
29 # Up to three trailing newlines in case of no body.
30 chomp $msg; chomp $msg; chomp $msg;
32 my ($rf, $af, $mf) = ([], [], []);
33 open $fd, '-|', @gcmd, 'diff-tree', '--name-status', '-r', "$commit^", $commit
34 or die "cannot do git diff-tree: $! $?";
37 my ($s, $file) = split(/\t/, $_);
54 "url" => $Girocco::Config
::gitweburl
."/".$proj->{name
}.".git/commit/".$commit,
55 "author" => { "name" => $an, "email" => $ae },
61 my ($url, $proj, $user, $ref, $oldrev, $newrev) = @_;
65 $pusher = { "name" => $user->{name
} };
66 if ($user->{name
} ne 'mob') {
67 $pusher->{"email"} = $user->{email
};
73 foreach my $commit (get_commits
($proj, $ref, $oldrev, $newrev)) {
74 push @
$commits, json_commit
($proj, $commit);
77 # This is backwards-compatible with GitHub (except the GitHub-specific
78 # full project name construction sometimes performed in clients)
79 my $payload = encode_json
{
85 "name" => $proj->{name
},
86 # Girocco extension: full_name is full project name,
87 # equivalent to GitHub's "owner[name]/name".
88 "full_name" => $proj->{name
}.".git",
90 "url" => $Girocco::Config
::gitweburl
.'/'.$proj->{name
}.".git",
91 # Girocco extension: Pull URL.
92 "pull_url" => $Girocco::Config
::gitpullurl
.'/'.$proj->{name
}.".git",
94 "owner" => { "name" => "", "email" => $proj->{email
} }
100 "commits" => $commits
103 # print "$payload\n";
104 my $ua = LWP
::UserAgent
->new;
106 $ua->post($url, { payload
=> $payload });
111 my ($cianame, $proj, $branch, $commit) = @_;
113 my @gcmd = ($Girocco::Config
::git_bin
, '--git-dir='.$proj->{path
});
116 open $fd, '-|', @gcmd, 'log', '-1', '--pretty=format:%an <%ae>%n%at%n%s', $commit
117 or die "cannot do git log: $! $?";
121 foreach (@l) { s/&/&/g; s/</</g; s/>/>/g; }
122 my ($a, $at, $subj) = @l;
125 open $fd, '-|', @gcmd, 'diff-tree', '--name-status', '-r', "$commit^", $commit
126 or die "cannot do git diff-tree: $! $?";
129 s/&/&/g; s/</</g; s/>/>/g;
130 my ($status, $file) = split(/\t/, $_);
135 my $rev = substr($commit, 0, 12);
140 <name>Girocco::Notify</name>
141 <version>1.0</version>
144 <project>$cianame</project>
146 if ($branch ne 'master') { # XXX: Check HEAD instead
147 $msg .= "<branch>$branch</branch>";
149 $msg .= "</source>\n";
150 $msg .= "<timestamp>$at</timestamp>\n";
151 $msg .= "<body><commit><author>$a</author><revision>$rev</revision>\n";
152 $msg .= "<url>$Girocco::Config::gitweburl/$proj->{name}.git/commit/$commit</url>\n";
154 foreach (@f) { $msg .= "<file>$_</file>\n"; }
155 $msg .= "</files><log>$subj</log></commit></body></message>\n";
159 use RPC
::XML
::Client
;
161 my $rpc_client = new RPC
::XML
::Client
"http://cia.vc/RPC2";
162 my $rpc_request = RPC
::XML
::request
->new('hub.deliver', $msg);
163 my $rpc_response = $rpc_client->send_request($rpc_request);
164 ref $rpc_response or print STDERR
"XML-RPC Error: $RPC::XML::ERROR\n";
168 my ($cianame, $proj, $ref, $oldrev, $newrev) = @_;
170 # CIA notifications for branches only
172 $branch =~ s
#^refs/heads/## or return;
174 foreach my $commit (get_commits
($proj, $ref, $oldrev, $newrev)) {
175 cia_commit
($cianame, $proj, $branch, $commit);
181 my ($proj, $ref, $oldrev, $newrev) = @_;
183 my @gcmd = ($Girocco::Config
::git_bin
, '--git-dir='.$proj->{path
});
186 open $fd, '-|', @gcmd, 'for-each-ref', '--format=%(refname)', 'refs/heads/'
187 or die "cannot do git for-each-ref: $! $?";
188 my @refs = grep { $_ ne $ref } <$fd>;
194 open $fd, '-|', @gcmd, 'rev-list', '--not', @refs
195 or die "cannot do git rev-list for revlims: $! $?";
201 my $revspec = (($oldrev =~ /^0+$/) ?
$newrev : "$oldrev..$newrev");
202 open $fd, '-|', @gcmd, 'rev-list', @revlims, $revspec
203 or die "cannot do git rev-list: $! $?";
213 my ($proj, $user, $ref, $oldrev, $newrev) = @_;
215 chdir($proj->{path
});
217 # First, possibly send out various mails
218 if ($proj->{notifymail
}) {
221 if ($user->{name
} eq 'mob') {
222 $sender = "The Mob User <$proj->{email}>";
224 $sender = "$user->{name} <$user->{email}>";
227 $sender = "$proj->{name} <$proj->{email}>";
229 system($Girocco::Config
::basedir
.'/taskd/mail.sh',
230 "$ref", "$oldrev", "$newrev", $proj->{name
},
232 and warn "mail.sh failed";
235 # Next, send JSON packet to given URL if enabled.
236 if ($proj->{notifyjson
}) {
237 json
($proj->{notifyjson
}, $proj, $user, $ref, $oldrev, $newrev);
240 # Also send CIA notifications.
241 if ($proj->{notifycia
}) {
242 cia
($proj->{notifycia
}, $proj, $ref, $oldrev, $newrev);