JIRA command-line client.

jcc.pl

#!/usr/bin/perl

# jcc: JIRA command-line client.

# http://docs.atlassian.com/jira/REST/latest/

use Data::Dumper;
use DateTime::Format::Strptime;
use DateTime::Format::Duration;
use IO::Socket::SSL;
use JSON;
use MIME::Base64;
use URI::Escape;

my $usage = "\nUsage: $0 " 
    . "<jira_user> <jira_pass> <command> [args...]\n\n";

# Needs at least two arguments
if (@ARGV < 3) { print $usage; exit 1; }
    
my $base_url = "https://mojang.atlassian.net/rest/api/latest";

$auth = encode_base64((shift @ARGV) . ':' . (shift @ARGV));

$auth =~ s/\n//g;

$command = shift @ARGV;

my $commands = {

  issue => sub {
  
    return Dumper(get_issue(@_)) if (@_ == 1);
    return put_issue(@_) if (@_ > 1);
    
    print "${usage}Issue key is required.\n\n";
    exit 1;
  
  },
  
  chk => sub {
  
    return put_issue(@_[0], 'CHK', 'set', 'now()');
  
  },
  
  countlinks => sub {
  
    my $issue = get_issue(@_[0]);
    
    return scalar @{$issue->{fields}->{issuelinks}} . "\n";
  
  },
  
  fixlinks => sub {
  
    fixlinks(@_[0]);
  
  },

};

my $json = JSON->new();
    
print $commands->{$command}(@ARGV) if ($commands->{$command});

exit 0;

sub show_errors {

  my $msg;

  my $response = shift;
  
  return if !$response;

  my $result = $json->decode($response);
  
  if ($result->{errorMessages}) {
  
    $msg = '';
  
    for my $message (@{$result->{errorMessages}}) {
    
      $msg .= "Server error: $message\n";
    
    }
    
    while (my ($k, $v) = each %{$result->{errors}}) {
    
      $msg .= "Field error ($k): $v\n";
    
    }
  
    print "$msg\n";
    exit 1;
    
  }

}


sub fixlinks {

  my ($project) = @_;
  
  my $last_key = '';
  
  while (1) {
  
    my $jql = "project=$project" 
        . ($last_key ? " and key > $last_key " : " ")
        .  "order by key asc";
    
    my ($header, $response, $code, $message) = https(
      GET => "$base_url/search/?jql=" . uri_escape($jql) 
          . "&fields=customfield_11100,issuelinks",
      [ "Authorization: Basic $auth" ]
    ) or die "Server returned no content";
    
    print "$message ($code)\n\n";
    exit 0 if $code != 200;
    
    my $result = $json->decode($response);
    
    exit 0 if !scalar @{$result->{issues}};
    
    for (@{$result->{issues}}) {
      my $key = $_->{key};
      my $linked_field = $_->{fields}->{customfield_11100} + 0;
      my $link_count = scalar @{$_->{fields}->{issuelinks}};
      $last_key = $key;
      print "$key ($linked_field/$link_count)\n";
      if ($linked_field + 0 != $link_count + 0) {
        put_issue($key, 'customfield_11100', 'set', $link_count);
      }
    }
    
  }

}

sub get_issue {

  my ($key) = @_;
  
  my ($header, $response, $code, $message) = https(
    GET => "$base_url/issue/$key",
    [ "Authorization: Basic $auth" ]
  ) or die "Server returned no content";
  
  print "$message ($code)\n\n";
  exit 0 if $code != 200;
  
  my $result = $json->decode($response);
  
  return $result;

}

