use strict;
NAMESYNOPSISDESCRIPTIONFILESYSTEM LAYOUT4C<user>C<pass>C<url>C<pristine>C<etags>BUGS4************COPYRIGHT
use LWP::UserAgent;
use HTTP::Request;
use URI;
my $sample_url = 'http://www.socialtext.net/st-rest-docs';
{
package Dir;
sub new {
my ($class, $dir) = @_;
return bless { dir => $dir }, $class;
}
sub create {
my ($self) = @_;
mkdir $self->{dir} or die "Can't create directory $self->{dir}: $!";
}
sub _join {
my ($dir, $filename) = @_;
return "$dir/$filename";
}
sub child {
my ($self, $filename) = @_;
return _join($self->{dir}, $filename);
}
sub _read_file {
my ($fn) = @_;
open my $fh, '<', $fn or die "Couldn't open $fn: $!";
return do { local $/; <$fh> }
}
sub _write_file {
my ($fn, $content) = @_;
my $fn_new = "$fn.new.$$";
eval {
open my $fh, '>', $fn_new or die "Couldn't open $fn_new: $!";
print $fh $content or die "Couldn't write to $fn_new: $!";
close $fh or die "Couldn't write to $fn_new: $!";
rename $fn_new, $fn or die "Couldn't rename $fn_new to $fn: $!";
};
unlink $fn_new;
die $@ if $@;
}
sub get {
my ($self, $filename) = @_;
return _read_file($self->child($filename));
}
sub set {
my ($self, $filename, $content) = @_;
return _write_file($self->child($filename), $content);
}
sub has {
my ($self, $filename) = @_;
return -e $self->child($filename);
}
sub subdir {
my ($self, $subdirname) = @_;
return Dir->new($self->child($subdirname));
}
sub filenames {
my ($self) = @_;
opendir my $dh, $self->{dir};
return grep { $_ ne '.' and $_ ne '..' } readdir $dh;
}
sub pathnames {
my ($self) = @_;
return map { $self->child($_) } $self->filenames;
}
}
{
package Page;
sub new {
my ($class, $response) = @_;
return bless { resp => $response }, $class;
}
sub content {
my ($self) = @_;
return $self->{resp}->content;
}
sub etag {
my ($self) = @_;
my $etag = $self->{resp}->header('ETag');
die "No ETag for page: " . $self->content if not defined $etag;
return $etag;
}
}
{
package Client;
use JSON qw();
sub new {
my ($class, $url, $user, $pass) = @_;
my $uo = URI->new($url);
my $local = $uo->path;
unless ($local =~ m@\A/([^/]+)\Z@) {
die "Couldn't parse URL $local --- should be something like $sample_url\n";
}
my $workspace_name = $1;
my $ua = LWP::UserAgent->new;
$ua->credentials($uo->host_port, "Socialtext", $user, $pass);
return bless {
url_obj => $uo,
workspace => $workspace_name,
user => $user,
pass => $pass,
ua => $ua,
}, $class;
}
sub new_from_dir {
my ($class, $dirname) = @_;
my $dir = Dir->new($dirname);
my $conf = $dir->subdir('.st'); my $self = $class->new($conf->get('url'),
$conf->get('user'),
$conf->get('pass'));
$self->{dir} = $dir;
return $self;
}
sub conf {
my ($self) = @_;
return $self->{dir}->subdir('.st');
}
sub pristine {
my ($self) = @_;
return $self->conf->subdir('pristine');
}
sub etags {
my ($self) = @_;
return $self->conf->subdir('etags');
}
sub data_url {
my ($self, $trailing_path) = @_;
my $uo = $self->{url_obj}->clone;
$uo->path("/data/workspaces/$self->{workspace}/$trailing_path");
return $uo;
}
sub http_get {
my ($self, $url, $content_type) = @_;
my $req = HTTP::Request->new(GET => $url->as_string);
$req->header(Accept => $content_type);
my $resp = $self->{ua}->request($req);
die "HTTP request failure: " . $resp->as_string if $resp->is_error;
return $resp;
}
sub get_json_data {
my ($self, $trailing_path) = @_;
my $resp = $self->http_get($self->data_url($trailing_path),
'application/json');
return JSON::jsonToObj($resp->content);
}
sub get_page {
my ($self, $page_id) = @_;
return Page->new($self->http_get($self->data_url("pages/$page_id"),
'text/x.socialtext-wiki'));
}
@socialtext
sub list_pages {
my ($self) = @_;
return @{$self->get_json_data('pages')};
}
sub outdated_files {
my ($self) = @_;
my @filenames = $self->etags->filenames;
my %revision_ids = ();
foreach my $page ($self->list_pages) {
$revision_ids{$page->{page_id}} = $page->{revision_id};
}
return grep { not $self->etags->has($_) or
$self->etags->get($_) ne $revision_ids{$_} }
keys %revision_ids;
}
sub updated {
my ($self, $id, $resp) = @_;
$self->pristine->set($id => $resp->content);
$self->etags->set($id => $resp->etag);
}
sub update_page {
my ($self, $id) = @_;
print "U $id\n";
my $resp = $self->get_page($id);
$self->{dir}->set($id => $resp->content);
$self->updated($id => $resp);
return $resp;
}
sub create_dir {
my ($self) = @_;
$self->{dir} = Dir->new($self->{workspace});
if (-e $self->{workspace}) {
die "The subdirectory '$self->{workspace}' already exists here.\n";
}
$self->{dir}->create();
$self->conf->create();
$self->conf->set(user => $self->{user});
$self->conf->set(pass => $self->{pass});
$self->conf->set(url => $self->{url_obj}->as_string);
$self->pristine->create();
$self->etags->create();
for my $page ($self->list_pages) {
my $resp = $self->update_page($page->{page_id});
my $etag = $resp->etag;
die "ETag for page $page->{page_id} is $etag " .
"but should be $page->{revision_id}"
if $etag ne $page->{revision_id};
}
}
sub merge_updates {
my ($self, $filename) = @_;
my $tmpname = ".tmp.$$";
my $newfile = ".tmp2.$$";
eval {
my $page = $self->get_page($filename);
$self->{dir}->set($tmpname, $page->content); open(my $pipe, '-|',
'diff3', '-m', $filename,
$self->pristine->child($filename),
$tmpname) or die "Can't open pipe: $!";
open my $newfh, '>', $newfile or die "Can't open $newfile: $!";
while (<$pipe>) {
print $newfh $_;
}
if (not close $pipe) {
die "popen of diff3 failed: $!" if $! != 0;
warn "diff3 exited with $?."
}
close $newfh or die "Couldn't write to $newfile: $!";
rename $newfile, $filename;
$self->updated($filename => $page);
};
unlink $tmpname;
unlink $newfile;
die $@ if $@;
}
sub modified_files {
my ($self) = @_;
return grep { $self->{dir}->get($_) ne $self->pristine->get($_) }
$self->pristine->filenames;
}
sub commit_file {
my ($self, $filename) = @_;
my $data = $self->{dir}->get($filename);
my $req = HTTP::Request->new(PUT => $self->data_url("pages/$filename"));
$req->header("If-Match" => $self->etags->get($filename));
$req->header("Content-Type" => "text/x.socialtext-wiki");
$req->header("Content-Length" => length $data);
$req->content($data);
my $response = $self->{ua}->request($req);
if ($response->is_error) {
die "Error uploading new version of $filename: " . $response->as_string;
}
$self->update_page($filename);
}
}
sub ask {
my ($string) = @_;
print $string;
my $result = <STDIN>;
chomp $result;
return $result;
}
sub checkout {
my ($url) = @_;
die_with_usage() if not $url;
my $user = ask('Email address you use for your Socialtext account: ');
my $pass = ask('Socialtext password (will be echoed): ');
my $client = Client->new($url, $user, $pass);
$client->create_dir();
}
sub diff {
my (@flags) = @_;
@flags = qw(-u) if not @flags; foreach my $filename (Client->new_from_dir('.')->pristine->pathnames) {
system 'diff', @flags, $filename, '.';
}
}
sub update {
my $client = Client->new_from_dir('.');
foreach my $filename ($client->outdated_files) {
$client->merge_updates($filename);
print "M $filename\n";
}
}
sub commit {
my $client = Client->new_from_dir('.');
my @files = $client->outdated_files;
if (@files) {
for my $filename (@files) {
print "M $filename\n";
}
die "Bring the above files up-to-date with $0 update before committing.\n";
}
foreach my $filename ($client->modified_files) {
$client->commit_file($filename);
print "! $filename\n";
}
}
sub die_with_usage {
die <<EOF;
$0: usage: one of the following:
$0 checkout $sample_url
$0 diff
$0 update
$0 commit
EOF}
my %cmds = (
co => \&checkout, checkout => \&checkout,
di => \&diff, diff => \&diff,
up => \&update, update => \&update,
ci => \&commit, commit => \&commit,
);
my $cmd = shift @ARGV;
die_with_usage if not $cmd or not $cmds{$cmd};
$cmds{$cmd}->(@ARGV);