File Coverage

blib/lib/App/Siesh.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package App::Siesh;

use strict;
use warnings;

use Term::ShellUI;
use Net::ManageSieve::Siesh;
use App::Siesh::Batch;

our $VERSION = '0.21';

sub read_config {
    my ($class,$file) = @_;

    if (!$file) {
	require Config::Find;
	$file =  Config::Find->find( name => 'siesh' );
    }
    return {} if ! $file;
    require Config::Tiny;

    my $config = Config::Tiny->read($file);
    die $config->errstr() if ! $config;

    return $config->{_};
}

sub run {
    my ( $class, %config ) = @_;

    # Set defaults for Net::ManageSieve::Siesh construction
    $config{user} ||= $ENV{USER};
    $config{host} ||= 'imap';
    $config{tls}  ||= 'auto';

    my @params;

    foreach ( qw(debug port tls) ) {
        push @params, ucfirst($_), $config{$_}
          if defined $config{$_};
    }

    my $sieve = Net::ManageSieve::Siesh->new(
        $config{host},
        on_fail => sub { die "$_[1]\n" },
        @params
    ) or die "Can't connect to $config{host}: $!\n";

    $sieve->auth( $config{user}, $config{password} ) or die "$@\n";

    my %shellui_params;
    if ($config{file}) {
	$shellui_params{term} = App::Siesh::Batch->new($config{file});
    }

    my $term = new Term::ShellUI(
	%shellui_params,
        history_file => '~/.siesh_history',
        prompt       => 'siesh> ',
        commands     => {
            "help" => {
                desc   => "Print this help page.",
                args   => sub { shift->help_args( undef, @_ ); },
                method => sub { shift->help_call( undef, @_ ); },
            },
            "put" => {
                desc    => 'Upload a script onto the server.',
                maxargs => 2,
                minargs => 2,
                proc => sub { $sieve->putfile(@_) },
                args => sub { complete_file_and_script(@_, $sieve); },
            },
            "get" => {
                desc    => "Fetch a script from the server and store locally.",
                maxargs => 2,
                minargs => 2,
                proc    => sub { $sieve->getfile(@_) or die $sieve->error() . "\n" },
                args    => sub { complete_script_and_file(@_, $sieve); },
            },
            "quit" => {
                desc    => "Quit siesh.",
                maxargs => 0,
                method  => sub { $sieve->logout; shift->exit_requested(1); }
            },
            "list" => {
                desc    => "List all scripts stored on the server.",
                maxargs => 0,
                proc    => sub {
    			my $active  = $sieve->get_active();
    			my @scripts = $sieve->listscripts(1);
    			print $active . " *\n" if $active;
    			print join("\n",sort @scripts) . "\n" if @scripts;
		},
            },
            "activate" => {
                desc    => "Mark a script as active.",
                maxargs => 1,
                proc    => sub { $sieve->setactive(shift) },
                args => sub { complete_scripts( @_, $sieve ) },
            },
            "edit" => {
                desc    => 'Edit script using $EDITOR.',
                maxargs => 1,
                proc    => sub { $sieve->edit_script(shift) },
                args    => sub { complete_scripts( @_, $sieve ) },
            },
            "view" => {
                desc    => 'Examine the contents of a script using $PAGER.',
                maxargs => 1,
                proc    => sub { $sieve->view_script(shift) },
                args    => sub { complete_scripts( @_, $sieve ) },
            },
            "delete" => {
                desc    => "Delete a script from the server.",
                minargs => 1,
                proc    => sub {
			if ( $_[0] eq '*' ) {
				$sieve->deactivate();
				$sieve->deletescript($sieve->listscripts);
			} else {
				$sieve->deletescript(@_);
			}
		},
                args    => sub { complete_scripts( @_, $sieve ) },
            },
            "cat" => {
                desc    => "Show the contents of a script on stdout.",
                maxargs => 1,
                proc    => sub { print $sieve->getscript(shift) },
                args    => sub { complete_scripts( @_, $sieve ) },
            },
            "copy" => {
                desc    => 'Make a copy of a script under another name.',
                maxargs => 2,
                minargs => 2,
                proc =>
                  sub { $sieve->copyscript(@_) },
                args => sub { complete_scripts( @_, $sieve ) },
            },
            "move" => {
                desc    => 'Rename a script on the server.',
                maxargs => 2,
                minargs => 2,
                proc =>
                  sub { $sieve->movescript(@_) },
                args => sub { complete_scripts( @_, $sieve ) },
            },
            "deactivate" => {
                desc    => 'Mark the currently activated script as inactive.',
                maxargs => 0,
                proc    => sub { $sieve->deactivate() },
                args    => sub { complete_scripts( @_, $sieve ) },
            },
            "q"      => { alias => 'quit',       exclude_from_completion => 1 },
            "logout" => { alias => 'quit',       exclude_from_completion => 1 },
            "h"      => { alias => "help",       exclude_from_completion => 1 },
            "ls"     => { alias => "list",       exclude_from_completion => 1 },
            "dir"    => { alias => "list",       exclude_from_completion => 1 },
            "rm"     => { alias => "delete",     exclude_from_completion => 1 },
            "vi"     => { alias => "edit",       exclude_from_completion => 1 },
            "more"   => { alias => "less",       exclude_from_completion => 1 },
            "type"   => { alias => "cat",        exclude_from_completion => 1 },
            "cp"     => { alias => "copy",       exclude_from_completion => 1 },
            "mv"     => { alias => "move",       exclude_from_completion => 1 },
            "set"    => { alias => "activate",   exclude_from_completion => 1 },
            "unset"  => { alias => "deactivate", exclude_from_completion => 1 },
        },
    );

    #$term->{debug_complete}=5;
    $term->{term}->ornaments(0);
    return $term->run();
}

sub complete_script_and_file {
    my ( $term, $cmp, $sieve ) = @_;
    if ($cmp->{argno} == 0 ) {
	my $scripts = complete_scripts($term,$cmp,$sieve) ;
	if ( @{ $scripts } ) {
		return $scripts;
	} else {
		return "No scripts to complete found.\n";
	}
    } elsif ($cmp->{argno} == 1 ) {
	return $term->complete_files($cmp)
    }
}

sub complete_file_and_script {
    my ( $term, $cmp, $sieve ) = @_;
    if ($cmp->{argno} == 0 ) {
	return $term->complete_files($cmp)
    } elsif ($cmp->{argno} == 1 ) {
		return "No scripts to complete found.\n";
    }
}

sub complete_scripts {
    my ( $term, $cmp, $sieve ) = @_;
    return [ grep { index( $_, $cmp->{str} ) == 0 } $sieve->listscripts()  ];
}

1;

__END__