FSM-Basic

 view release on metacpan or  search on metacpan

examples/fake_bash.pl  view on Meta::CPAN

    $log_filter = <$debug_fd>;
    chomp $log_filter;
    close $debug_file, open $log_fd, '>>', $log_file;
    select( ( select($log_fd), $| = 1 )[0] );
}

my $file_def = -f $ENV{HOME} . "/$dstip.json" ? $ENV{HOME} . "/$dstip.json" : "$FindBin::Bin/$dstip.json";
my $json = slurp_file($file_def);
$json = subst($json);

my $file_subst = -f $ENV{HOME} . "/subst_rules.json" ? $ENV{HOME} . "/subst_rules.json" : "$FindBin::Bin/subst_rules.json";
if ( -f $file_subst ) {
    my $subst_json  = slurp_file($file_subst);
    my $subst_rules = from_json($subst_json);
    if ( exists $subst_rules->{all} ) {
        foreach my $subst ( keys %{ $subst_rules->{all} } ) {
            $json =~ s/$subst/$subst_rules->{all}{$subst}/g;
        }
    }
    if ( exists $subst_rules->{$dstip} ) {
        foreach my $subst ( keys %{ $subst_rules->{$dstip} } ) {
            $json =~ s/$subst/$subst_rules->{$dstip}{$subst}/g;
        }
    }
}

my $states       = from_json($json);
my $history_file = glob('~/.bash.history');
my $prompt       = $to_subst{__PROMPT__};
my $term         = Term::ReadLine->new('bash');
my $attribs      = $term->Attribs->ornaments(0);
$term->using_history();
$term->read_history($history_file);
$term->clear_signals();
my $fsm = FSM::Basic->new( $states, 'prompt' );
my $final = 0;
my $out;
my $line;

while ( defined( $line = $term->readline($prompt) ) ) {
    ( $final, $out ) = $fsm->run($line);
    if ( $log_filter ) {
        print $log_fd '[' . scalar(localtime) . "] $srcip => $dstip line=<$line> out=<$out> final=<$final> state=<$fsm->{state}> \n" if $DEBUG && ( $log_filter eq $srcip ||$log_filter eq $dstip) ;
    } else{ 
        print $log_fd '[' . scalar(localtime) . "] $srcip => $dstip line=<$line> out=<$out> final=<$final> state=<$fsm->{state}> \n" if $DEBUG;
    }
    if ( $out =~ s/(\N*)$//s ) {
        $prompt = $1;
    }
    my $old_out = $out;
    $out = subst($out);
    $out = subst_date($out);
    print $out;
    $term->write_history($history_file);
    $out = $old_out;
    last if $final;
}

sub slurp_file {
    my ( $file, $chomp ) = @_;
    my $data = do { local ( @ARGV, $/ ) = $file; <> };
    chomp $data if $chomp;
    return wantarray ? split /\n/, $data : $data;
}



sub subst {
    my ($data) = @_;
    print $log_fd "DATA=$data\n" if $log_level > 0;
    foreach my $subst ( keys %to_subst ) {
        $data =~ s/\Q$subst\E/$to_subst{$subst}/g;
    }
    print $log_fd "DATANEW=$data\n" if $log_level > 0;
    return $data;
}

sub subst_date {
    my ($data) = @_;
    print $log_fd "DATA=$data\n" if $log_level > 0;
    while ( $data =~ /(__DATE(\((.*)\))?([+-]?\d+)?__)/mg ) {
        #__DATE5__
        #__DATE+5__
        #__DATE-5__
        #__DATE(%F %H:%M:%S)__
        #__DATE(%F %H:%M:%S)6__
        #__DATE(%F %H:%M:%S)-6__
        my $fmt   = $3 // '';
        my $tag   = $1 // '';
        my $delta = $4 // 0;
        my $new_tag;
        if ($fmt) {
            $new_tag = strftime( $fmt, localtime( time + ( $delta * 86400 ) ) );
        } else {
            $new_tag = localtime( time + ( $delta * 86400 ) );
        }
        $data =~ s/\Q$tag/$new_tag/mg;
    }
    print $log_fd "DATANEW=$data\n" if $log_level > 0;
    return $data;
}



( run in 0.806 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )