#!/usr/bin/perl

=head1 NAME

osgish - Admin's OSGi Shell

=cut

use Term::Clui;
use Term::ShellUI;
use Term::ANSIColor qw(:constants);
use Getopt::Long qw(GetOptionsFromArray);
use JMX::Jmx4Perl::Config;
use strict;
use English;

use Data::Dumper;

use OSGi::Osgish;


=head1 SYNOPSIS

  osgish [options] 

  osgish --help

  osgish --version

 Options:
   --server <server>       URL or symbolic name of OSGi server to connect to
   --user <user>           Credential used for authentication   
   --password <pwd>  
   --proxy <url>           URL to proxy
   --proxy-user <user>     Authentication information for a proxy
   --proxy-password <pwd>
   --config                Path to an optional configuration file (default: ~/.osgish)

=head1 DESCRIPTION

B<Osgish> is the administrator's shell for OSGi. It's focus is on simple usage
for common administrative tasks. There are many other shells for OSGi as well,
most (if not all) implemented in Java. Osgish unique features are

=over 4

=item *

Readline and history support based on GNU Readline/History as known from other
shells like 'bash'. When GNU Readline is not available, a pure Perl Module is
used instead.

=item *

Context sensitive argument completion, e.g. on bundle symbolic names. 

=item * 

Colored output (can be switched off)

=item *

Multi-Server support

=item * 

Remote operation via HTTP(S)

=back

=cut

my %opts = ();
my $result = GetOptions(\%opts,
                        "server|s=s",
                        "user|u=s","password|p=s",
                        "proxy=s",
                        "proxy-user=s","proxy-password=s",
                        "config=s",
                        "version!",
                        "help|h!" => sub { &Getopt::Long::HelpMessage() }
                       );

if ($opts{version}) {
    print "osgish ",$OSGi::Osgish::VERSION,"\n";
    exit(0);
}

my $use_color = 1;
my $no_color_prompt = 0;        # Don't color for certain readline imp.
my $config = &get_config($opts{config});
my $jmx_config = new JMX::Jmx4Perl::Config($config);
my $j4p_args = &get_j4p_args(\%opts);

&init;

# Current connection to OSGi agent
my $osgi;

# Current server and osgi object
my ($server,$osgi);
my ($server_from_config,$server_list,$server_map) = &init_server_list(\%opts,$jmx_config);
&switch_to_server($server_from_config) if $server_from_config;

# Context for subcommands
my @contexts = ();

# Initialize color theme
my $color_theme = &get_color_theme($config);

# Create a UI object and let it run
my $term = new Term::ShellUI(
                             commands => &top_commands,
                             history_file => "~/.osgish_history",
                             prompt => \&prompt
                            );
&run_term($term);

# ====================================================================
# Commands used

# Top-Level commands
sub top_commands {
    return 
        { 
         %{&bundle_commands},
         %{&service_commands},
         %{&server_commands},
         %{&global_commands},
#         "help" =>   { 
#                      desc => "Print helpful information",
#                      args => sub { shift->help_args($helpcats, @_); },
#                      method => sub { shift->help_call($helpcats, @_); } 
#                     },
        };
}

# Commands in context "bundle"
sub bundle_commands {
    my $parent_cmds = shift || \&top_commands;
    my $cmds = { 
                "ls" => { 
                         desc => "List bundles",
                         proc => \&cmd_list_bundles,
                         args => sub { &complete_bundles(@_,no_ids => 1) }
                        },
                "start" => { 
                            desc => "Start a bundle",
                            proc => \&cmd_start_bundle,
                            args => sub { &complete_bundles(@_) }
                           },
                "stop" => { 
                           desc => "Stop a bundle",
                           proc => \&cmd_stop_bundle,
                           args => sub { &complete_bundles(@_) }
                          }
               };
    
    return $server ? {
                      "bundle" => { 
                                   desc => "Bundles related operations",
                                   proc => sub { 
                                       &cmd_set_context("bundle",$cmds,$parent_cmds) 
                                   },
                                   cmds => $cmds                       
                                  },
                      "b" => { alias => "bundle", exclude_from_completion => 1},
                     } : {};
}


sub server_commands {

    return {
            "servers" => { 
                          desc => "Show all configured servers",
                          proc => \&cmd_show_servers
                         },
            "connect" => { 
                          desc => "Connect to a server by its URL or symbolic name",
                          minargs => 1, maxargs => 2,
                          args => sub { &complete_servers(@_) },
                          proc => \&cmd_connect
                         },
           };
}

