clone.pl

#!/usr/bin/env perl
use strict;
use warnings;
use URI;
use Digest::SHA1 qw/sha1_hex/;
use File::Path qw/make_path/;

my %hook;
my @repo = @ARGV or die "Usage: $0 <repo>..\n";

add_hook(
    'on_pull',
    sub {
        my $repo = shift;
        print "pulled $repo\n";
    }
);

for my $repo (@repo) {
    run('on_pull', $repo) if pull($repo);
}

sub add_hook {
    my ($name, $callback) = @_;
    push @{ $hook{$name} ||= [] }, $callback;
}

sub run {
    my ($name, @args) = @_;
    if ($hook{$name}) {
        for my $hook (@{ $hook{$name} }) {
            $hook->(@args);
        }
    }
}

sub pull {
    my $repo = shift;
    my $uri = URI->new($repo);    # git://github.com/aanoaa/Hubot-Scripts-standup.git
    if ($uri->scheme ne 'git') {
        print STDERR "only permit git scheme: $uri\n";
        return;
    }

    if ($uri->opaque !~ m/github\.com/) {
        print STDERR "only permit github domain: $uri\n";
        return;
    }

    my $digest = substr(sha1_hex($uri), 0, 7);
    my $rt;
    if (-d $digest) {
        chdir $digest;
        $rt = system "git pull";
        chdir '..';
    } else {
        $rt = system "git clone $repo $digest";
        make_path("../logs/$digest");
        symlink '../master.ini', "../conf/$digest.ini";
        symlink "../gits/$digest/public", "../root/$digest";
    }

    return $rt == 0;
}