use
5.010001;
DEBUG
=>
$ENV
{AMW_DEBUG},
};
our
$VERSION
=
'0.43'
;
has
sl_tex
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
sl_pdf
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
luatex
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
zip
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
tex
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
pdf
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
a4_pdf
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
lt_pdf
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
epub
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
html
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
bare_html
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
cleanup
=> (
is
=>
'ro'
,
isa
=> Bool,
default
=>
sub
{ 0 });
has
ttdir
=> (
is
=>
'ro'
,
isa
=> Maybe[Str]);
has
templates
=> (
is
=>
'lazy'
,
isa
=> Object);
has
webfontsdir
=> (
is
=>
'ro'
,
isa
=> Maybe[Str]);
has
webfonts
=> (
is
=>
'lazy'
,
isa
=> Maybe[Object]);
has
standalone
=> (
is
=>
'lazy'
,
isa
=> Bool);
has
extra_opts
=> (
is
=>
'ro'
,
isa
=> HashRef,
default
=>
sub
{ +{} });
sub
slides {
return
shift
->sl_pdf;
}
sub
BUILDARGS {
my
(
$class
,
%params
) =
@_
;
$params
{extra_opts} = { %{
delete
$params
{extra} || {} } };
my
$all
= 1;
if
(
exists
$params
{slides}) {
my
$slides
=
delete
$params
{slides};
$params
{sl_pdf} ||=
$slides
;
}
foreach
my
$format
(
$class
->available_methods) {
if
(
exists
$params
{
$format
}) {
$all
= 0;
last
;
}
}
if
(
$all
) {
foreach
my
$format
(
$class
->available_methods) {
$params
{
$format
} = 1;
}
}
foreach
my
$dir
(
qw/ttdir webfontsdir/
) {
if
(
exists
$params
{
$dir
} and
defined
$params
{
$dir
} and -d
$params
{
$dir
}) {
my
$abs
= File::Spec->rel2abs(
$params
{
$dir
});
$params
{
$dir
} =
$abs
;
}
}
return
\
%params
;
}
sub
available_methods {
return
(
qw/bare_html
html
epub
a4_pdf
lt_pdf
tex
zip
pdf
sl_tex
sl_pdf
/
);
}
sub
compile_methods {
my
$self
=
shift
;
return
grep
{
$self
->
$_
}
$self
->available_methods;
}
sub
extra {
return
%{
shift
->extra_opts };
}
sub
_build_standalone {
my
$self
=
shift
;
if
(
$self
->a4_pdf ||
$self
->lt_pdf) {
return
0;
}
else
{
return
1;
}
}
sub
_build_templates {
my
$self
=
shift
;
return
Text::Amuse::Compile::Templates->new(
ttdir
=>
$self
->ttdir);
}
sub
_build_webfonts {
my
$self
=
shift
;
return
Text::Amuse::Compile::Webfonts->new(
webfontsdir
=>
$self
->webfontsdir);
}
has
logger
=> (
is
=>
'rw'
,
isa
=> CodeRef,
default
=>
sub
{
return
sub
{
print
@_
}; });
has
report_failure_sub
=> (
is
=>
'rw'
,
isa
=> CodeRef,
default
=>
sub
{
return
sub
{
print
"Failure to compile $_[0]\n"
;
}
});
has
errors
=> (
is
=>
'rwp'
,
isa
=> ArrayRef,
default
=>
sub
{ [] });
sub
version {
my
$self
=
shift
;
my
$musev
=
$Text::Amuse::VERSION
;
my
$selfv
=
$VERSION
;
my
$pdfv
=
$PDF::Imposition::VERSION
;
return
"Using Text::Amuse $musev, Text::Amuse::Compiler $selfv, "
.
"PDF::Imposition $pdfv\n"
;
}
sub
find_muse_files {
my
(
$self
,
$dir
) =
@_
;
my
@files
;
die
"$dir is not a dir"
unless
(
$dir
&& -d
$dir
);
find(
sub
{
my
$file
=
$_
;
return
unless
-f
$file
;
return
unless
$file
=~ m/^[0-9a-z][0-9a-z-]+[0-9a-z]+\.muse$/;
if
(
$File::Find::dir
=~ m/\./) {
my
@dirs
= File::Spec->splitdir(
$File::Find::dir
);
if
(
@dirs
&&
$dirs
[0] &&
$dirs
[0] eq
'.'
) {
shift
(
@dirs
);
}
my
@dots
=
grep
{ m/^\./ }
@dirs
;
return
if
@dots
;
}
push
@files
, File::Spec->rel2abs(
$file
);
},
$dir
);
return
sort
@files
;
}
sub
find_new_muse_files {
my
(
$self
,
$dir
) =
@_
;
my
@candidates
=
$self
->find_muse_files(
$dir
);
my
@newf
;
my
$mtime
= 9;
while
(
@candidates
) {
my
$f
=
shift
(
@candidates
);
die
"I was expecting a file here"
unless
$f
&& -f
$f
;
my
$status
=
$f
;
$status
=~ s/\.muse$/.status/;
if
(! -f
$status
) {
push
@newf
,
$f
;
}
elsif
((
stat
(
$f
))[
$mtime
] > (
stat
(
$status
))[
$mtime
]) {
push
@newf
,
$f
;
}
}
return
@newf
;
}
sub
recursive_compile {
my
(
$self
,
$dir
) =
@_
;
return
$self
->compile(
$self
->find_new_muse_files(
$dir
));
}
sub
compile {
my
(
$self
,
@files
) =
@_
;
$self
->reset_errors;
my
$cwd
= getcwd;
my
@compiled
;
foreach
my
$file
(
@files
) {
chdir
$cwd
or
die
"Couldn't chdir into $cwd $!"
;
if
(
ref
(
$file
)) {
eval
{
$self
->_compile_virtual_file(
$file
); };
}
else
{
eval
{
$self
->_compile_file(
$file
); };
}
my
$fatal
= $@;
chdir
$cwd
or
die
"Couldn't chdir into $cwd $!"
;
if
(
$fatal
) {
$self
->logger->(
$fatal
);
$self
->add_errors(
"$file $fatal"
);
$self
->report_failure_sub->(
$file
);
}
else
{
push
@compiled
,
$file
;
}
}
return
@compiled
;
}
sub
_compile_virtual_file {
my
(
$self
,
$vfile
) =
@_
;
die
"Virtual file is not a hashref"
unless
ref
(
$vfile
) eq
'HASH'
;
my
%virtual
=
%$vfile
;
my
$files
=
delete
$virtual
{files};
die
"No file list found"
unless
$files
&&
@$files
;
my
$path
=
delete
$virtual
{path};
die
"No directory path"
unless
$path
&& -d
$path
;
chdir
$path
or
die
"Couldn't chdir into $path $!"
;
my
$suffix
=
delete
(
$virtual
{suffix}) ||
'.muse'
;
my
$name
=
delete
(
$virtual
{name}) ||
'virtual'
;
$self
->logger->(
"Working on virtual file in "
. getcwd().
"\n"
);
my
@filelist
=
map
{
$_
.
$suffix
}
@$files
;
my
$doc
= Text::Amuse::Compile::Merged->new(
files
=> \
@filelist
,
%virtual
);
my
$muse
= Text::Amuse::Compile::File->new(
name
=>
$name
,
suffix
=>
$suffix
,
luatex
=>
$self
->luatex,
templates
=>
$self
->templates,
options
=> {
$self
->extra },
document
=>
$doc
,
logger
=>
$self
->logger,
virtual
=> 1,
standalone
=>
$self
->standalone,
webfonts
=>
$self
->webfonts,
);
$self
->_muse_compile(
$muse
);
}
sub
_compile_file {
my
(
$self
,
$file
) =
@_
;
die
"$file is not a file"
unless
$file
&& -f
$file
;
my
(
$name
,
$path
,
$suffix
) = fileparse(
$file
,
'.muse'
,
'.txt'
);
if
(
$path
) {
chdir
$path
or
die
"Cannot chdir into $path from "
. getcwd() .
"\n"
;
};
my
$filename
=
$name
.
$suffix
;
$self
->logger->(
"Working on $filename file in "
. getcwd().
"\n"
);
my
%args
= (
name
=>
$name
,
suffix
=>
$suffix
,
templates
=>
$self
->templates,
options
=> {
$self
->extra },
logger
=>
$self
->logger,
standalone
=>
$self
->standalone,
webfonts
=>
$self
->webfonts,
luatex
=>
$self
->luatex,
);
my
$muse
= Text::Amuse::Compile::File->new(
%args
);
$self
->_muse_compile(
$muse
);
}
sub
_write_status_file {
my
(
$self
,
$fh
,
$status
) =
@_
;
my
$localtime
=
localtime
();
my
%avail
= (
FAILED
=> 1,
DELETED
=> 1,
OK
=> 1,
);
die
unless
$avail
{
$status
};
print
$fh
"$status $$ $localtime\n"
;
flock
(
$fh
, LOCK_UN) or
die
"Cannot unlock status file\n"
;
close
$fh
;
}
sub
_muse_compile {
my
(
$self
,
$muse
) =
@_
;
my
$statusfile
=
$muse
->status_file;
open
(
my
$fhlock
,
'>:encoding(utf-8)'
,
$statusfile
)
or
die
"Cannot open $statusfile\n!"
;
flock
(
$fhlock
, LOCK_EX | LOCK_NB) or
die
"Cannot acquire lock on $statusfile"
;
sleep
5
if
DEBUG;
my
@fatals
;
$muse
->purge_all
unless
DEBUG;
if
(
$muse
->is_deleted) {
$self
->_write_status_file(
$fhlock
,
'DELETED'
);
return
;
}
foreach
my
$method
(
$self
->compile_methods) {
if
(
$method
eq
'sl_pdf'
or
$method
eq
'sl_tex'
) {
unless
(
$muse
->wants_slides) {
$self
->logger->(
"* Slides not required\n"
);
next
;
}
}
my
$output
=
eval
{
$muse
->
$method
};
if
($@) {
push
@fatals
, $@;
last
;
}
elsif
(
$output
) {
$self
->logger->(
"* Created $output\n"
);
}
else
{
$self
->logger->(
"* $method skipped\n"
);
}
}
if
(
@fatals
) {
$self
->_write_status_file(
$fhlock
,
'FAILED'
);
die
join
(
" "
,
@fatals
);
}
else
{
$self
->_write_status_file(
$fhlock
,
'OK'
);
}
$muse
->cleanup
if
$self
->cleanup;
}
sub
_suffix_for_method {
my
(
$self
,
$method
) =
@_
;
return
unless
$method
;
my
$ext
=
$method
;
$ext
=~ s/_/./g;
$ext
=
'.'
.
$ext
;
return
$ext
;
}
sub
_check_file_basename {
my
(
$self
,
$file
) =
@_
;
die
"Bad usage"
unless
$file
;
die
"$file is not a file"
unless
-f
$file
;
my
(
$name
,
$path
,
$suffix
) = fileparse(
$file
,
'.muse'
);
die
"Bad usage, not a muse file"
unless
$suffix
;
return
File::Spec->catfile(
$path
,
$name
);
}
sub
file_needs_compilation {
my
(
$self
,
$file
) =
@_
;
my
$need
= 0;
my
$mtime
= 9;
my
$basename
=
$self
->_check_file_basename(
$file
);
my
$header
= muse_fast_scan_header(
$file
);
foreach
my
$m
(
$self
->compile_methods) {
my
$outsuffix
=
$self
->_suffix_for_method(
$m
);
my
$outfile
=
$basename
.
$outsuffix
;
if
(
$m
eq
'sl_tex'
or
$m
eq
'sl_pdf'
) {
my
$slides
=
$header
->{slides};
if
(!
$slides
or
$slides
=~ /^\s*(
no
|false)\s*$/si) {
print
"$outfile check not needed\n"
if
DEBUG;
next
;
}
}
if
(-f
$outfile
and (
stat
(
$outfile
))[
$mtime
] >= (
stat
(
$file
))[
$mtime
]) {
print
"$outfile is OK\n"
if
DEBUG;
next
;
}
else
{
print
"$outfile is NOT OK\n"
if
DEBUG;
$need
= 1;
last
;
}
}
return
$need
;
}
sub
purge {
my
(
$self
,
@files
) =
@_
;
foreach
my
$file
(
@files
) {
my
$basename
=
$self
->_check_file_basename(
$file
);
foreach
my
$ext
(Text::Amuse::Compile::File->purged_extensions) {
die
"?"
if
$ext
eq
'.muse'
;
my
$produced
=
$basename
.
$ext
;
if
(-f
$produced
) {
$self
->logger->(
"Purging $produced\n"
);
unlink
$produced
or
warn
"Cannot unlink $produced $!"
;
}
}
}
}
sub
add_errors {
my
(
$self
,
@args
) =
@_
;
push
@{
$self
->errors},
@args
;
}
sub
reset_errors {
my
$self
=
shift
;
$self
->_set_errors([]);
}
sub
has_errors {
return
scalar
(@{
shift
->errors });
}
1;