File Coverage

blib/lib/Siebel/Srvrmgr/ListParser/FSA.pm

Criterion	Covered	Total	%
statement	165	185	89.1
branch	34	44	77.2
condition	5	9	55.5
subroutine	50	56	89.2
pod	2	2	100.0
total	256	296	86.4

package Siebel::Srvrmgr::ListParser::FSA;
use warnings;
use strict;
use Log::Log4perl;
use Siebel::Srvrmgr;
use Siebel::Srvrmgr::Regexes qw(SRVRMGR_PROMPT);
use Scalar::Util qw(weaken);

use parent 'FSA::Rules';

=pod

=head1 NAME

Siebel::Srvrmgr::ListParser::FSA - the FSA::Rules class specification for Siebel::Srvrmgr::ListParser

=head1 SYNOPSIS

	use FSA::Rules;
	my $fsa = Siebel::Srvrmgr::ListParser::FSA->get_fsa();
    # do something with $fsa

    # for getting a diagram exported in your currently directory with a onliner
    perl -MSiebel::Srvrmgr::ListParser::FSA -e "Siebel::Srvrmgr::ListParser::FSA->export_diagram"

=head1 DESCRIPTION

Siebel::Srvrmgr::ListParser::FSA subclasses the state machine implemented by L<FSA::Rules>, which is used by L<Siebel::Srvrmgr::ListParser> class.

This class also have a L<Log::Log4perl> instance built in.

=head1 EXPORTS

Nothing.

=head1 METHODS

=head2 export_diagram

Creates a PNG file with the state machine diagram in the current directory where the method was invoked.

=cut

sub export_diagram {

    my $fsa = get_fsa();

    my $graph = $fsa->graph( layout => 'neato', overlap => 'false' );
    $graph->as_png('pretty.png');

    return 1;

}

=pod

=head2 new

Returns the state machine object defined for usage with a L<Siebel::Srvrmgr::ListParser> instance.

Expects as parameter a hash table reference containing all the commands alias as keys and their respective regular expressions to detect
state change as values. See L<Siebel::Srvrmgr::ListParser::OutputFactory> C<get_mapping> method for details.

=cut