# Commands im context "service"
sub service_commands {
    if ($server) {
        my $cmds = &service_sub_commands;
        return {
           "service" => { 
                         desc => "Service related operations",
                         proc => sub { 
                             &cmd_set_context("service",$cmds,\&top_commands) 
                         },
                         cmds => $cmds                       
                        },
           "s" => { alias => "service", exclude_from_completion => 1},
           "serv" => { alias => "service", exclude_from_completion => 1}
          };
    } else {
        return {};
    }
}

sub service_sub_commands {
    return { 
            "ls" => { 
                     desc => "List all services",
                     proc => \&cmd_list_services,
                     args => sub { &complete_services(@_,no_ids => 1) }
                     
                    },
            "bls" => { 
                      desc => "List bundles",
                      proc => \&cmd_list_bundles,
                      args => sub { &complete_bundles(@_,no_ids => 1) }                      
                     },
            %{&bundle_commands(sub { return { %{&service_sub_commands},%{&global_commands}}})}
           };    
}

# Commands always available
sub global_commands {
    return 
        {
         "error" => {
                     desc => "Show last error (if any)",
                     proc => \&cmd_last_error
                    },
         "help" => {
                    desc => "Print helpful information",
                    args => sub { shift->help_args(undef, @_); },
                    method => sub { shift->help_call(undef, @_); }
                   },
         "h" => { alias => "help", exclude_from_completion=>1},
         "quit" => {
                    desc => "Quit",
                    maxargs => 0,
                    method => sub { shift->exit_requested(1); }
                   },
         "q" => { alias => 'quit', exclude_from_completion => 1 },
         $server ? ("shutdown" => {
                                   desc => "Shutdown server",
                                   proc => \&cmd_shutdown
                                  }) : ()
        };
}

# ==================

# Update the context and available commands
sub cmd_set_context {
    # The new context
    my $context = shift;
    # Sub-commands within the context
    my $sub_cmds = shift;
    # Parent commands of this sub context
    my $parent_cmds = shift;
    
    push @contexts,$context;
    
    # Set sub-commands
    $term->commands
      ({
        %$sub_cmds,
        %{&global_commands},
        $parent_cmds ? 
        (".." => {
                 desc => "Go up one level",
                 proc => 
                  sub { 
                      pop @contexts;
                      $term->commands(&{$parent_cmds});
                  }
                 },
         "/" => { 
                 desc => "Go to the top level",
                 proc => 
                 sub { 
                     &reset_context();
                 }
                }) : ()
       });    
}

# Connect to a server
sub cmd_connect {
    my $arg = shift;
    my $name = shift;
    my $s = $server_map->{$arg};
    unless ($s) {
        unless ($arg =~ m|^\w+://[\w:]+/|) {
            print "Invalid URL $arg\n";
            return;
        }
        $name ||= &prepare_server_name($arg);
        my $entry = { name => $name, url => $arg };
        push @$server_list,$entry;
        $server_map->{$name} = $entry;
        $s = $entry;
    }
    my ($old_server,$old_osgi) = ($server,$osgi);
    eval { 
        &switch_to_server($s->{name});
    };
    if ($@) {
        $server = $old_server;
        $osgi = $old_osgi;
        die $@;
    } 
    &reset_context;
    $term->commands(&top_commands);
    my ($yellow,$reset) = &get_color("host",RESET);
    print "Connected to " . $yellow . $server . $reset .  " (" . $osgi->url . ")\n";
}

# Show all servers
sub cmd_show_servers {
    for my $s (@$server_list) {
        my ($ms,$me) = &get_color("host",RESET);
        my $sep = $s->{from_config} ? "-" : "*";
        printf " " . $ms . '%30.30s' . $me . ' %s %s' . "\n",$s->{name},$sep,$s->{url};
    }
}

# Shutdown a server
sub cmd_shutdown {
    unless ($osgi) {
        print "Not connected to a server\n";
        return;
    }
    my ($yellow,$reset) = &get_color("host",RESET);
    my $answer = &choose("Really shutdown " . $yellow . $server . $reset . " ?","yes","no");
    if ($answer eq "yes") {
        $osgi->shutdown;
        $server = undef;
        $osgi = undef;
        &reset_context;
    } else {
        print "Shutdown of ". $yellow . $server . $reset . " cancelled\n";
    }
}

sub switch_to_server {
    $server = shift;
    $osgi = &get_osgi($server) || die "Unknown $server (not an alias nor a proper URL).\n";;
    $osgi->init();    
}

