#!/usr/bin/env perl
package WWW::Jenkins::Job;

#  Copyright 2012 Netflix, Inc.
#
#     Licensed under the Apache License, Version 2.0 (the "License");
#     you may not use this file except in compliance with the License.
#     You may obtain a copy of the License at
#
#         http://www.apache.org/licenses/LICENSE-2.0
#
#     Unless required by applicable law or agreed to in writing, software
#     distributed under the License is distributed on an "AS IS" BASIS,
#     WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#     See the License for the specific language governing permissions and
#     limitations under the License.

use strict;
use warnings;

sub new {
    my $class = shift;
    my $self = bless { @_ }, $class;
    for my $required ( qw(name jenkins url color) ) {
        defined $self->{$required} || die "no $required parameter to WWW::Jenkins::Job->new()";
    }
    $self->{inQueue} ||= 0;
    return $self;
}

sub copy {
    my ( $self ) = shift;
    return bless { %$self, @_ }, ref($self);
}

sub j {
    return shift->{jenkins};
}

sub ua {
    return shift->j->{ua};
}

sub name {
    return shift->{"name"};
}

# turns the jenkins 'color' attribute into a color
# suitable for encoding in Term::ANSIColor.
# All aborted builds are marked as red
# ... these are the options we have to work with in ANSIColor
# attributes: reset, bold, dark, faint, underline, blink, reverse and concealed.
# foreground: black, red, green, yellow, blue, magenta, cyan and white.
# background: on_black, on_red, on_green, on_yellow, on_blue, on_magenta, on_cyan and on_white

sub color {
    my ( $self ) = @_;
    my $color = $self->{color};
    $color =~ s/_anime$//;
    $color = "green" if $self->j->{stoplight} && $color eq 'blue';
    $color = 'faint' if $color eq 'disabled';
    $color = 'red'   if $color eq 'aborted';
    $color = 'faint' if $color eq 'grey';
    $color = 'faint' if $color eq 'notbuilt';
    return $color;
}

sub number {
    my ( $self ) = @_;
    my $lb = $self->{lastBuild} ||= {};
    return $lb->{number} if defined $lb->{number};

    if( defined $lb->{url} ) {
        my ( $num ) = ( $lb->{url} =~ m{/(\d+)/?$} );
        return $lb->{number} = $num if defined $num;
    }
    $self->_load_lastBuild;
    return $lb->{number};
}

sub started {
    my ( $self ) = shift;
    my $lb = $self->{lastBuild} ||= {};
    return $lb->{timestamp} / 1000 if defined $lb->{timestamp};
    $self->_load_lastBuild;
    return $lb->{timestamp} / 1000;
}

sub duration {
    my ( $self ) = shift;
    my $lb = $self->{lastBuild} ||= {};
    return $lb->{duration} / 1000 if defined $lb->{duration};
    $self->_load_lastBuild;
    return $lb->{duration} / 1000;
}

sub _load_lastBuild {
    my ( $self ) = shift;
    my $uri = "$self->{url}/api/json?depth=0&tree=lastBuild[url,duration,timestamp,number]";
    my $res = $self->ua->get($uri);
    my $data = WWW::Jenkins::parse_json($res->decoded_content());
    return %{$self->{lastBuild}} = %{$data->{lastBuild}};
}

sub start {
    my ( $self, $params ) = @_;
    $self->j->login();
    my @params;
    if ( $self->{actions} ) {
        for my $action ( @{$self->{actions}} ) {
            if ( exists $action->{parameterDefinitions} ) {
                for my $param ( @{$action->{parameterDefinitions}} ) {
                    if ( exists $params->{$param->{name}} ) {
                        push @params, { "name" => $param->{name}, "value" => $params->{$param->{name}} };
                    }
                    else {
                        push @params, { "name" => $param->{name}, "value" => $param->{defaultParameterValue}->{value} };
                    }
                }
            }
        }
    }
    my $resp = $self->ua->post("$self->{url}/build", {delay => "0sec", json=> WWW::Jenkins::encode_json({"parameter" => \@params})});
    if( $resp->is_error ) {
        die "Failed to start $self->{name}, got error: " . $resp->status_line;
    }
    return 1;
}

sub stop {
    my ( $self ) = @_;

    die "job " . $self->name() . " has never been run"
        unless $self->{lastBuild};

    # dont stop something not running
    return 1 unless $self->is_running();

    $self->j->login();
    my $resp = $self->ua->post("$self->{lastBuild}->{url}/stop", {});
    if( $resp->is_error ) {
        die "Failed to stop $self->{name}, got error: " . $resp->status_line;
    }
    return 1;
}