sub new {

    my $class   = shift;
    my $map_ref = shift;

    my $log_cfg = Siebel::Srvrmgr->logging_cfg();

    die 'Could not start logging facilities'
      unless ( Log::Log4perl->init_once( \$log_cfg ) );

    my $logger = Log::Log4perl->get_logger('Siebel::Srvrmgr::ListParser');

    $logger->logdie('the output type mapping reference received is not valid')
      unless ( ( defined($map_ref) ) and ( ref($map_ref) eq 'HASH' ) );

    my %params = (
        done => sub {

            my $self = shift;

            my $curr_line = shift( @{ $self->notes('all_data') } );
 # :TODO:22-02-2015 18:22:29:: add a new method to do that
            $self->notes( 'line_num' => ( $self->notes('line_num') + 1 ) );

            if ( defined($curr_line) ) {

                if ( defined( $self->notes('last_command') )
                    and ( $self->notes('last_command') eq 'exit' ) )
                {

                    return 1;

                }
                else {

                    $self->notes( line => $curr_line );
                    return 0;

                }

            }
            else { # no more lines to process

                return 1;

            }

        }
    );

    my $self = $class->SUPER::new(
        \%params,
        no_data => {
            do => sub {

                my $logger =
                  Log::Log4perl->get_logger('Siebel::Srvrmgr::ListParser');

                if ( $logger->is_debug() ) {

                    $logger->debug('Searching for useful data');

                }

            },
            rules => [
                greetings => sub {

                    my $state = shift;

                    if ( defined( $state->notes('line') ) ) {

                        return (
                            $state->notes('line') =~ $map_ref->{greetings} );

                    }
                    else {

                        return 0;

                    }

                },
                command_submission => sub {

                    my $state = shift;

                    if ( defined( $state->notes('line') ) ) {

                        return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                    }
                    else {

                        return 0;

                    }

                },
            ],
            message => 'Line read'

        },
        greetings => {
            label    => 'greetings message from srvrmgr',
            on_enter => sub {

                my $state = shift;
                $state->notes( is_cmd_changed     => 0 );
                $state->notes( is_data_wanted     => 1 );
                $state->notes( 'create_greetings' => 1 )
                  unless ( $state->notes('greetings_created') );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        end => {
            do => sub {

                my $logger =
                  Log::Log4perl->get_logger('Siebel::Srvrmgr::ListParser');
                $logger->debug('Enterprise says bye-bye');

            },
            rules => [
                no_data => sub {
                    return 1;
                }
            ],
            message => 'EOF'
        },
        list_comp => {
            label    => 'parses output from a list comp command',
            on_enter => sub {
                my $state = shift;
                $state->notes( is_cmd_changed => 0 );
                $state->notes( is_data_wanted => 1 );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        list_comp_types => {
            label    => 'parses output from a list comp types command',
            on_enter => sub {
                my $state = shift;
                $state->notes( is_cmd_changed => 0 );
                $state->notes( is_data_wanted => 1 );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        list_params => {
            label    => 'parses output from a list params command',
            on_enter => sub {
                my $state = shift;
                $state->notes( is_cmd_changed => 0 );
                $state->notes( is_data_wanted => 1 );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        list_comp_def => {
            label    => 'parses output from a list comp def command',
            on_enter => sub {
                my $state = shift;
                $state->notes( is_cmd_changed => 0 );
                $state->notes( is_data_wanted => 1 );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        list_tasks => {
            label    => 'parses output from a list tasks command',
            on_enter => sub {
                my $state = shift;
                $state->notes( is_cmd_changed => 0 );
                $state->notes( is_data_wanted => 1 );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        list_servers => {
            label    => 'parses output from a list servers command',
            on_enter => sub {
                my $state = shift;
                $state->notes( is_cmd_changed => 0 );
                $state->notes( is_data_wanted => 1 );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        list_sessions => {
            label    => 'parses output from a list sessions command',
            on_enter => sub {
                my $state = shift;
                $state->notes( is_cmd_changed => 0 );
                $state->notes( is_data_wanted => 1 );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        set_delimiter => {
            label    => 'parses output (?) from set delimiter command',
            on_enter => sub {
                my $state = shift;
                $state->notes( is_cmd_changed => 0 );
                $state->notes( is_data_wanted => 1 );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        load_preferences => {
            label    => 'parses output from a load preferences command',
            on_enter => sub {
                my $state = shift;
                $state->notes( is_cmd_changed => 0 );
                $state->notes( is_data_wanted => 1 );
            },
            on_exit => sub {

                my $state = shift;
                $state->notes( is_data_wanted => 0 );

            },
            rules => [
                command_submission => sub {

                    my $state = shift;
                    return ( $state->notes('line') =~ SRVRMGR_PROMPT );

                },
            ],
            message => 'prompt found'
        },
        command_submission => {
            do => sub {

                my $state = shift;

                my $logger =
                  Log::Log4perl->get_logger('Siebel::Srvrmgr::ListParser');
                if ( $logger->is_debug() ) {

                    $logger->debug( 'command_submission got ['
                          . $state->notes('line')
                          . ']' );

                }

                $state->notes( found_prompt => 1 );
                my $cmd = ( $state->notes('line') =~ SRVRMGR_PROMPT )[1];

                if ( ( defined($cmd) ) and ( $cmd ne '' ) ) {

                    # removing spaces from command
                    $cmd =~ s/^\s+//;
                    $cmd =~ s/\s+$//;

                    $logger->debug("last_command set with '$cmd'")
                      if $logger->is_debug();

                    $state->notes( last_command   => $cmd );
                    $state->notes( is_cmd_changed => 1 );

                }
                else {

                    if ( $logger->is_debug() ) {

                        $logger->debug(
                            'got prompt, but no command submitted in line '
                              . $state->notes('line_num') );

                    }

                    $state->notes( last_command   => '' );
                    $state->notes( is_cmd_changed => 1 );

                }

            },
            rules => [
                set_delimiter => sub {

                    my $state = shift;

                    if ( $state->notes('last_command') =~
                        $map_ref->{set_delimiter} )
                    {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                list_comp => sub {

                    my $state = shift;

                    if (
                        $state->notes('last_command') =~ $map_ref->{list_comp} )
                    {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                list_comp_types => sub {

                    my $state = shift;

                    if ( $state->notes('last_command') =~
                        $map_ref->{list_comp_types} )
                    {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                list_params => sub {

                    my $state = shift;

                    if ( $state->notes('last_command') =~
                        $map_ref->{list_params} )
                    {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                list_tasks => sub {

                    my $state = shift;

                    if ( $state->notes('last_command') =~
                        $map_ref->{list_tasks} )
                    {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                list_servers => sub {

                    my $state = shift;

                    if ( $state->notes('last_command') =~
                        $map_ref->{list_servers} )
                    {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                list_sessions => sub {

                    my $state = shift;

                    if ( $state->notes('last_command') =~
                        $map_ref->{list_sessions} )
                    {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                list_comp_def => sub {

                    my $state = shift;

                    if ( $state->notes('last_command') =~
                        $map_ref->{list_comp_def} )
                    {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                load_preferences => sub {

                    my $state = shift;

                    if ( $state->notes('last_command') =~
                        $map_ref->{load_preferences} )
                    {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                no_data => sub {

                    my $state = shift;

                    if ( $state->notes('last_command') eq '' ) {

                        return 1;

                    }
                    else {

                        return 0;

                    }

                },
                # add other possibilities here of list commands
            ],
            message => 'command submitted'
        }
    );

    return $self;

}

1;

=pod

=head1 SEE ALSO

=over

=item *

L<Siebel::Srvrmgr::ListParser>

=item *

L<FSA::Rules>

=back

=head1 CAVEATS

This class has some problems, most due the API of L<FSA::Rules>: since the state machine is a group of references to subroutines, it holds references
to L<Siebel::Srvrmgr::ListParser>, which basically causes circular references between the two classes.

There is some workaround to the caused memory leaks due this configuration, but in future releases L<FSA::Rules> may be replaced to something else.

=head1 AUTHOR

Alceu Rodrigues de Freitas Junior, E<lt>[e-mail]<gt>.

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 of Alceu Rodrigues de Freitas Junior, E<lt>[e-mail]<gt>.

This file is part of Siebel Monitoring Tools.

Siebel Monitoring Tools is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Siebel Monitoring Tools is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Siebel Monitoring Tools.  If not, see <http://www.gnu.org/licenses/>.

=cut