#!perl
use
5.010;
my
$dir
= tempdir(
CLEANUP
=> 1 );
my
$name
= our_catfile(
$dir
,
'abc def'
);
{
for
( 1 .. 9 ) {
datafolder(
path
=>
$name
,
date_prefix
=> 0,
time_prefix
=> 0 );
}
mkdir
( our_catfile(
$dir
,
'abc def_990'
) )
or
die
"mkdir failed"
;
for
( 1 .. 19 ) {
datafolder(
path
=>
$name
,
date_prefix
=> 0,
time_prefix
=> 0 );
}
my
@entries
= get_dir_entries(
$dir
);
is(
@entries
, 29,
"created 28 folders"
);
for
my
$entry
(
@entries
) {
like(
$entry
,
qr/^abc def_(00[1-9]|99[0-9]|100[0-9])$/
,
"correct numbering"
);
}
}
$dir
= tempdir(
CLEANUP
=> 1 );
$name
= our_catfile(
$dir
,
'abc def'
);
{
for
( 1 .. 9 ) {
datafolder(
path
=>
$name
,
time_prefix
=> 0 );
}
my
@entries
= get_dir_entries(
$dir
);
is(
@entries
, 9,
"created 9 folders with date prefix"
);
my
$date_prefix
= strftime(
'%Y-%m-%d'
,
localtime
() );
for
my
$entry
(
@entries
) {
like(
$entry
,
qr/[0-9]{4}-[0-9]{2}-[0-9]{2}/
,
"date in foldername"
);
like(
$entry
,
qr/^${date_prefix}_abc def_00[1-9]$/
,
"correct date in folder name"
);
}
}
$dir
= tempdir(
CLEANUP
=> 1 );
$name
= our_catfile(
$dir
,
'abc def'
);
{
for
( 1 .. 9 ) {
datafolder(
path
=>
$name
,
date_prefix
=> 0 );
}
my
@entries
= get_dir_entries(
$dir
);
is(
@entries
, 9,
"created 9 folders with time prefix"
);
my
(
$sec
,
$min
,
$hour
,
$mday
,
$mon
,
$year
,
$wday
,
$yday
,
$isdst
) =
localtime
(
time
);
my
$ti
=
$hour
*60*60 +
$min
*60 +
$sec
;
for
my
$entry
(
@entries
) {
like(
$entry
,
qr/[0-2][0-9]-[0-5][0-9]-[0-6][0-9]/
,
"time in foldername"
);
$entry
=~ s/_abc def_00[1-9]//;
my
(
$h
,
$m
,
$s
) =
split
'-'
,
$entry
;
my
$dev
=
$ti
-(
$h
*60*60+
$m
*60+
$s
);
ok (
abs
(
$dev
)<5,
"correct time in folder name"
);
}
}
$dir
= tempdir(
CLEANUP
=> 1 );
$name
= our_catfile(
$dir
,
'abc def'
);
{
for
( 1 .. 9 ) {
datafolder(
path
=>
$name
);
}
my
@entries
= get_dir_entries(
$dir
);
is(
@entries
, 9,
"created 9 folders with date_time prefix"
);
my
(
$sec
,
$min
,
$hour
,
$mday
,
$mon
,
$year
,
$wday
,
$yday
,
$isdst
) =
localtime
(
time
);
my
$ti
=
$hour
*60*60 +
$min
*60 +
$sec
;
my
$date_prefix
= strftime(
'%Y-%m-%d'
,
localtime
() );
for
my
$entry
(
@entries
) {
like(
$entry
,
qr/[0-9]{4}-[0-9]{2}-[0-9]{2}_[0-2][0-9]-[0-5][0-9]-[0-6][0-9]/
,
"date_time in foldername"
);
$entry
=~ s/_abc def_00[1-9]//;
my
(
$d
,
$t
)=
split
'_'
,
$entry
;
ok (
$d
eq
$date_prefix
,
'correct date in folder name'
);
my
(
$h
,
$m
,
$s
)=
split
'-'
,
$t
;
my
$dev
=
$ti
- (
$h
*60*60+
$m
*60+
$s
);
ok (
abs
(
$dev
)<5,
"correct time in folder name"
);
}
}
{
my
$folder
= datafolder(
path
=>
$name
,
date_prefix
=> 0,
time_prefix
=> 0 );
say
"path: "
,
$folder
->path();
my
$folder_name
=
'abc def_001'
;
is(
$folder
->path(), our_catfile(
$dir
,
$folder_name
) );
isa_ok(
$folder
->meta_file,
'Lab::Moose::DataFile::Meta'
);
my
$meta_file
=
$folder
->meta_file();
my
$meta
=
$meta_file
->path();
is(
$meta
, our_catfile(
$dir
,
$folder_name
,
'META.yml'
) );
my
$contents
= LoadFile(
$meta
);
my
@expected
=
qw/argv user host date timestamp version/
;
hashref_contains(
$contents
,
@expected
);
$meta_file
->
log
(
meta
=> {
abc
=>
'123'
,
def
=>
'345'
} );
$contents
= LoadFile(
$meta
);
hashref_contains(
$contents
,
@expected
,
qw/abc def/
);
file_exists_ok( our_catfile(
$folder
->path,
'DataFolder.t'
) );
}
{
my
$folder
= datafolder(
script_name
=>
'script'
,
date_prefix
=> 0,
time_prefix
=> 0 );
isa_ok(
$folder
,
'Lab::Moose::DataFolder'
);
my
$path
=
$folder
->path();
is(
$path
,
'MEAS_001'
,
"default folder name"
);
file_exists_ok( our_catfile(
$path
,
'META.yml'
) );
file_exists_ok( our_catfile(
$path
,
'script'
) );
remove_tree(
$path
);
}
sub
get_dir_entries {
my
$dir
=
shift
;
opendir
my
$dh
,
$dir
or
die
"cannot open $dir: $!"
;
my
@entries
=
readdir
$dh
;
@entries
=
grep
{
$_
ne
'.'
and
$_
ne
'..'
}
@entries
;
return
@entries
;
}
sub
hashref_contains {
my
$hashref
=
shift
;
my
@keys
=
@_
;
for
my
$key
(
@keys
) {
ok(
exists
$hashref
->{
$key
},
"hashref contains '$key'"
);
}
}
done_testing();