sub is_running {
    my ( $self ) = @_;
    return $self->{color} =~ /_anime/ ? 1 : 0;
}

sub is_queued {
    my ( $self ) = @_;
    return $self->{inQueue} ? 1 : 0;
}

sub was_aborted {
    my ( $self ) = @_;
    return $self->{color} eq 'aborted';
}

sub wipeout {
    my ( $self ) = @_;
    $self->j->login();
    my $resp = $self->ua->post("$self->{url}/doWipeOutWorkspace", {});
    if( $resp->is_error ) {
        die "Failed to wipeout $self->{name}, got error: " . $resp->status_line;
    }
    return 1;
}

sub logCursor {
    my ( $self ) = @_;
    die "job " . $self->name() . " has never been run"
        unless $self->{lastBuild};
    my $res = undef;
    return sub {
        if( !$res ) {
            $res = $self->ua->post(
                "$self->{lastBuild}->{url}/logText/progressiveText", { start => 0 }
            )
        }
        elsif( $res->header("X-More-Data") && $res->header("X-More-Data") eq 'true' ) {
            $res = $self->ua->post(
                "$self->{lastBuild}->{url}/logText/progressiveText", { 
                    start => $res->header("X-Text-Size")
                }
            );
        }
        else {
            # there was a previous response but X-More-Data not set, so we are done
            return undef;
        }
        return $res->decoded_content || "";
    }
}

sub disable {
    my ( $self ) = @_;
    $self->j->login();
    my $resp = $self->ua->post("$self->{url}/disable", {});
    if( $resp->is_error ) {
        die "Failed to disable $self->{name}, got error: " . $resp->status_line;
    }
    return 1;
}

sub enable {
    my ( $self ) = @_;
    $self->j->login();
    my $resp = $self->ua->post("$self->{url}/enable", {});
    if( $resp->is_error ) {
        die "Failed to enable $self->{name}, got error: " . $resp->status_line;
    }
    return 1;
}

sub config {
    my ( $self, $content ) = @_;
    $self->j->login();
    my $url = "$self->{url}/config.xml";
    my $resp;
    if( $content ) {
        my $req =  HTTP::Request->new("POST", $url);
        $req->content($content);
        $resp = $self->ua->request($req);
    }
    else {
        $resp = $self->ua->get($url, {});
    }
    if( $resp->is_error ) {
        die "Failed get/set config.xml for $self->{name}, got error: " . $resp->status_line;
    }
    return $resp->decoded_content();
}

sub millis {
    eval "use Time::HiRes";
    if( $@ ) {
        return time() * 1000;
    }
    else {
        return Time::HiRes::time() * 1000
    }
}
        
    

sub history {
    my ( $self ) = @_;
    my $res = $self->ua->get("$self->{url}/api/json?depth=11&tree=builds[result,url,number,building,timestamp,duration]");
    my $data = WWW::Jenkins::parse_json($res->decoded_content());
    my @out;
    for my $build ( @{$data->{builds}} ) {
        my $color;
        if( $build->{building} ) {
            $color = $self->{color};
            $build->{duration} ||=  $self->millis  - $build->{timestamp}
        }
        else {
            $color = 
                $build->{result} =~ /SUCCESS/ ? "blue"    :
                $build->{result} =~ /ABORTED/ ? "aborted" :
                $build->{result} =~ /FAILURE/  ? "red"     :
                                                "grey"    ;
        }
        warn("unknown result: $build->{result}\n") if $color eq 'grey';
        push @out, $self->copy(
            color => $color,
            inQueue => 0,
            lastBuild => $build,
        );
    }
    return wantarray ? @out : \@out;
}

1;
package WWW::Jenkins::Node;

#  Copyright 2012 Netflix, Inc.
#
#     Licensed under the Apache License, Version 2.0 (the "License");
#     you may not use this file except in compliance with the License.
#     You may obtain a copy of the License at
#
#         http://www.apache.org/licenses/LICENSE-2.0
#
#     Unless required by applicable law or agreed to in writing, software
#     distributed under the License is distributed on an "AS IS" BASIS,
#     WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#     See the License for the specific language governing permissions and
#     limitations under the License.

use strict;
use warnings;

sub new {
    my $class = shift;
    my $self = bless { @_ }, $class;
    for my $required ( qw(name jenkins) ) {
        defined $self->{$required} || die "no $required parameter to WWW::Jenkins::Node->new()";
    }
    $self->{url} ||= $self->j->{baseuri} . "/computer/$self->{name}";

    $self->{color} = $self->{offline} ? "red" : "green";
    my $busy = 0;
    for my $exec ( @{$self->{executors}} ) {
        $busy++ unless $exec->{idle};
    }
    $self->{offline} = $self->{offline};
    $self->{temporarilyOffline} = $self->{temporarilyOffline};
    $self->{busy} = $busy;
    $self->{executors} = $self->{numExecutors};
    return $self;
}