# =================================================================================================== 

# List bundles
sub cmd_list_bundles {
    print "Not connected to a server\n" and return unless $osgi;
    my ($opts,@filters) = &extract_command_args(["s!"],@_);
    my $bundles = $osgi->bundles;
    my $text = sprintf("%4.4s   %-11.11s %3s %s\n","Id","State","Lev","Name");
    $text .= "-" x 87 . "\n";
    my $nr = 0;
    
    my $filtered_bundles = &filter_bundles($bundles,$opts,@filters);
    return unless @$filtered_bundles;
    
    if (@$filtered_bundles == 1) {
        # Print single info for bundle
        print "TODO\n";
    } else {
        for my $b (sort { $a->{Identifier} <=> $b->{Identifier} } @$filtered_bundles) {
            my $id = $b->{Identifier};
            my ($green,$red,$reset) = &get_color("bundle_active","bundle_inactive",RESET);
            my $state = lc $b->{State};
            my $color = "";
            $color = $red if $state eq "installed";
            $color = $green if $state eq "active";
            my $state = uc(substr($state,0,1)) . substr($state,1);
            my $level = $b->{StartLevel};
            
            my $name = $b->{Headers}->{'[Bundle-Name]'}->{Value};
            my $sym_name = $b->{SymbolicName};
            my $version = $b->{Version};
            my $location = $b->{Location};
            my $desc = $opts->{s} ? 
              $sym_name || $location :
                $name || $sym_name || $location;
            $desc .= " ($version)" if $version && $version ne "0.0.0";
            
            $text .= sprintf "%s%4d   %-11s%s %3d %s%s%s\n",$color,$id,$state,$reset,$level,$desc; 
            $nr++;
        }
        &print_paged($text,$nr);
    }
    #print $text;
    #print Dumper($bundles);
}

sub cmd_start_bundle {
    my $bundle = shift;
    $osgi->start_bundle($bundle);
}

sub cmd_stop_bundle {
    my $bundle = shift;
    $osgi->stop_bundle($bundle);    
}

# =========================================================================================

sub cmd_list_services { 
    print "Not connected to a server\n" and return unless $osgi;
    my $services = $osgi->services;
    my ($opts,@filters) = &extract_command_args(["u=s","b=s"],@_);

    my $filtered_services = &filter_services($services,$opts,@filters);
    return unless @$filtered_services;
    
    my $text = sprintf("%4.4s   %-60.60s %5.5s | %s\n","Id","Classes","Bd-Id","Using bundles");
    $text .= "-" x 74 . "+" . "-" x 24 . "\n";
    my $nr = 0;
    for my $s (sort { $a->{Identifier} <=> $b->{Identifier} } @{$filtered_services}) {
        my $id = $s->{Identifier};
        my ($c_id,$c_interf,$c_using,$r) = &get_color("service_id","service_interface","service_using",RESET);
        my $using_bundles = $s->{UsingBundles} || [];
        my $using = $using_bundles ? join (", ",sort { $a <=> $b } @$using_bundles) : "";
        my $bundle_id = $s->{BundleIdentifier};
        my $classes = $s->{objectClass};        
        $text .= sprintf "%s%4d%s   %s%-60.60s%s  %4d | %s%s%s\n",$c_id,$id,$r,$c_interf,$classes->[0],$r,$bundle_id,$c_using,$using,$r;
        for my $i (1 .. $#$classes) {
            $text .= sprintf "       %s%-66.66s%s |\n",$c_interf,$classes->[$i],$r;
        }
        $nr++;
    }
    &print_paged($text,$nr);
}

# =========================================================================================
sub cmd_last_error {
    if ($osgi && $osgi->last_error) { 
        my $txt = $osgi->last_error;
        chop $txt;
        print "$txt\n";
    } else {
        print "No errors";
    }
}

# ==================

sub reset_context {
    $term->commands(&top_commands);
    @contexts = ();
}

sub complete_servers {
    my ($term,$cmpl) = @_;
    return [] unless @$server_list;
    my $str = $cmpl->{str} || "";
    my $len = length($str);
    return [ grep { substr($_,0,$len) eq $str }  map { $_->{name} } @$server_list  ];
}

sub complete_bundles {
    return &complete_bundle_or_service(sub { $osgi->bundle_ids(use_cached =>) },
                                       sub { $osgi->bundle_symbolic_names(use_cached => 1)},
                                       @_);
}

