#!/usr/bin/env perl

package INF::Cyclades;

use Net::Telnet;
use Data::Dumper;
use IO::Socket::Socks;

sub flush($) {
    my $self = shift;
    $self->{telnet}->get( Timeout => 1, Errmode => 'return' );
}

sub get_until_timeout($) {
    my $self = shift;
    my $ret  = "";

    my $red;

    while (
        defined(
            $red = $self->{telnet}->get( Timeout => 1, Errmode => 'return' )
        )
      )
    {
        $ret .= $red;
    }

    return $ret;
}

sub get_until_match($$$$) {
    my ( $self, $match, $echo, $tries ) = @_;
    my $ret = "";

    while ( --$tries ) {
        my $data = $self->get_until_timeout;

        print $data if $echo and defined $data;
        $ret .= $data if defined $data;

        if ( index( $ret, $match ) != -1 ) {
            print "\n" if $echo;
            return $ret;
        }
    }
    print "\n" if $echo;
    return undef;
}

sub sync($) {
    my $self = shift;

    my $tries = 7;

    while ( --$tries ) {
        my $data = $self->get_until_timeout;

        if ( $data =~ /username:/i ) {
            $self->{telnet}->print( $self->{username} );
        }
        elsif ( $data =~ /password:/i ) {
            $self->{telnet}->print( $self->{password} );
        }
        elsif ( $data =~ /pm>/i ) {
            last;
        }
        else {
            $self->{telnet}->print("");
        }
    }

    return 1 if $tries > 0;

    return 0;
}

sub update_cache($$) {
    my ( $self, $wot ) = @_;

    #    return undef unless $self->sync;

    $self->{telnet}->print( "status " . $wot );
    my $data = $self->get_until_match( "pm>", 0, 3 );

    my @lines = ( split /\n/, $data );

    shift @lines;
    shift @lines;

    for my $line (@lines) {
        chomp $line;
        chomp $line;
        my @fields = split /\t/, $line;

        my $port = int( $fields[0] );
        next unless $port > 0;

        $fields[1] =~ s/^\s*//;
        $fields[1] =~ s/\s*$//;

        $self->{cache}->[$port] = { name => $fields[1], state => $fields[2] };
    }
}

sub get_cache($) {
    my $self = shift;
    return if exists $self->{cache};

    $self->update_cache("all");
}

sub name_get($) {
    my $self = shift;
    return $self->{host};
}

sub pdu_load_get($) {
    my $self = shift;
    my @ret  = ();

    #    return undef unless $self->sync;

    $self->{telnet}->print("current");
    my $data = $self->get_until_match( "pm>", 0, 3 );

    return undef unless $data =~ /True RMS current: ([.0-9]+)A\./i;
    push @ret, $1;
    push @ret, $1 if $data =~ /True RMS current for segment A: ([.0-9]+)A\./i;
    push @ret, $1 if $data =~ /True RMS current for segment B: ([.0-9]+)A\./i;

    return join( ',', @ret );
}

sub psu_status($) {
    my $self = shift;
    return undef;
}

sub port_count($) {
    my $self = shift;
    $self->get_cache;

    return scalar( @{ $self->{cache} } ) - 1;
}

sub port_id_get_by_number($$) {
    my ( $self, $number ) = @_;
    return $number;
}

sub port_name_get($$) {
    my ( $self, $number ) = @_;

    $self->get_cache;

    return $self->{cache}->[$number]->{name}
      if length( $self->{cache}->[$number]->{name} ) > 0;

    return sprintf "Port %02d", $number;
}

sub port_name_set($$$) {
    my ( $self, $number, $name ) = @_;

    $self->get_cache;

    $name =~ s/ /_/g;

    $self->{telnet}->print( "name " . $number . " " . $name );
    $self->get_until_match( "pm>", 1.3 );

    $self->{telnet}->print("save");
    $self->get_until_match( "pm>", 1.3 );

    $self->update_cache($number);

}

sub port_state_get($$) {
    my ( $self, $number ) = @_;

    $self->get_cache;

    my $ret = $self->{cache}->[$number]->{state};

    $ret =~ s/Unlocked //g;

    return $ret;
}

sub port_state_get_no_cache($$) {
    my ( $self, $number ) = @_;

    if ( $self->{lie} == 1 ) {
        $self->{lie} = 0;
        return "Off";
    }

    $self->update_cache($number);
    return $self->port_state_get($number);
}

sub port_off($$) {
    my ( $self, $number ) = @_;
    $self->{telnet}->print( "off " . $number );
    $self->get_until_match( "pm>", 1, 3 );
}

sub port_on($$) {
    my ( $self, $number ) = @_;
    $self->{telnet}->print( "on " . $number );
    $self->get_until_match( "pm>", 1.3 );
}

sub port_cycle($$) {
    my ( $self, $number ) = @_;
    $self->{telnet}->print( "cycle " . $number );
    $self->get_until_match( "pm>", 1.60 );
}

sub logout($) {
    my $self = shift;
}

sub new ($;$) {
    my ( $class, $parm ) = @_;
    my $self;

    $self->{host}     = $parm->{host}     || "redbus-ms20.mythic-beasts.com";
    $self->{username} = $parm->{username} || "admin";
    $self->{password} = $parm->{password} || "pm8";
    $self->{port}     = $parm->{port}     || "23";

    if ( $self->{host} =~ /^(.*):(.*)$/ ) {
        $self->{iphost} = $1;
        $self->{vmunit} = $2;
    }
    else {
        $self->{iphost} = $self->{host};
    }

    $self->{telnet} = new Net::Telnet(
        Timeout => 10,
        Prompt  => '/pm>/',

        #        Dump_Log => STDERR,
        Binmode => 1
    );

    $self->{lie} = 0;

    $self = bless $self, $class;

    if ( not exists $parm->{proxy_port} ) {
        $self->{telnet}->open(
            Host => $self->{iphost},
            Port => $self->{port}
        );
    }
    else {

        my $sock = IO::Socket::Socks->new(
            ProxyAddr   => $parm->{proxy_host},
            ProxyPort   => $parm->{proxy_port},
            ConnectAddr => $self->{iphost},
            ConnectPort => $self->{port}
        ) or die $SOCKS_ERROR;
        $self->{telnet}->fhopen($sock);
    }

    unless ( $self->sync ) {
        $self->{telnet}->close;
        return undef;
    }

    return $self;
}

1;