sub name {
    return shift->{"name"};
}

sub is_running {
    return shift->{busy};
}

sub offline {
    return shift->{offline};
}

sub tempOffline {
    return shift->{temporarilyOffline};
}

sub toggleOffline {
    my $self = shift;
    my $resp = $self->ua->post("$self->{url}/toggleOffline", {offlineMessage => ""});
    if( $resp->is_error ) {
        die "Failed to toggleOffline $self->{name}, got error: " . $resp->status_line;
    }
    return 1;
}

sub remove {
    my $self = shift;
    my $resp = $self->ua->post("$self->{url}/doDelete", {});
    if( $resp->is_error ) {
        die "Failed to nodeDelete $self->{name}, got error: " . $resp->status_line;
    }
    return 1;
}

*copy = *WWW::Jenkins::Job::copy;
*j = *WWW::Jenkins::Job::j;
*ua = *WWW::Jenkins::Job::ua;
*color = *WWW::Jenkins::Job::color;

if ( 0 ) {  # fixed use only once nonsense
    copy(); j(); ua(); color();
}
package WWW::Jenkins;
use strict;
use warnings;
#  Copyright 2012 Netflix, Inc.
#
#     Licensed under the Apache License, Version 2.0 (the "License");
#     you may not use this file except in compliance with the License.
#     You may obtain a copy of the License at
#
#         http://www.apache.org/licenses/LICENSE-2.0
#
#     Unless required by applicable law or agreed to in writing, software
#     distributed under the License is distributed on an "AS IS" BASIS,
#     WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#     See the License for the specific language governing permissions and
#     limitations under the License.

use LWP::UserAgent qw();
use HTTP::Cookies qw();
use HTTP::Request qw();
use Carp qw(croak);
use URI;

our @CLEANUP;

sub new {
    my $class = shift;
    my $self = bless {
        # defaults
        stoplight => 0,
        user      => $ENV{USER},
        @_
    }, $class;

    my $UA = $self->{verbose}
        ? "WWW::Jenkins::UserAgent"
        : "LWP::UserAgent";
    
    $self->{baseuri} || die "baseuri option required";

    
    
    $self->{ua} ||= $UA->new(
        cookie_jar => HTTP::Cookies->new(
            file => "$ENV{HOME}/.$self->{user}-".URI->new($self->{baseuri})->host()."-cookies.txt",
            autosave => 1,
        ),
        ssl_opts => {
            SSL_verify_callback => sub { 1 },
            $self->{ssl_opts} ? %{$self->{ssl_opts}} : ()
        }
    );

    return $self;
}

sub create {
    my ($self, $job, $config) = @_;
    if( ref($job) ) {
        return $job->config($config);
    }

    $self->login();
    my $req =  HTTP::Request->new("POST", "$self->{baseuri}/createItem?name=$job");
    $req->header("Content-Type" => "application/xml");
    $req->content($config);
    my $resp = $self->{ua}->request($req);
    if( $resp->is_error ) {
        die "Failed to create new job $job, got error: " . $resp->as_string;
    }
}

sub search {
    my ($self, $filter) = @_;
    my $uri = "$self->{baseuri}/api/json?tree=jobs[name]";
    my $res = $self->{ua}->get($uri);
    my @out = ();
    if( $res->is_success ) {
        my $data = parse_json($res->decoded_content());
        @out = grep { /$filter/ } map { $_->{name} } @{$data->{jobs}};
    }
    return wantarray ? @out : \@out;
}
    
sub jobs {
    my ($self,@jobs) = @_;
    
    my @out = ();
    for my $job ( @jobs ) {
        my $uri = "$self->{baseuri}/job/$job/api/json?depth=0&tree=name,inQueue,url,lastBuild[number,url],color,actions[parameterDefinitions[defaultParameterValue[value],name]]";
        my $res = $self->{ua}->get($uri);
        if( $res->is_success ) {
            my $data = parse_json($res->decoded_content());
            push @out, WWW::Jenkins::Job->new(%$data, jenkins => $self);
        }
    }
    return wantarray ? @out : \@out;
}

