The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use Test::More;
use Filesys::SmbClient;
use strict;
use diagnostics;
use Config;

if( !$Config{'PERL_API_REVISION'} or !$Config{'PERL_VERSION'} or 
    ($Config{'PERL_API_REVISION'} != 5  or $Config{PERL_VERSION}<6)) {
  plan skip_all => 
    'tie filehandle for Filesys::SmbClient didn\'t work before Perl 5.6';
}
else {
  plan tests => 20;
}

require Filesys::SmbClient;

my $buffer = "A test of write call\n";
my $buffer2 = "buffer of 1234\n";

SKIP: {
  skip "No server defined for test at perl Makefile.PL", 20 if (!-e ".c");
if (-e ".c") {
  use POSIX;
  my $ok = 0;
  open(F,".c") || die "Can't read .c\n";
  my $l = <F>; chomp($l); 
  my @l = split(/\t/, $l);
  my %param = 
    (
     username  => $l[3],
     password  => $l[4],
     workgroup => $l[2],
     debug     =>  0
    );
  my $smb = new Filesys::SmbClient(%param);
  my $server = "smb://$l[0]/$l[1]";

  # Create a directory
  ok($smb->mkdir("$server/toto"),"Create directory")
    or diag("With $!");

  # Create a file with open / tie
  local *FD;
  tie(*FD, 'Filesys::SmbClient', undef, undef, %param);
  ok(open(FD, ">$server/toto/tata"),
     "TIE: open to create a file")
    or diag("With $!");
  # PRINT
  print FD $buffer;
  # PRINTF
  printf FD "%s",$buffer2;
  # PRINT IN LIST CONTEXT
  print FD "6","\n";
  # SYSWRITE
  my $lg = syswrite(FD,"6\n");
  is($lg,2,"TIE: return of syswrite");
  close(FD);
  $lg = syswrite(FD,"6\n");
  is($lg,undef,"TIE: return of syswrite on a closed filehandle");

  # Read a file with open/tie
  my $f;
  # TIEHANDLE
  ok(open(FD,"$server/toto/tata"),"TIE: read a file") or diag("With $!");
  # READLINE
  is(scalar<FD>,$buffer, "TIE: Read one ligne of a file");
  is(scalar<FD>,$buffer2, "TIE: Read another ligne of a file");
  # GETC
  is(getc(FD),6,"TIE: getc of a file");
  is(getc(FD),"\n","TIE: getc of a file");
  is(getc(FD),6,"TIE: getc of a file");
  is(getc(FD),"\n","TIE: getc of a file");
  # SEEK
  my $rr = seek(FD,0,SEEK_SET);
  is(getc(FD),"A","TIE: seek SEEK_SET a file");
  undef $rr;
  # READ
  $lg = read(FD,$rr,4);
  is($lg, 4,"TIE: Return of read");
  is($rr, " tes", "TIE: buffer read");
#  $rr = seek(FD,2,SEEK_CUR);
#  is(getc(FD),"f","Seek SEEK_CUR a file open with opentie");
#  $rr = seek(FD,0,SEEK_END);
#  is(getc(FD),"b","Seek SEEK_END a file open with opentie");
  close(FD);
  is(seek(FD,0,SEEK_SET),-1,"TIE: seek closed file");
  is(read(FD,$rr,4), undef, "TIE: read closed file");

  # Read a file with opentie in list context
  undef $f;
  open(FD,"$server/toto/tata");
  my @l2 = <FD>;
  close(FD);
  is(join('',@l2),$buffer.$buffer2."6\n"x2,
     "TIE: Read a file in list context");

  # Unlink a file
  ok($smb->unlink("$server/toto/tata"),"Unlink file")
    or diag("With $!");

  # Opentie a non existant file
  ok(!open(FD,"$server/toto/tataa"), "TIE: open a non-existent file");

  # Erase this directory
  ok($smb->rmdir("$server/toto/"),"Rm directory") or diag("With $!");
}
}