use
fields
qw(cf_datadir cf_tmpdir cf_config)
;
Entity
YATT
=>
sub
{
shift
->YATT};
Entity
config
=>
sub
{
my
(
$this
) =
shift
;
my
MY
$yatt
=
$this
->YATT;
if
(
@_
) {
$yatt
->{cf_config}->{
$_
[0]};
}
else
{
$yatt
->{cf_config};
}
};
Entity
session_start
=>
sub
{
my
(
$this
) =
shift
;
$CON
->start_session(
@_
?
@_
:
qr/^\w+$/
);
''
;
};
Entity
session_resume
=>
sub
{
my
(
$this
) =
shift
;
$CON
->get_session;
''
;
};
use
Fcntl
qw(:DEFAULT :flock SEEK_SET)
;
sub
mh_alloc_newfh {
(
my
MY
$yatt
) =
@_
;
my
(
$fnum
,
$lockfh
) =
$yatt
->mh_lastfnum(1);
my
(
$fname
);
do
{
$fname
=
"$yatt->{cf_datadir}/.ht_"
. ++
$fnum
;
}
while
(-e
$fname
);
seek
$lockfh
, 0, SEEK_SET
or
die
"Can't seek: $!"
;
print
$lockfh
$fnum
,
"\n"
;
truncate
$lockfh
,
tell
(
$lockfh
);
open
my
$fh
,
'>'
,
$fname
or
die
"Can't open newfile '$fname': $!"
;
wantarray
? (
$fh
,
$fname
,
$fnum
) :
$fh
;
}
sub
mh_lastfnum {
(
my
MY
$yatt
) =
shift
;
my
$lockfh
=
$yatt
->mh_openlock(
@_
);
my
$num
= <
$lockfh
>;
if
(
defined
$num
) {
$num
= (
$num
=~ m{^(\d+)} ? $1 : 0);
}
else
{
$num
= 0;
}
wantarray
? (
$num
,
$lockfh
) :
$num
;
}
sub
mh_openlock {
(
my
MY
$yatt
,
my
$lock
) =
@_
;
my
$lockfn
=
"$yatt->{cf_datadir}/.ht_lock"
;
sysopen
my
$lockfh
,
$lockfn
, O_RDWR | O_CREAT
or
die
"Can't open '$lockfn': $!"
;
if
(
$lock
) {
flock
$lockfh
, LOCK_EX
or
die
"Can't lock '$lockfn': $!"
;
}
$lockfh
;
}
Entity
tsvfile
=>
sub
{
my
(
$this
,
$name
) =
@_
;
my
MY
$yatt
=
$this
->YATT;
$name
=~ s;(^|/)\.+/;$1;g;
my
$fn
=
"$yatt->{cf_dir}/../$name.tsv"
;
unless
(-r
$fn
) {
die
"No such file: $fn\n"
;
}
open
my
$fh
,
'<'
,
$fn
or
die
"Can't open $fn: $!"
;
local
$_
;
my
@lines
;
while
(<
$fh
>) {
chomp
; s/\r$//;
next
if
/^\
push
@lines
, [
split
/\t/];
}
wantarray
?
@lines
: \
@lines
;
};
sub
cmd_setup {
my
MY
$self
=
shift
;
foreach
my
$dir
(
$self
->{cf_datadir},
$self
->{cf_tmpdir}) {
next
if
-d
$dir
;
File::Path::make_path(
$dir
, {
mode
=> 02775,
verbose
=> 1});
}
}
sub
after_new {
my
MY
$self
=
shift
;
$self
->{cf_tmpdir} //=
$self
->app_path_var_tmp;
$self
->{cf_datadir} //=
$self
->app_path_var(
'data'
);
}
Entity
sess_obj
=>
sub
{
my
(
$this
) =
shift
;
$CON
->get_session
};
Entity
att_value_of
=>
sub
{
my
(
$this
,
$type
,
$name
,
$formal_value
,
$opts
) =
@_
;
my
$in
=
delete
$opts
->{in} //
$CON
;
my
$as_value
=
delete
$opts
->{as_value};
if
(
%$opts
) {
croak
"Unknown option for att_value_of(): "
.
join
(
", "
,
sort
keys
%$opts
);
}
\ YATT::Lite::Util::att_value_in(
$in
,
$type
,
$name
,
$formal_value
,
$as_value
);
};