sub nodes {
    my ($self, $label)  = @_;
    $self->login();
    my @out = ();
    my $uri = "$self->{baseuri}/computer/(master)/config.xml";
    my $res = $self->{ua}->get($uri);
    if( $res->is_success ) {
        my $xml = $res->decoded_content();

        my $res = $self->{ua}->get("$self->{baseuri}/computer/api/json?depth=1&tree=computer[displayName,executors[idle],numExecutors,offline,temporarilyOffline]");
        my $data = WWW::Jenkins::parse_json($res->decoded_content);
        my %nodeData = map { $_->{displayName} => $_ } @{$data->{computer}};
        #print "$xml\n";
        my @slaves =  ($xml =~ m{<slave>(.*?)</slave>}sg );
        for my $slave (@slaves) {
            my %names = ($slave =~ m{(\s+)<name>(.*?)</name>}sg );
            my $smallest_indent = (sort keys %names)[0];
            my $name = $names{$smallest_indent};
            my ($labels) = ($slave =~ m{<label>(.*?)</label>}sg );
            if( $label && $labels =~ /$label/ || $name =~ /$label/ ) {
                my @labels = sort split /\s+/, $labels;
                if ( $name eq 'All' ) {
                    print "$slave\n";
                    use Data::Dumper;
                    print Dumper(\%names);
                    print "smallest: \"$smallest_indent\" => $names{$smallest_indent}\n";
                    exit;
                }
                #print "$name => $labels\n";
                push @out, WWW::Jenkins::Node->new(jenkins => $self, name => $name, labels => \@labels, %{$nodeData{$name}})
            }
        }
        #use Data::Dumper;
        #warn Dumper(\@slaves);
        #print $xml;
        #exit -1;
    }
    return \@out;
        
    # my $uri = "$self->{baseuri}/computer/api/json?depth=0&tree=computer[displayName]";
    # my $res = $self->{ua}->get($uri);
    # if( $res->is_success ) {
    #     my $data = parse_json($res->decoded_content());
    #     for my $node ( @{$data->{"computer"}} ) {
            
    #     }
    # }
    
    
}

sub views {
    my ($self,@views) = @_;
    
    my @out = ();
    for my $view ( @views ) {
        # turns A/B into A/view/B which is needed
        # in jenkins uri for subviews
        my $viewPath = join("/view/", split '/', $view);
        my $uri = "$self->{baseuri}/view/$viewPath/api/json?depth=1&tree=views[name,url],jobs[name,inQueue,url,lastBuild[number,url,timestamp,duration],color]";
        my $res = $self->{ua}->get($uri);
        my $data = parse_json($res->decoded_content());
        # we dont know if the view has subviews or it it has jobs, so try for both
        # and recurse if we find a subview
        if( $data->{jobs} ) {
            push @out, WWW::Jenkins::Job->new(%$_, jenkins => $self) for @{$data->{jobs}};
        }
        if( $data->{views} ) {
            push @out, $self->views("$view/$_->{name}") for @{$data->{views}};
        }
    }
    return wantarray ? @out : \@out;
}

sub queue {
    my ( $self ) = @_;
    my $uri = "$self->{baseuri}/queue/api/json?depth=0&tree=items[task[color,name,url],why,stuck]";
    my $res = $self->{ua}->get($uri);
    #print $res->decoded_content;
    my $data = parse_json($res->decoded_content());
    my %blocked;
    my %stuck;
    my @running;
    my @quieted;
    for my $item ( @{$data->{items}} ) {
        my $job = WWW::Jenkins::Job->new(
            %{$item->{task}},
            inQueue => 1,
            jenkins => $self
        );

        if( $item->{stuck} ) {
            if( !$item->{why} ) {
                warn "no reason given why $item->{task}->{name} is stuck\n";
                next;
            }
            if( $item->{why} =~ /([^ ]+) (is|are) offline/ ) {
                push @{$stuck{$1}}, $job;
            }
            else {
                warn "don't understand why $item->{task}->{name} is stuck: $item->{why}\n";
            }
        }
        else {
            if( !$item->{why} ) {
                warn "no reason given why $item->{task}->{name} is enqueued\n";
                next;
            }
            if( $item->{why} =~ /Waiting for next available executor on (.*)/ ) {
                push @{$blocked{$1}}, $job;
            }
            elsif( $item->{why} =~ /already in progress/ ) {
                push @running, $job;
            }
            elsif( $item->{why} =~ /quiet period/ ) {
                push @quieted, $job;
            }
            else {
                warn "don't understand why $item->{task}->{name} is enqueued: $item->{why}\n";
            }
        }
    }
    return {
        blocked => \%blocked,
        stuck   => \%stuck,
        running => \@running,
        quieted => \@quieted,
    };
}