sub complete_services {
    return &complete_bundle_or_service(sub { $osgi->service_ids(use_cached =>) },
                                       sub { $osgi->service_object_classes(use_cached => 1)},
                                       @_);
}

sub complete_bundle_or_service {
    my ($ids_sub,$names_sub,$term,$cmpl,@rest) = @_;

    my $args = @rest ? { @rest } : {};
    return [] unless $osgi;
    my $str = $cmpl->{str} || "";
    my $len = length($str);
    if (!$args->{no_ids} && $str =~ /^\d+$/) { 
        # Complete on ids
        return [ sort { $a <=> $b } grep { substr($_,0,$len) eq $str } @{&$ids_sub()} ];
    } else {
        my @sym_names = sort keys %{&$names_sub()};
        if ($str) {
            return [ grep { substr($_,0,$len) eq $str } @sym_names ];
        } else {
            return \@sym_names;
        }
    }

}

sub prompt {
    my $term = shift;
    my ($yellow,$cyan,$red,$reset) = $no_color_prompt ? ("","","","") : &get_color("host","prompt_context","prompt_empty",RESET,{escape => 1});
    my $p = "[";
    $p .= $server ? $yellow . $server : $red . "osgish";
    $p .= $reset;
    $p .= ":" . $cyan if @contexts;
    for my $i (0 .. $#contexts) {
        $p .= $contexts[$i];
        $p .= $i < $#contexts ? "/" : $reset;
    }
    $p .= "] : ";
    return $p;
}

sub get_osgi {
    my $server = shift;
    return undef unless $server;
    my $sc = $server_map->{$server};
    return undef unless $sc;
    if ($sc->{from_config}) {
        return new OSGi::Osgish({ %$j4p_args, server => $server, config => $jmx_config});
    } else {
        return new OSGi::Osgish({ %$j4p_args, url => $sc->{url}});
    }
}

sub get_server_list_from_config {
    my $jmx_config = shift;
    return map { { name => $_->{name}, url => $_->{url}, from_config => 1 } } @{$jmx_config->get_servers};
}

sub prepare_server_name {
    my $url = shift;
    return $1 if $url =~ m|^\w+://([^/]+)/?|;
}

sub get_config {
    my $file = shift || $ENV{HOME} . "/.osgish";
    my $ret = {};

    # Merge if servers from ~/.j4p
    my $default =  {};
    $default = { new Config::General(-ConfigFile => $ENV{HOME} . "/.j4p",-LowerCaseNames => 1)->getall } 
      if -e $ENV{HOME} . "/.j4p";
    if ($file && -e $file) {
        $ret = { new Config::General(-ConfigFile => $file,-LowerCaseNames => 1,-DefaultConfig => $default)->getall };        
    } 
    return $ret;
}

# For a command, extract args and options
sub extract_command_args {
    my ($spec,@args) = @_;
    my $opts = {};
    GetOptionsFromArray(\@args, $opts,@{$spec});
    return ($opts,@args);
}

# Convert * and . to proper regexp
sub convert_wildcard_pattern_to_regexp {
    my $wildcard = shift;
    $wildcard =~ s/\?/./g;
    $wildcard =~ s/\*/.*/g;
    return qr/^$wildcard$/;
}

sub get_j4p_args {
    my $o = shift;
    my $ret = { };
    
    for my $arg qw(user password) {
        if (defined($opts{$arg})) {
            $ret->{$arg} = $opts{$arg};
        }
    }
    
    if (defined($opts{proxy})) {
        my $proxy = {};
        $proxy->{url} = $opts{proxy};
        for my $k (qw(proxy-user proxy-password)) {
            $proxy->{$k} = defined($opts{$k}) if $opts{$k};
        }
        $ret->{proxy} = $proxy;
    }        
    if (defined($opts{target})) {
        $ret->{target} = {
                          url => $opts{target},
                          $opts{'target-user'} ? (user => $opts{'target-user'}) : (),
                          $opts{'target-password'} ? (password => $opts{'target-password'}) : (),
                         };
    }
    return $ret;
}

