sub
new {
my
(
$class
,
%params
) =
@_
;
if
(
my
$dir
=
$params
{webfontsdir}) {
if
(
my
$self
= _parse_dir_and_spec(
$dir
)) {
bless
$self
,
$class
;
return
$self
;
}
else
{
warn
"$dir has invalid data!\n"
;
return
undef
;
}
}
return
undef
;
}
sub
srcdir {
return
shift
->{srcdir} }
sub
family {
return
shift
->{family} }
sub
bold {
return
shift
->{bold} }
sub
italic {
return
shift
->{italic} }
sub
bolditalic {
return
shift
->{bolditalic} }
sub
regular {
return
shift
->{regular} }
sub
format
{
return
shift
->{
format
} }
sub
mimetype {
return
shift
->{mimetype} }
sub
size {
return
shift
->{size} }
sub
_parse_dir_and_spec {
my
$dir
=
shift
;
$dir
= File::Spec->rel2abs(
$dir
);
unless
(-d
$dir
) {
warn
"$dir is not a directory!"
;
return
;
}
my
%data
= (
srcdir
=>
$dir
);
my
$specfile
= File::Spec->catfile(
$dir
,
'spec.txt'
);
if
(-f
$specfile
) {
open
(
my
$fh
,
'<'
,
$specfile
) or
die
"Cannot open specfile $!"
;
while
(
my
$line
= <
$fh
>) {
if
(
$line
=~ m/^\s*
(family|regular|italic|bold|bolditalic|size)
\s+
(\w[\w\.\ -]*?)
\s*
$/x) {
$data
{$1} = $2;
}
elsif
(
$line
=~ m/^
}
elsif
(
$line
=~ m/^\s*$/) {
}
else
{
warn
"Invalid line in $specfile found: $line"
;
}
}
close
$fh
;
}
else
{
warn
"$specfile not found"
;
return
;
}
my
@missing
;
foreach
my
$font
(
qw/regular italic bold bolditalic/
) {
if
(
$data
{
$font
}) {
if
(-f File::Spec->catfile(
$dir
,
$data
{
$font
})) {
next
;
}
}
push
@missing
,
$font
;
}
if
(
@missing
) {
warn
"$specfile is missing (or not file doesn't exist) these fonts: "
.
join
(
" "
,
@missing
) .
"\n"
;
return
;
}
if
(
$data
{regular} =~ m/\.(woff|ttf|otf)/i) {
my
$ext
=
lc
($1);
my
%formats
= (
woff
=> {
format
=>
'woff'
,
mimetype
=>
'application/font-woff'
,
},
ttf
=> {
format
=>
'truetype'
,
mimetype
=>
'application/x-font-ttf'
,
},
otf
=> {
format
=>
'opentype'
,
mimetype
=>
'application/x-font-opentype'
,
},
);
if
(
my
$format
=
$formats
{
$ext
}) {
$data
{
format
} =
$format
->{
format
};
$data
{mimetype} =
$format
->{mimetype};
}
}
unless
(
$data
{
format
}) {
warn
"Can't determine format for $data{regular}!\n"
;
return
;
}
$data
{size} ||= 10;
$data
{family} ||=
"Dummy family"
;
return
\
%data
;
}
sub
files {
my
$self
=
shift
;
my
%out
;
foreach
my
$font
(
qw/regular bold italic bolditalic/
) {
my
$k
=
$self
->
$font
;
$out
{
$k
} = File::Spec->catfile(
$self
->srcdir,
$k
);
}
return
%out
;
}
1;