Slash Boxes
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

rjbs (4671)

  (email not shown publicly)
AOL IM: RicardoJBSignes (Add Buddy, Send Message)
Yahoo! ID: RicardoSignes (Add User, Send Message)

I'm a Perl coder living in Bethlehem, PA and working Philadelphia. I'm a philosopher and theologan by training, but I was shocked to learn upon my graduation that these skills don't have many associated careers. Now I write code.

Journal of rjbs (4671)

Thursday April 17, 2008
10:15 PM

syncing all my git repositories

[ #36184 ]

Inspired by my recent adventures in on-plane USB flash drive git repository swapping, I ordered a USB storage device. It seemed like getting a micro SD reader would be fairly multipurpose and expandable, so I ordered a teeny tiny micro SD reader that came with a 2 GB card and adapters for mini and regular SD. This thing is tiny. If I put a quarter on top of it, you can barely see it.

The next task, of course, was to make it really easy to clone all my work onto it, both for easy access and for use as a swappable git repository in dire situations, like the flight to YAPC. I threw this program together. It's rough around the edges, but I imagine that it will be very useful in the future, and that I might expand its features a bit for more general use.

use strict;
use warnings;
use Path::Class;

my $ROOT = dir("/Volumes/RJBS-KEY");

print "key drive not mounted; skipping\n", exit unless -d $ROOT;

my %remote = (
  'code/projects' => [ ''   => '/git/*'        ],
  'rjbs/code'     => [ '' => 'git/code'      ],
  'rjbs/conf'     => [ '' => 'git/conf'      ],
  'rjbs/talks'    => [ '' => 'git/talks/*'   ],
  'rjbs/writing'  => [ '' => 'git/writing/*' ],

sub clone_from_to {
  my ($remote, $path) = @_;

  my ($remote_leaf) = $path =~ m{/?([^/]+)/?\z};

  my ($local_root, $local_leaf) = $remote =~ m{(.+)/([^/]+)\z};

  my $is_starry = $remote{$remote}->[1] =~ m{\*\z};

  my $clone_in = $is_starry
               ? $ROOT->subdir($remote)
               : $ROOT->subdir($local_root);

  my $pull_in = $clone_in->subdir($remote_leaf);

  my $prefix = $pull_in->relative($ROOT);

  if (-d $pull_in) {
    chdir $pull_in;
    print "$prefix: $_" for `git pull -q`;
  } else {
    chdir $clone_in;
    my $host = $remote{$remote}->[0];
    my $root = $path =~ m{^/} ? '' : '/~rjbs/';
    $path =~ s/ /\\ /g;
    my $url = "ssh://$host$root$path";
    print "$prefix: $_" for `git clone -q $url`;

for my $remote (keys %remote) {
  my ($host, $path) = @{ $remote{$remote} };

  my @dirs;
  if ($path =~ m{(.+/)\*\z}) {
    $path = $1;
    @dirs =`ssh $host find $path -type d -mindepth 1 -maxdepth 1`;
    chomp @dirs;
  } else {
    @dirs = $path;

  clone_from_to($remote, $_) for sort @dirs;

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
More | Login | Reply
Loading... please wait.