sub get_color { 
    my @colors = @_;
    my $args = ref($colors[$#colors]) eq "HASH" ? pop @colors : {};
    if ($use_color) {
        if ($args->{escape}) {
            return map { "\01" . &resolve_color($_) . "\02" } @colors;
        } else {
            return map { &resolve_color($_) } @colors;
        }
    } else {
        return map { "" } @colors;
    }
}

sub resolve_color {
    my $c = shift;
    my $color = $color_theme->{$c};
    if (exists($color_theme->{$c})) {
        return defined($color) ? $color : "";
    } else {
        return $c;
    }
}

sub print_paged {
    my $text = shift;
    my $nr = shift;
    if (defined($nr) && $nr < 24) {
        print $text;
    } else {
        view("",$text);
    }
}

sub init {
    # Force pipe, quit if less than a screen-full.
    my @args = ('-f','-E');
    if ($use_color) {
        # Raw characters
        push @args,'-r';
    }
    if ($ENV{LESS}) {
        my $l = "";
        for my $a (@args) {
            $l .= $a . " " unless $ENV{LESS} =~ /-$a/;
        }
        chop $l if length($l);
        $ENV{LESS} = $l;
    } else {
        $ENV{LESS} = join " ",@args;
    }
}

sub init_server_list {
    my ($o,$jc) = @_;
    my @servers = &get_server_list_from_config($jc);
    my $ret_server;
    if ($o->{server}) {
        my $config_s = $jc->get_server_config($o->{server});
        if ($config_s) {
            my $found = 0;
            my $i=0;
            my $entry = { name => $config_s->{name}, url => $config_s->{url}, from_config => 1 } ;
            for my $s (@servers) {
                if ($s->{name} eq $o->{server}) {
                    $servers[$i] = $entry;
                    $found = 1;                 
                    last;
                }
                $i++;
            } 
            push @servers,$entry unless $found;
            $ret_server = $config_s->{name};
        } else {
            die "Invalid URL ",$o->{server} unless ($o->{server} =~ m|^\w+://|);
            my $name = &prepare_server_name($opts{server});
            push @servers,{ name => $name, url => $o->{server} };
            $ret_server = $name;
        }
    }

    return ($ret_server,\@servers,
              { map { $_->{name} => $_ } @servers });
}

# Run ShellUI and never return. Provide some special
# ReadLine treatment
sub run_term {
    my $t = shift;
    $t->{term}->ornaments(0);
    
    # Special readline customization for Term::ReadLine::Perl
    if ($t->{term}->ReadLine eq "Term::ReadLine::Perl") {
        $no_color_prompt = 1;
    }
    #$t->{debug_complete}=5;
    $t->run;
}

sub get_color_theme {
    my $config = shift;

    # For now, we return a fixed theme:
    return { 
            host => YELLOW,
            bundle_active => GREEN,
            bundle_inactive => RED,
            service_id => GREEN,
            service_interface => undef,
            service_using => RED,
            prompt_context => CYAN,
            prompt_empty => RED
           };
}


# Filter bundles according to some criteria
sub filter_bundles {
    my ($bundles,$opts,@filters) = @_;

    if (@filters) {
        my %filtered_bundles;
        for my $f (@filters) {
            my $regexp = &convert_wildcard_pattern_to_regexp($f);
            for my $b (values %$bundles) {
                if ($b->{SymbolicName} =~ $regexp || ($f =~ /^\d+$/ && $b->{Identifier} == $f)) {
                    $filtered_bundles{$b->{Identifier}} = $b;
                }
            }
        }
        return [values %filtered_bundles];
    } else {
        return [values %$bundles];
    }
}

# Filter services according to one or more criteria
sub filter_services {
    my ($services,$opts,@filters) = @_;
    my %found = ();
    my $rest = [values %$services];
    my $filtered = undef;
    if ($opts->{u}) {
        for my $s (@$rest) {
            if (grep { $_ == $opts->{u} } @{$s->{UsingBundles}}) {
                $found{$s->{Identifier}} = $s;
            } 
        }
        $filtered = 1;
        $rest = [values %found];
    } 
    if ($opts->{b}) {
        for my $s (@$rest) {
            if ($s->{BundleIdentifier} == $opts->{b}) {
                $found{$s->{Identifier}} = $s;
            } elsif ($filtered) {
                delete $found{$s->{Identifier}};
            }
        }
        $filtered = 1;
        $rest = [values %found];
    }
    if (@filters) {
        for my $f (@filters) {
            my $regexp = &convert_wildcard_pattern_to_regexp($f);
            for my $s (@$rest) {
                if (grep { $_ =~ $regexp } @{$s->{objectClass}}) {
                    $found{$s->{Identifier}} = $s;
                } elsif ($filtered) {
                    delete $found{$s->{Identifier}};
                }
            }
        }
        $filtered = 1;
        $rest = [values %found];
    }
    return $rest;
}
