=head1 NAME

Mikrotik - Perl interface for Mikrotik devices.

=head1 SYNOPSIS

  use Mikrotik;

  $user = 'foo';
  $password = 'bar';
  $ip = '1.1.1.1';
  
  $dev = new Mikrotik ( ip=> $ip, user=>$user, password=> $password);
  
  $dev->ip;           # get the IP address object;
  
  $dev->arp;          # get the ARP table from  device;
  
  $dev->set_clock;    # set the device clock 
  $dev->reboot;       # reboot the device
  
  $dev->address_add ( ethernet_interface, ip_address, netmask );  # Edd the IP address for ethernet interface. 
                                                                  # Ethernet_interface= 'eth0', 'eth1' .. etc     
                                                                                                                             
  $dev->address_remove ( ethernet_interface, ip_address )         # Remove the IP addreess from ethernet interface
  
  $dev->address_change  ( ethernet_interface, ip_address , user , password);      # Change the current ip address to the new one. 
                                                                                  # User/password are needed for connection to new IP address
                                                                            
  $dev->dns_set ( ip_address, type);  # Set the DNS. type = primary/sevondary.
  
  $dev->dns_get;    # Get the DNS.
  
  $dev->free_space; # Free space onm the device;
  
  $dev->time        # Get the time;
  
  $dev->free_memory;
  
  $dev->total_memory;
  

=cut
=head2 NOTES

This is tested for RB333.

=cut

# The POD text continues at the end of the file.


package Mikrotik;
use strict;
use Net::SSH::Perl;
use Net::IP;
use Net::Netmask;
use Class::Date;
use Log::Log4perl;

$VERSION = 0.1;

our $ssh;

sub new { 
  my ($this,%params) = @_;
  my $class = ref $this|| $this;
  my $ip = new Net::IP ( $params{ip} )|| die ('IP ERROR');
  
  $ssh = Net::SSH::Perl->new ($ip->ip);
  
  $ssh->login( $params{user}, $params{password} );

  my $debug = 0;
  $debug = 1
    if $params{debug} == 1;
  #TO DO - debug  
  return  bless { debug => $debug }, $class;

};

sub ip (){
   my ($self,$ip_address)=@_;
   my $netmask;
   
   my ($ip) = $ip_address =~ m/^\W*(\d+\W\d+\W\d+\W\d+)/;
   my $netmask = $ip_address =~ m/\/(\S+)$/;
   $ip = new Net::IP ($ip) or die ( Net::IP::Error() );
   $netmask =  new Net::Netmask ($ip_address)
      if $netmask;
   return ($ip,$netmask);
}

sub arp {
   my ($output,$err,$std_err)= $ssh->cmd('/ip arp print');
   
   return 
      unless $output;

   my @list; 
   while ( $output =~ /(\d+\.\d+\.\d+\.\d+)\W+(\w+:\w+:\w+:\w+:\w+:\w+)\W+(\w+)/g ) {
      push @list ,{  ip => $1, mac_address =>  $2, interface => $3 ,};
   }
   return @list;
};


sub set_clock {
   my ($self,$param)= @_;
   my ($output,$err,$std_err);
   
   if ( defined $param->{time} ){      
      ($output,$err,$std_err)= $ssh->cmd('system clock set time=' . $param->{time} )
         if $param->{time} =~ /\d{1,2}:\d{1,2}:\d{1,2}/;
   }
   
   if ( defined $param->{date} ){      
      ($output,$err,$std_err)= $ssh->cmd('system clock set date=' . $param->{date})
          if  $param->{date} =~ /\w+\/\d{1,2}\/\d{4}/;
   }
  return 1;  
};

sub reboot {
   my ($self,$param)= @_;
   my ($output,$err,$std_err)= $ssh->cmd('system reboot' );

  return 1;  
};

sub address_add {
   my ($self,$interface,$ip_address,$netmask)=@_;

   return 
      unless $interface;
   
   my ($ip,$netmask) = $self->ip($ip_address);
 
   my $cmd = "/ip addr add interface=$interface address=" . $ip->ip . " netmask=" . $netmask->mask;

   my ($output,$err,$std_err)= $ssh->cmd("$cmd");
   
   return 1
     unless $err;
         
   return;
};

