BEGIN { use_ok(
'SharePoint::SOAPHandler'
) };
BEGIN { use_ok(
'CopyTree::VendorProof'
) };
BEGIN { use_ok(
'Term::ReadKey'
) };
my
%config
;
$config
{sharepointdomain} ||=
'www.yoursharepointsite.org:443'
;
$config
{domuser} ||=
'DOMAIN_CAPS\username'
;
$config
{no_proxies} ||=
'y'
;
open
my
$config_fh
,
"<"
,
"test.config"
or
die
"Could not open test configuration!"
;
while
(<
$config_fh
>) {
chomp
;
my
(
$key
,
$value
) =
split
/\s+/,
$_
, 2;
$config
{
$key
} =
$value
;
}
close
$config_fh
;
SKIP:{
skip
'skipping online tests'
, 42
if
(!
$config
{
'live_tests'
});
my
$cpobj
= CopyTree::VendorProof->new;
isa_ok (
$cpobj
,
"CopyTree::VendorProof"
,
'cpobj is a correct obj'
);
my
$soaphandler_inst
=SharePoint::SOAPHandler->new;
isa_ok (
$soaphandler_inst
,
"SharePoint::SOAPHandler"
,
'connector_inst is a correct SharePoint::SOAPHandler obj'
);
my
(
$u
,
$p
,
$creds_dom
,
$authroot
,
$no_https_proxy
);
print
STDERR
"\n"
;
print
STDERR
"========================================================================\n"
;
print
STDERR
"| We need to connect to your sharepoint site |\n"
;
print
STDERR
"| Please enter your sharepoint username: |\n"
;
print
STDERR
"| Note: it must be in this format: DOMAIN_ALLCAPS\\username |\n"
;
print
STDERR
"| |\n"
;
print
STDERR
"=======================================================================|\n"
;
print
STDERR
"DOMAIN\\username ["
.
$config
{domuser}.
"]: "
;
chomp
(
$u
= <STDIN>);
$config
{domuser}=
$u
if
$u
;
print
STDERR
"\n"
;
print
STDERR
"========================================================================\n"
;
print
STDERR
"| Now please enter your password for sharepoint: |\n"
;
print
STDERR
"=======================================================================|\n"
;
print
STDERR
"password (will not echo on screen): "
;
Term::ReadKey::ReadMode(
'noecho'
);
chomp
(
$p
=<STDIN>);
print
STDERR
"\n"
;
Term::ReadKey::ReadMode(0);
print
STDERR
"========================================================================\n"
;
print
STDERR
"| enter your sp_creds_domain as such: |\n"
;
print
STDERR
"| (no 'http://' and no trailing '/' ) |\n"
;
print
STDERR
"| www.sharepointsite.org:443 |\n"
;
print
STDERR
"| |\n"
;
print
STDERR
"=======================================================================|\n"
;
print
STDERR
"sp_creds_domain ["
.
$config
{sharepointdomain}.
"]: "
;
chomp
(
$creds_dom
=<STDIN>);
$creds_dom
=~ s/\/$//;
$config
{sharepointdomain}=
$creds_dom
if
$creds_dom
;
print
STDERR
"\n"
;
print
STDERR
"========================================================================\n"
;
print
STDERR
"| enter your sp_authorizedroot as such: |\n"
;
print
STDERR
"| Use plain spaces (don't escape with %20) and |\n"
;
print
STDERR
"| Please, NO trailing slashes. |\n"
;
print
STDERR
"=======================================================================|\n"
;
print
STDERR
"sp_authorizedroot ["
.
$config
{authroot}.
"]: "
;
chomp
(
$authroot
=<STDIN>);
$authroot
=~ s/\/$//;
$config
{authroot}=
$authroot
if
$authroot
;
print
STDERR
"\n"
;
print
STDERR
"========================================================================\n"
;
print
STDERR
"| do you normally use a proxy server, but want to AVOID |\n"
;
print
STDERR
"| using it for your https sharepoint connection? (y/n) |\n"
;
print
STDERR
"| [that is, enter 'y' to avoid proxy, or 'n' to use it] |\n"
;
print
STDERR
"| your config could be: |\n"
;
print
STDERR
"| you don't know what a proxy is --> type 'n' |\n"
;
print
STDERR
"| your sharepoint is outside your proxy --> type 'n' |\n"
;
print
STDERR
"| your sharepoint is inside your proxy --> type 'y' |\n"
;
print
STDERR
"| |\n"
;
print
STDERR
"=======================================================================|\n"
;
print
STDERR
"no_https_proxy ["
.
$config
{no_proxies}.
"]: "
;
chomp
(
$no_https_proxy
=<STDIN>);
$config
{no_proxies}=
$no_https_proxy
if
$no_https_proxy
;
if
(
$config
{no_proxies} eq
'y'
){
delete
$ENV
{
'https_proxy'
};
delete
$ENV
{
'http_proxy'
};
}
print
STDERR
"\n"
;
open
$config_fh
,
">"
,
"test.config"
;
for
my
$key
(
keys
%config
) {
print
$config_fh
"$key "
.
$config
{
$key
} .
"\n"
;
}
print
"*******************************\n"
;
isnt (
$config
{domuser},
''
,
'has a sp username'
);
isnt (
$p
,
''
,
'has a sp password'
);
isnt (
$config
{sharepointdomain},
''
,
'has a sp_creds_domain'
);
isnt (
$config
{authroot},
''
,
'has a sp_authrized_root'
);
$soaphandler_inst
->sp_creds_domain (
$config
{sharepointdomain});
$soaphandler_inst
->sp_creds_user(
$config
{domuser});
$soaphandler_inst
->sp_creds_password(
$p
);
$soaphandler_inst
->sp_authorizedroot(
$config
{authroot});
my
$content
=
"somecontent\n"
;
$soaphandler_inst
-> cust_mkdir (
'Shared Documents/script_qc'
)or clunk();
my
$path
=
'Shared Documents/script_qc/somepath'
;
$soaphandler_inst
-> write_from_memory(\
$content
,
$path
);
my
$readmemscalarref
=
$soaphandler_inst
-> read_into_memory(
$path
);
is (
$$readmemscalarref
,
"somecontent\n"
,
"test read content to be same as written"
);
my
$newpath
=
'Shared Documents/script_qc/somepath2'
;
$soaphandler_inst
-> copy_local_files(
$path
,
$newpath
);
my
$newcontent
=
"newcontent\n"
;
$soaphandler_inst
-> write_from_memory(\
$newcontent
,
$newpath
);
$readmemscalarref
=
$soaphandler_inst
-> read_into_memory(
$newpath
);
is (
$$readmemscalarref
,
"newcontent\n"
,
"test read, new content overwrite old content"
);
$soaphandler_inst
-> copy_local_files(
$path
,
$newpath
);
$readmemscalarref
=
$soaphandler_inst
-> read_into_memory(
$newpath
);
is (
$$readmemscalarref
,
"somecontent\n"
,
"copy_local_files will overwrite content (newcontent back to somecontent)"
);
my
$newdirpath
=
'Shared Documents/script_qc/targetdir'
;
$soaphandler_inst
-> cust_mkdir (
$newdirpath
)or clunk();
$soaphandler_inst
-> write_from_memory(\
$newcontent
,
'Shared Document/script_qc/targetdir'
);
my
@emptyarr
=
$soaphandler_inst
-> fdls(
''
,
$newdirpath
);
is (
scalar
(
@emptyarr
),
"0"
,
"write_from_memory should fail on dir target"
);
@emptyarr
=
$soaphandler_inst
-> fdls(
''
,
$newdirpath
);
$soaphandler_inst
-> copy_local_files(
$path
,
$newdirpath
);
is (
scalar
(
@emptyarr
),
"0"
,
"copy_local_files should fail on dir target"
);
isa_ok (
ref
$cpobj
->src (
$path
,
$soaphandler_inst
),
'CopyTree::VendorProof'
,
'src returns self'
);
is (
ref
$cpobj
->{
'source'
}{
$path
},
'SharePoint::SOAPHandler'
,
'src stores connector_inst with path as key'
);
my
@testpath
=
keys
%{
$cpobj
->{
'source'
}};
is (
$testpath
[0],
$path
,
'src stores actual path key'
);
$path
=
'Shared Documents/script_qc/someotherpath'
;
$cpobj
->dst (
$path
,
$soaphandler_inst
);
is (
ref
$cpobj
->{
'destination'
}{
$path
},
'SharePoint::SOAPHandler'
,
'dst stores path and connector_inst'
);
my
(
$returnpath
,
$returninst
) =
$cpobj
->dst ();
is (
$returnpath
,
$path
,
'first part of dst() returns path'
);
is (
ref
$returninst
,
'SharePoint::SOAPHandler'
,
'second part of dst() returns connector_inst'
);
my
$newcpobj
= CopyTree::VendorProof->new;
eval
{
$newcpobj
->cp;};
like ($@,
qr"^dest file is not defined\."
,
'no dst object/file'
);
$newcpobj
= CopyTree::VendorProof->new;
$newcpobj
-> dst (
''
,
$soaphandler_inst
);
eval
{
$newcpobj
->cp;};
like ($@,
qr"^dest file is not defined\."
,
'dst obj, no fd_ls meth, no path. no path fails first'
);
$newcpobj
= CopyTree::VendorProof->new;
$newcpobj
-> dst (
'Shared Documents/script_qc/someotherpath'
,
$soaphandler_inst
);
eval
{
$newcpobj
->cp;};
like ($@,
qr/you don't have a source/
, 'copy
local
to
local
, somepath to someotherpath,
no
src declair');
$newcpobj
->src (
'Shared Documents/script_qc/somepath'
,
'nobj'
);
eval
{
$newcpobj
->cp;};
like ($@,
qr/Can't locate object method "is_fd"/
, 'copy
local
to
local
, somepath to someotherpath, src inst
no
methods');
$newcpobj
= CopyTree::VendorProof->new;
$newcpobj
-> dst (
'Shared Documents/script_qc/someotherpath'
,
$soaphandler_inst
);
$newcpobj
->src (
'Shared Documents/script_qc/somepath'
,
$soaphandler_inst
);
eval
{
$newcpobj
->cp;};
is ($@,
''
,
'copy local to local, somepath to someotherpath'
);
is (
$soaphandler_inst
-> is_fd (
'Shared Documents/script_qc/somepath'
) ,
'f'
,
'file test f on src'
);
is (
$soaphandler_inst
-> is_fd (
'Shared Documents/script_qc/someotherpath'
) ,
'f'
,
'file test f on src'
);
my
@files
;
@files
=
$soaphandler_inst
->fdls (
'f'
,
'.'
);
isnt (
$files
[0],
''
,
'fdls f, . shoudld get somepath and someotherpath'
);
$soaphandler_inst
->cust_mkdir(
"Shared Documents/script_qc/testdir"
);
my
@dirs
=
$soaphandler_inst
->fdls (
'd'
,
'Shared Documents/script_qc/testdir/../'
);
isnt (
$dirs
[0],
''
,
'fdls f, ../ use of .. and ending slash auto removed'
);
is (
$soaphandler_inst
-> is_fd (
"Shared Documents/script_qc/testdir"
),
'd'
,
"is_fd returns 'd' on dir"
);
$newcpobj
->
reset
;
$newcpobj
->src (
'Shared Documents/script_qc/someotherpath'
,
$soaphandler_inst
);
$newcpobj
->dst (
'Shared Documents/script_qc/testdir'
,
$soaphandler_inst
);
$newcpobj
->cp;
is (
$soaphandler_inst
->is_fd(
'Shared Documents/script_qc/testdir/someotherpath'
),
'f'
,
'cp file to dir'
);
$newcpobj
->
reset
;
$newcpobj
->src (
'Shared Documents/script_qc/someotherpath'
,
$soaphandler_inst
);
$newcpobj
->dst (
'Shared Documents/script_qc/testdir/diffname'
,
$soaphandler_inst
);
$newcpobj
->cp;
is (
$soaphandler_inst
->is_fd(
'Shared Documents/script_qc/testdir/diffname'
),
'f'
,
'cp file to different file name'
);
$newcpobj
->
reset
;
$newcpobj
->src (
'Shared Documents/script_qc/testdir'
,
$soaphandler_inst
);
$newcpobj
->dst (
'Shared Documents/script_qc/testdir2'
,
$soaphandler_inst
);
eval
{
$newcpobj
->cp;};
like ($@,
qr/you cannot copy a dir \[Shared Documents\/
script_qc\/testdir] into a non \/ non-existing dir \[Shared Documents\/script_qc\/testdir2]/,
'cp dir to dir copy, check non existing dest dir copy shoudl fail'
);
$soaphandler_inst
->cust_mkdir (
'Shared Documents/script_qc/testdir2'
);
$newcpobj
->cp;
is (
$soaphandler_inst
->is_fd(
'Shared Documents/script_qc/testdir2/testdir'
),
'd'
,
'cp dir to dir copy, check source dir inside dest'
);
is (
$soaphandler_inst
->is_fd(
'Shared Documents/script_qc/testdir2/testdir/diffname'
),
'f'
,
'cp dir to dir copy, check source dir, file inside dest'
);
is (
$soaphandler_inst
->is_fd(
'Shared Documents/script_qc/testdir2/testdir/someotherpath'
),
'f'
,
'cp dir to dir copy, check source dir, file inside dest'
);
is (
$soaphandler_inst
->is_fd(
'Shared Documents/script_qc/nonexist/bsfile'
), 0,
'cp dir to dir copy, check source dir, file inside dest'
);
$soaphandler_inst
->write_from_memory(
$soaphandler_inst
->read_into_memory(
'Shared Documents/script_qc/testdir2/testdir/diffname'
),
'Shared Documents/script_qc/testdir2/written'
);
$soaphandler_inst
->copy_local_files(
'Shared Documents/script_qc/testdir2/testdir/diffname'
,
'Shared Documents/script_qc/testdir2/written_local'
);
is (
$soaphandler_inst
->is_fd(
'Shared Documents/script_qc/testdir2/written'
),
'f'
,
'write_from_memory, read_into_memory test'
);
is (
$soaphandler_inst
->is_fd(
'Shared Documents/script_qc/testdir2/written_local'
),
'f'
,
'copy_local_files test'
);
my
(
$arrf
,
$arrd
) =
$soaphandler_inst
->fdls (
'fdarrayrefs'
,
'.'
);
is (
ref
$arrf
,
'ARRAY'
,
'fdarrayrefs test'
);
is (
ref
$arrd
,
'ARRAY'
,
'fdarrayrefs test'
);
eval
{
$soaphandler_inst
-> cust_rmdir (
'non-existingdir'
);};
like ($@,
qr/wait\. you told me to delete something that's not a dir\. I'll stop for your protection/
,
'removing an non existing dir dies'
);
$soaphandler_inst
->cust_rmdir (
"Shared Documents/script_qc/testdir"
);
$soaphandler_inst
->cust_rmdir (
"Shared Documents/script_qc/testdir2"
);
$soaphandler_inst
->cust_rmfile (
'Shared Documents/script_qc/somepath'
);
is (
$soaphandler_inst
-> is_fd(
'Shared Documents/script_qc/somepath'
),
'pd'
,
'successful single file delete'
);
is (
$soaphandler_inst
-> is_fd (
"Shared Documents/script_qc/testdir"
),
'pd'
,
"is_fd returns 'pd' on non-existing"
);
$soaphandler_inst
->cust_rmdir (
"Shared Documents/script_qc"
);
is (
$soaphandler_inst
-> is_fd (
"Shared Documents/script_qc"
),
'pd'
,
"is_fd returns 'pd' on non-existing"
);
}
done_testing();