sub put_issue {

  my ($key, $field, $action, $value) = @_;
  
  $value = '' if !$value;
  
  print "\n";
  
  # Needs 3 args.
  
  if (@_ < 3) {
    print "${usage}Update an issue: \n" 
        . "issue <key> <field> <action> [value]\n\n";
    exit 1;
  }
  
  # Get metadata with available fields for this issue
  
  print "Checking editable fields...\n";
  
  my $transition;
  
  my ($header, $response, $code, $message) = https(
    GET => "$base_url/issue/$key/editmeta",
    [ "Authorization: Basic $auth" ]
  ) or die "Server returned no field metadata";
  
  print "$message ($code)\n\n";
  exit 0 if $code != 200;
  
  $response = $json->decode($response);
  
  my ($field_key, $field_meta) = find_field($field, $response->{fields});
  
  print "$field ($field_key) is editable...\n" if $field_meta;
  
  # If we didn't find the field, look for it in transitions.
  
  if (!$field_meta) {
  
    print "Can't edit directly, checking transitions...\n";
  
    ($header, $response, $code, $message) = https(
      GET => "$base_url/issue/$key/transitions?expand=transitions.fields",
      [ "Authorization: Basic $auth" ]
    ) or die "Server returned no content";
    
    print "$message ($code)\n\n";
    exit 0 if $code != 200;
  
    $response = $json->decode($response);
    
    $transition = $response->{transitions}[0] 
        or die "Server returned no transitions";
    
    $transition->{name} =~ m/update/i 
        or die "Expected first transition to be an 'update' transition";
    
    # print Dumper($transition->{fields});
    
    ($field_key, $field_meta) = find_field($field, $transition->{fields});
    
    print "$field ($field_key) found in transitions...\n"
        if $field_meta;
    
  }
    
  # If we _still_ didn't find the field, give up.
  
  die "Field '$field' not found." if !$field_meta;
  
  # print Dumper($field_meta);
  
  # Allowed values can be objects. 
  # Get them from metadata if they match string value.
  
  if ($field_meta->{allowedValues}) {
  
    for my $v (@{$field_meta->{allowedValues}}) {
    
      if ($v->{name} && ($v->{name} =~ m/^\Q$value\E$/i) || 
          $v->{value} && ($v->{value} =~ m/^\Q$value\E$/i)) {
      
        $value = $v;
        
        last;
      
      }
    
    }
  
  }
  
  # Get the request ready.
  
  $value = format_now() if $value eq "now()"; 
  
  my $request = { 
    update => { $field_key => [ { $action => $value } ] } 
  };
  
  $request->{update}->{$field_key}[0]->{$action} += 0
    if $field_meta->{schema}->{type} eq 'number';
  
  if ($transition) {
    delete $transition->{fields};
    $request->{transition} = $transition;
  }
  
  my $data = encode_json($request);
  
  # Send the request.
  
  ($header, $response, $code, $message) = https(
    ($transition ? 'POST' : 'PUT'), 
    "$base_url/issue/$key" . ($transition ? '/transitions' : ''),
    [ "Content-Type: application/json", "Authorization: Basic $auth" ], 
    $data
  );

  print "$message ($code)\n\n";
  
  show_errors($response);
  
  # exit 0 if $code != 200;

}

sub find_field {
  my ($name, $fields) = @_;
    
  return ($name, $fields->{$name}) if $fields->{$name};
  
  while (my ($k, $v) = each %$fields) {
    return ( $k, $fields->{$k} )
        if (($k =~ m/^\Q$name\E$/i) || ($v->{name} =~ m/^\Q$name\E$/i));
  }
  
}

sub format_now {
  
  my $dp = DateTime::Format::Strptime->new(
      pattern => '%Y-%m-%dT%H:%M:%S.000%z'
  ); 
  
  return $dp->format_datetime(DateTime->now());
  
}

sub https {
  
  my ($action, $url, $headers, $body) = @_;
  
  my ($protocol, $domain) = $url =~ m#^(https?)://([^/]*)#i;
  
  die "Protocol is not https" if $protocol !~ m/^https$/i;
  
  my $socket = new  IO::Socket::SSL("$domain:https");

  return warn "Can't open socket to $domain.\n" if !$socket;

  my $length = $body ? length $body : 0;
  
  my $br = "\r\n"; # nothing to see here...
  
  my $header_data = $headers ? $br . join $br, @$headers : '';
  
  my $request = "$action $url HTTP/1.0$header_data$br"
      . ($length ? "Content-Length: $length$br$br$body" : $br);
  
  my $response;
  
  #print "Request:\n\n$request\n\n";
    
  print $socket $request;
  
  $socket->read($response);  
  
  close $socket;
  
  #print "Response:\n\n$response\n\n";
  
  $response =~ s/(.*)$br$br//ms; # strip the headers from the response
  $header = $1;
  
  $header =~ m/^HTTP[^\s]+\s([^\s]*)\s(.*)\r/;
  
  return wantarray ? ( $header, $response, $1, $2 ) : $response;

}