sub address_remove {
   my ($self,$interface,$ip_address)=@_;
   return
     unless $interface;
   return 
     unless $ip_address;
   
   my ($ip,$netmask) =  $self->ip($ip_address);
   $ip_address = $ip->ip .'/' . $netmask->bits;
     
   my $cmd = '{ :foreach a in=[/ip address find interface=' . $interface .'] do={ :if ( [ /ip address get $a address  ] = "' . $ip_address . '" ) do={ /ip address remove $a  } } }' ;

   my ($output,$err,$std_err)= $ssh->cmd("$cmd");
  
   return 1
      unless $err == 0 ;

   return;
};

sub address_change {
   my ($self,$interface,$ip_address,$user,$password) = @_ ;
   return 
      unless $interface;
      
   my ($ip,$netmask) =  $self->ip($ip_address);
   
   my $cmd = "/ip address print terse  where interface=$interface";
   
   my($output, $stderr, $exit) =  $ssh->cmd($cmd);
   return 
      if $stderr;

   my ($ip_old) = $output =~ m/address=(\S+)\b/;
   
   my ($ip_old,$netmask_old) = $self->ip($ip_old);      

   $netmask = $netmask_old
       unless $netmask;

   $ip_address = $ip->ip .'/' . $netmask->bits;

  return
     unless $self->address_add($interface,$ip_address);
     
   ###Connect to new IP
   if ($user && $password){
      $ssh = Net::SSH::Perl->new ($ip->ip);
      $ssh->login($user,$password);
   }
   
   my $cmd = "/ip address print count-only  where interface=$interface";
   ($output, $stderr, $exit) = $ssh ->cmd($cmd);

   return 
      unless $output>1;
   print 'OK';
   ###delete old IP
   return 1
      if $self->address_remove ($interface,$ip_old);

   return;
   
};

sub dns_set {
    my ($self,$ip_address,$type) = @_ ;
    return
       unless $ip_address;
       
    return 
       unless $type;
       
    $type = $type . '-dns';
    
    my ($ip,$netmask) =  $self->ip($ip_address);   
    my $cmd = "/ip dns set $type=" . $ip->ip;
    my ($output, $stderr, $exit) = $ssh ->cmd($cmd);
    return $output;
}

sub dns_get {
    my ($self,$type) = @_ ;
    
    return 
       unless $type;
    $type = $type . '-dns';

    my $cmd = "{:put [ ip dns get $type ]}";

    my ($output, $stderr, $exit) = $ssh ->cmd($cmd);
    return $output;
}

sub uptime {
   my ($output,$err,$std_err)= $ssh->cmd('{:put [/system resource get uptime]}');
   
   return 
      unless $output;
   return $output;
};

sub device {
   my ($output,$err,$std_err)= $ssh->cmd('{:put [/system resource get board-name]}');
   
   return 
      unless $output;
   return $output;
};

sub free_memory {
   my ($output,$err,$std_err)= $ssh->cmd('{:put [/system resource get free-memory]}');
   
   return 
      unless $output;
   return $output;
};

sub total_memory {
   my ($output,$err,$std_err)= $ssh->cmd('{:put [/system resource get total-memory]}');
   
   return 
      unless $output;
   return $output;
};

sub free_space {
   my ($output,$err,$std_err)= $ssh->cmd('{:put [/system resource get free-hdd-space]}');
   
   return 
      unless $output;
   return $output;
};

sub time {
   my $month_map = {
      'jan' => 1,
      'feb' => 2,
      'mar' => 3,
      'apr' => 4,
      'may' => 5,
      'jun' => 6,
      'jul' => 7,
      'aug' => 8,
      'sep' => 9,
      'oct' => 10,
      'nov' => 11,
      'dec' => 12,
   };
   my ($output,$err,$std_err)= $ssh->cmd('{:put [/system clock get date]}');
   return 
      unless $output;
   my ($month,$day,$year) = $output=~ /(\w+)\/(\d{1,2})\/(\d{4})/;
    
   $month = $month_map->{$month};
   
   my ($output,$err,$std_err)= $ssh->cmd('{:put [/system clock get time]}');
   return 
      unless $output;
   my ($hour,$min,$sec) = $output=~ /(\d{1,2}):(\d{1,2}):(\d{1,2})/;

   return   new Class::Date([$year,$month,$day,$hour,$min,$sec]);

};

package Hotspot::Device::RB333;
1;