sub login {
    my ( $self ) = @_;
    return if $self->{logged_in};
    # FIXME there has to be a better way to tell if we
    # are already logged in ...
    # just load the page with the smallest content that I could find
    # and check for a "log in" string to indicate the user is not
    # logged in already
    my $res = $self->{ua}->get("$self->{baseuri}/user/$self->{user}/?");
    if ( $res->decoded_content =~ />log in</ ) {
        $res = $self->{ua}->post(
            "$self->{baseuri}/j_acegi_security_check", {
                j_username => $self->{user},
                j_password => $self->password(),
            }
        );
        $self->{ua}->get("$self->{baseuri}/user/$self->{user}/?"); 
        $self->{ua}->cookie_jar->scan(
            sub {
                my @args = @_;
                # dont discard cookies, so we dont get prompted for a password everytime
                $args[9] = 0;
                $self->{ua}->cookie_jar->set_cookie(@args);
            }
        );
    }
    $self->{logged_in}++;
    return;
}

sub stdio {
    my $self = shift;
    my ($in, $out);
    if( !-t STDIN || !-t STDOUT ) {
        # stdio missing, so try to use tty directly
        my $tty = "/dev/tty" if -e "/dev/tty";
        if( !$tty ) {
            my ($ttyBin) = grep { -x $_ } qw(/bin/tty /usr/bin/tty);
            if ( $ttyBin ) {
                $tty = qx{$ttyBin};
                chomp($tty);
            }
        }
        
        if( !$tty ) {
            die "Could not determine TTY to read password from, aborting";
        }
        open $in,  "<$tty" or die "Failed to open tty $tty for input: $!";
        open $out, ">$tty" or die "Failed to open tty $tty for output: $!";
    }
    else {
        # using stdio
        $in  = \*STDIN;
        $out = \*STDOUT;
    }
    return ($in, $out);
}

sub password {
    my ( $self ) = @_;
    if ( ref($self) && defined $self->{password} ) {
        if ( ref($self->{password}) eq 'CODE' ) {
            return $self->{password}->($self);
        }
        return $self->{password};
    }
    my ($in, $out) = $self->stdio;

    my $old = select $out;
    eval "use Term::ReadKey";
    if( $@ ) {
        # no readkey, so try for stty to turn off echoing
        my ($sttyBin) = grep { -x $_ } qw(/bin/stty /usr/bin/stty);
        if( $sttyBin ) {
            push @CLEANUP, sub {
                system($sttyBin, "echo");
            };
            system($sttyBin, "-echo");
        }
        else {
            die "Unable to disable echo on your tty while reading password, aborting";
        }
    }
    else { 
        # use readkey to turn off echoing
        push @CLEANUP, sub {
            Term::ReadKey::ReadMode("restore", $out);
        };
        Term::ReadKey::ReadMode("noecho", $out);
    }

    my $user = ref($self) eq 'HASH' ? $self->{user} : $ENV{USER};
    print $out "Jenkins Password [$user]: ";
    my $pass = <$in>;
    $CLEANUP[-1]->();
    print $out "\n";
    chomp($pass);
    select $old;
    return $pass;
}

{

    my $parser;
    my $encoder;
    sub init_json {
        # no parser, so find one
        eval "use JSON::XS qw()";
        unless( $@ ) {
            $parser = JSON::XS->can("decode_json") || JSON::XS->can("from_json");
            $encoder = JSON::XS->can("encode_json") || JSON::XS->can("to_json");
            return;
        }
        eval "use JSON qw()";
        unless ( $@ ) {
            $parser = JSON->can("decode_json") || JSON->can("jsonToObj");
            $encoder = JSON->can("encode_json") || JSON->can("objToJson");
            return;
        }
        eval "use JSON::DWIW qw()";
        unless ( $@ ) {
            $parser = JSON::DWIW->can("from_json");
            $encoder = JSON::DWIW->can("to_json");
            return;
        }
        eval "use JSON::Syck qw()";
        unless ( $@ ) {
            $parser = JSON::Syck->can("Load");
            $encoder = JSON::Syck->can("Dump");
            return;
        }
        die "No valid JSON parser found, try JSON::XS, JSON, JSON::DWIW, or JSON::Syck";
    }

    sub parse_json {
        $parser or init_json();
        my $output = eval {
            $parser->(@_)
        };
        if( $@ ) {
            croak "Failed to parse JSON:\n", @_;
        }
        return $output;
    }       

    sub encode_json {
        $encoder or init_json();
        my $output = eval {
            $encoder->(@_)
        };
        if ( $@ ) {
            croak "Failed to generate JSON:\n", @_;
        }
        return $output;
    }
}        

