Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Auto updating magics

  • Loading branch information...
commit 43614198ddacc7abce3eacfaa4fac9e3c835b0c3 1 parent 1cb30ea
@dgl authored
Showing with 37 additions and 0 deletions.
  1. +5 −0 etc/config
  2. +32 −0 lib/WWW/CPANGrep.pm
View
5 etc/config
@@ -1,3 +1,8 @@
+[Update]
+ ; Set to 'live' on the live site (a manually maintained tag), else follow
+ ; master (for http://a.grep.cpan.me)
+ Ref = origin/master
+
[Location]
CPAN = fakecpan-sampler-0.001
Slabs = var/slabs
View
32 lib/WWW/CPANGrep.pm
@@ -55,6 +55,10 @@ sub dispatch_request {
sub (/about) {
HTML::Zoom->from_file(TMPL_PATH . "/about.html")
},
+ sub (/githook) {
+ _maybe_update();
+ HTML::Zoom->from_file(TMPL_PATH . "/about.html")
+ },
sub (/) {
# XXX: Fix me if this ever becomes an overhead
my $redis = AnyEvent::Redis->new(host => $config->{"server.queue"});
@@ -170,4 +174,32 @@ sub _render_snippet {
$html ||= "";
}
+sub _maybe_update {
+ # Slightly scary in place updating. Note there is no auth for now, someone could DoS us a
+ # bit, but not much else.
+ return unless -d ".git";
+
+ my $ref = $config->{"update.ref"};
+ return unless $ref;
+
+ my $sha1 = _get_commit_id($ref);
+
+ system "git", "fetch", "-t", "origin";
+
+ # New code?
+ if(_get_commit_id($ref) ne $sha1) {
+ system "git", "merge", "HEAD", $ref;
+ }
+}
+
+sub _get_commit_id {
+ my($ref) = @_;
+
+ my $pid = open my $fh, "-|", qw(git log --format=%H -1), $ref or return;
+ my($id) = <$fh> =~ /(\S+)/;
+ waitpid $pid, 0;
+
+ return $id;
+}
+
WWW::CPANGrep->run_if_script;
Please sign in to comment.
Something went wrong with that request. Please try again.