view release on metacpan or  search on metacpan

lib/Net/ManageSieve/Siesh.pm  view on Meta::CPAN

    my $script;
    open( my $fh, '<', $file );
    { local $/ = undef, $script = <$fh> }
    close $fh;
    my $length = length $script;
    $self->havespace( $name, $length );
    return $self->putscript( $name, $script );
}

sub getfile {
    my ( $self, $name, $file ) = @_;
    my $script = $self->getscript($name);
    open( my $fh, '>', $file );
    print {$fh} $script;
    return close $fh;
}

sub listscripts {
    my ( $self, $unactive ) = @_;
    my (@scripts);
    @scripts = @{ $self->SUPER::listscripts() };
    my $active = delete $scripts[-1];
    if ($unactive) {
        @scripts = grep { $_ ne $active } @scripts;
    }
    return @scripts;
}

sub deletescript {
    my ( $sieve, @scripts ) = @_;
    for my $script (@scripts) {
        $sieve->SUPER::deletescript($script);
    }
    return 1;
}

sub view_script {
    my ( $sieve, $script )   = @_;
    my ( $fh,    $filename ) = $sieve->temp_scriptfile($script);
    unless ($fh) { die $sieve->error() . "\n" }
    my $pager = $ENV{'PAGER'} || "less";
    no warnings 'exec';
    eval { system( $pager, $filename ); 1; } or do {
        print
"Error calling your pager application: $!\nUsing cat as fallback.\n\n";
        $sieve->cat($script);
    };
    return 1;
}

sub edit_script {
    my ( $sieve, $script ) = @_;
    my ( $fh, $filename ) = $sieve->temp_scriptfile( $script, 1 );
    my $editor = $ENV{'VISUAL'} || $ENV{'EDITOR'} || "vi";
    while (1) {
        system( $editor, $filename );
        eval { $sieve->putfile( $filename, $script ); 1; } or do {
            print "$@\n";
            ## There was maybe a parse error, if the user enters yes
            ## we reedit the file, otherwise we leave it by the next last
            next if prompt( "Re-edit script? ", -yn );
        };
        ## There was either no error with putfile or the user entered no
        last;
    }
    return close $fh;
}

sub activate {
    my ( $self, $script ) = @_;
    return $self->setactive($script);
}

sub deactivate {
    my $self = shift;
    return $self->setactive("");
}

sub is_active {
    my ( $self, $script ) = @_;
    return $self->get_active() eq $script;
}

sub get_active {
    my ($self) = @_;
    return $self->SUPER::listscripts()->[-1];
}

sub script_exists {
    my ( $self, $scriptname ) = @_;
    my %script = map { $_ => 1 } $self->listscripts;
    return defined( $script{$scriptname} );
}

1;    # End of Net::ManageSieve::Siesh

__END__

=head1 NAME

Net::ManageSieve::Siesh - Expanding Net::ManagieSieve beyond the pure protocol

=head1 VERSION

Version 0.05

=head1 SYNOPSIS

Net::ManageSieve::Siesh expands Net::ManagieSieve beyond just implementing
the core RFC protocol. There are functions to upload and download files,
deactivating scripts, copy and move them etc.

    use Net::ManageSieve::Siesh;

    my $sieve = Net::ManageSieve::Siesh->new();
    $sieve->copy('script1','script2');
    $sieve->mv('script2','script3');
    $sieve->put('../script.txt','script4');
    $sieve->get('script1','../script.txt');

If you're just searching for a comamnd line interface to ManageSieve,