END { 
    for my $cleaner ( @CLEANUP ) {
        $cleaner->();
    }
}

# silly class to make debugging easier
package WWW::Jenkins::UserAgent;
use base qw(LWP::UserAgent);

sub request {
    my $self = shift;
    my $req  = shift;
    my $resp = $self->SUPER::request($req, @_);
    print "======================================>\n";
    print $req->as_string;
    print "<======================================\n";
    print $resp->as_string;
    return $resp;
}
1;
package main;
#!/usr/bin/env perl

#  Copyright 2012 Netflix, Inc.
#
#     Licensed under the Apache License, Version 2.0 (the "License");
#     you may not use this file except in compliance with the License.
#     You may obtain a copy of the License at
#
#         http://www.apache.org/licenses/LICENSE-2.0
#
#     Unless required by applicable law or agreed to in writing, software
#     distributed under the License is distributed on an "AS IS" BASIS,
#     WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#     See the License for the specific language governing permissions and
#     limitations under the License.


use strict;
use warnings;

use YAML::Syck;
use Term::ANSIColor;
use Getopt::Long;
use File::Basename qw();

$|++;

sub usage {
    my $err = shift || 0;
    my $io = $err ? *STDERR : *STDOUT;

    print $io ("-")x76,"\n" if $err;
    print $io <<EOM;
Usage: $0 [options] [command] [<pattern>]

Global Options:
    --all:           search jenkins for job names, ignore jobs in ~/.jenkins
    --baseuri=<uri>: base uri to jenkins server [http://jenkins]
    --stoplight:     make blue builds green [off]
    --job=<name>:    specify a job name, can be repeated
    --view=<name>:   speficy a list of jobs by view
    --yes:           always answer yes to any question
    --password:      prompt for password once

Commands:
    ls|list [<pattern>]: show status of builds, optionally filter on pattern
    login:               login to all configured jenkins masters
    start <pattern>:     start job
    stop <pattern>:      stop job
    tail <pattern>:      tail the most recent build log for a job
    disable <pattern>:   disable job
    enable <pattern>:    enable a job
    wipeout <pattern>:   delete current build workspace for a job
    q|queue:             shows pending build queue grouped by build-slaves
    hist|history:        list history of builds for a job
    conf|config:         dump config.xml for a job
    create <name|pattern> <config.xml|-> : create/update new jenkins job from config.xml
    nodes <pattern>
    nodesToggle <pattern>
    nodesDelete <pattern>

* Note <pattern> can be any regular expression to match jobs in your
  default job list/view
EOM
    exit $err;
}

my @actions;
my @commands = qw(ls list login start stop tail disable enable wipeout q queue hist history conf config create nodes nodesToggle nodesDelete);

my %options;
$options{$_} = sub { push @actions, shift } for @commands;

my %opts = (
    master => "*"
);
GetOptions(
    "help"       => sub { usage(0) },
    "all"        => \$opts{all},
    "baseuri=s"  => \$opts{baseuri},
    "stoplight"  => \$opts{stoplight},
    "job=s@"     => \$opts{jobs},
    "view=s@"    => \$opts{views},
    "yes"        => \$opts{yes},
    "color!"     => \$opts{color},
    "verbose"    => \$opts{verbose},
    "user"       => \$opts{user},
    "stuck"      => \$opts{stuck},
    "param|p=s@" => \$opts{params},
    "password"   => \$opts{password},
    "yes"        => \$opts{yes},
    "master=s"   => \$opts{master},

    "online"     => \$opts{online},
    "offline"    => \$opts{offline},
    "busy"       => \$opts{busy},
    "idle"       => \$opts{idle},

    %options,
) || usage(1);

for my $key ( keys %opts ) {
    delete $opts{$key} unless defined $opts{$key}
}

my @jenkins = ();

if( $opts{password} ) {
    $opts{password} = WWW::Jenkins->password();
}

for my $cfg ( glob("$ENV{HOME}/.jenkins*$opts{master}*" ) ) {
    if( ! $opts{baseuri} && -f $cfg ) {
        my $config = YAML::Syck::LoadFile($cfg);
        $config->{baseuri}  ||= "http://jenkins";
        $config->{user} ||= $ENV{USER};
        push @jenkins, WWW::Jenkins->new(%$config, %opts);
    }
}

if( !@jenkins ) {
    push @jenkins, WWW::Jenkins->new( baseuri => "http://jenkins", user => $ENV{USER}, %opts)
}

my @args;
for my $arg ( @ARGV ) {
    if( grep { $arg eq $_ } @commands ) {
        push @actions, $arg;
    }
    else {
        push @args, $arg;
    }
}

my $filter = shift @args || ".";

if( !@actions ) {
    list(load("list"), @args);
}
else {
    for my $action ( @actions ) {
        no strict "refs";
        
        my $func = *{"main::$action"};
        $func->(load($action), \@args);
    }
}

BEGIN { 
    # create function aliases
    no warnings "once";
    *ls   = \&list;
    *q    = \&queue;
    *hist = \&history;
    *conf = \&config;

    # these routines are all the same, just loop over all jobs
    # and try to run the operation on each job.
    for my $func (qw(start stop disable enable wipeout)) {
        no strict 'refs';
        *{"main::$func"} = sub {
            my ( $jobs, $args ) = @_;
            confirm_multiple($func, $jobs) if @$jobs > 1;
            for my $job ( @$jobs ) {
                eval {
                    if ( $func eq 'start') {
                        $job->$func( { map { split /=/, $_, 2 } @{$opts{params}} } )
                    }
                    else {
                        $job->$func()
                    }
                };
                printf "%s %s: %s\n", ucfirst($func), $job->name(), $@ ? "ERROR: $@" : "OK";
                       
            }
        }
    }
};

{
    my $jobs;
    my $nodes;
    sub load {
        my $action = shift;
        return [] if $action eq 'q' || $action eq 'queue' || $action eq 'login';
        if( $action =~ /^nodes/) {
            return $nodes if $nodes;
            my @nodes;
            for my $jenkins ( @jenkins ) {
                push @nodes, @{$jenkins->nodes($filter)};
            }
            return \@nodes;
        }
        else {
            return $jobs if $jobs;
            my @jobs;
            for my $jenkins ( @jenkins ) {
                my $jobNames = $opts{all} ? $jenkins->search($filter) : $jenkins->{jobs};
                my %uniq;
                push @jobs, grep { !$uniq{$_->name}++ } $jenkins->jobs(grep{ /$filter/ } @$jobNames);
                push @jobs, grep { !$uniq{$_->name}++ } $jenkins->views(@{$jenkins->{views}});
            }
            
            if( $filter ) {
                @jobs = grep { $_->name =~ /$filter/ } @jobs;
                my @exact = grep { $_->name eq $filter } @jobs;
                @jobs = @exact if @exact;
                
                if( ! @jobs ) {
                    # perhaps the name is not in the config file
                    # but is a job on the jenkins master
                    for my $jenkins ( @jenkins ) {
                        push @jobs, $jenkins->jobs($filter);
                    }
                }
                
                if( ! @jobs ) {
                    return [$filter] if $action eq 'create';
                    die "No jobs found for pattern /$filter/\n";
                }
            }
            return $jobs = \@jobs;
        }
    }
}

sub login {
    for my $jenkins ( @jenkins ) {
        $jenkins->login();
    }
}

sub list {
    my ( $jobs, $args ) = @_;
    for my $job ( @$jobs ) {
        my $markers = "";
        $markers .= "*" if $job->is_running;
        $markers .= "?" if $job->was_aborted;
        $markers .= "+" if $job->is_queued;
        print colorize($job->color, $job->name), "$markers $job->{url}\n";
    }        
}

sub nodes {
    my ( $nodes, $args ) = @_;
    for my $node ( @$nodes ) {
        next if $opts{idle} && $node->is_running;
        next if $opts{busy} && !$node->is_running;
        next if $opts{online} && $node->offline;
        next if $opts{offline} && !$node->offline;
        my $markers = "";
        $markers .= "*" if $node->is_running;
        $markers .= "?" if $node->offline && !$node->tempOffline;
        print colorize($node->color, $node->name), "$markers @{$node->{labels}}\n";
    }        
}

sub nodesToggle {
    my ( $nodes, $args ) = @_;
    my @nodes = grep {
        $opts{idle} && !$_->is_running
            || $opts{busy} && $_->is_running
            || $opts{online} && !$_->offline
            || $opts{offline} && $_->offline
    } @$nodes;
    confirm_multiple("toggleOffline", \@nodes, "node") if @nodes > 1;
    for my $node ( @nodes ) {
        eval {
            $node->toggleOffline()
        };
        printf "toggleOffline %s: %s\n",$node->name(), $@ ? "ERROR: $@" : "OK";
    }
}

sub nodesDelete {
    my ( $nodes, $args ) = @_;
    my @nodes = grep {
        $opts{idle} && !$_->is_running
            || $opts{busy} && $_->is_running
            || $opts{online} && !$_->offline
            || $opts{offline} && $_->offline
    } @$nodes;
    confirm_multiple("nodeDelete", \@nodes, "node") if @nodes > 1;
    for my $node ( @nodes ) {
        eval {
            $node->remove()
        };
        printf "nodeDelete %s: %s\n",$node->name(), $@ ? "ERROR: $@" : "OK";
    }
}

sub queue {
    for my $jenkins ( @jenkins ) {
        my $queue = $jenkins->queue();
        for my $host ( keys %{$queue->{blocked}} ) {
            my $hostStr = $host;
            # if hostname will wrap, just truncate the middle
            if ( length($host) > 76 ) {
                $hostStr = substr($host,0,31) . "..." . substr($host,-31,31);
            }
            print colorize("bold", colorize("underline", $hostStr)), "\n";
            print "  ", colorize($_->color, $_->name), "\n" for @{$queue->{blocked}->{$host}};
        }

        if ( $jenkins->{stuck} ) {
            for my $host ( keys %{$queue->{stuck}} ) {
                my $hostStr = $host;
                # if hostname will wrap, just truncate the middle
                if ( length($host) > 76 ) {
                    $hostStr = substr($host,0,31) . "..." . substr($host,-31,31);
                }
                print colorize("bold", colorize("red", colorize("underline", $hostStr))), "\n";
                print "  ", colorize($_->color, $_->name), "\n" for @{$queue->{stuck}->{$host}};
            }
        }

        if ( @{$queue->{running}} ) {
            print colorize("bold", colorize("underline", "ALREADY RUNNING")), "\n";
            print "  ", colorize($_->color, $_->name), "\n" for @{$queue->{running}};
        }
    
        if ( @{$queue->{quieted}} ) {
            print colorize("bold", colorize("underline", "QUIETED")), "\n";
            print "  ", colorize($_->color, $_->name), "\n" for @{$queue->{quieted}};
        }
    }
}


sub tail {
    my ( $jobs, $args ) = @_;
    require_one($jobs);
    my $job = $jobs->[0];
    my $cursor = $job->logCursor;
    while(1) {
        my $content = $cursor->();
        last unless defined $content;
        print $content;
        sleep 1;
    }
}

sub history {
    my ( $jobs, $args ) = @_;
    require_one($jobs);
    my $job = $jobs->[0];
    my @jobs = $job->history();
    for my $job ( @jobs ) {
        my $markers = "";
        $markers .= "*" if $job->is_running;
        $markers .= "?" if $job->was_aborted;
        print "#" , $job->number(), 
            " - ", colorize($job->color, scalar localtime($job->started)),
            sprintf("%-2s [%07.03f sec]\n", $markers, $job->duration);
    }        
}

sub config {
    my ( $jobs, $args ) = @_;
    require_one($jobs);
    my $job = $jobs->[0];
    print $job->config();
}

sub create {
    my ( $jobs, $args ) = @_;
    require_one($jobs);
    my $job = $jobs->[0];
    my $configFile = shift @$args;
    my $config = do {
        local $/;
        open my $fh, "<$configFile" or die "Could not read config file $configFile: $!";
        <$fh>;
    };
    $jenkins[0]->create($job,$config);
}

sub require_one {
    my ( $jobs ) = @_;
    if ( @$jobs > 1 ) {
        my $prog = File::Basename::basename($0);
        my ($pkg, $func) = (caller(1))[0,3];
        $func =~ s/$pkg\:://;
        die scalar(@$jobs)
            . " matches for pattern /$filter/ but only one job can be sent to: $prog $func\nMatches:\n\t"
            . join("\n\t", map { $_->{name} } @$jobs )
            . "\n";
    }
}

sub confirm_multiple {
    my ($operation, $jobs, $type) = @_;
    $type ||= "job";
    return if $jenkins[0]->{yes};
    my ($in, $out) = $jenkins[0]->stdio;
    while(1 && ! $opts{yes} ) {
        print $out "Mutliple ${type}s found for pattern /$filter/\n";
        print $out "    ", $_->name, "\n" for @$jobs;
        print $out "Do you want to $operation all of them? [y/N]: ";
        my $ans = <$in>;
        chomp($ans);
        if( !$ans || $ans =~ /^n/i ) {
            exit;
        }
        if( $ans =~ /^y/i ) {
            return;
        }
        print $out "Sorry, didn't understand \"$ans\"\n";
    }   
}

sub colorize {
    my ( $color ) = shift;
    # dont colorize when redirected to non-tty
    return @_ unless -t STDOUT;
    return color($color), @_, color("reset");
}