$VERSION
=
'0.34'
;
$VERSION
=
eval
$VERSION
;
sub
new {
my
$package
=
shift
;
return
bless
{
@_
},
$package
;
}
sub
make_ppd {
my
(
$self
,
%args
) =
@_
;
my
$build
=
delete
$args
{build};
my
@codebase
;
if
(
exists
$args
{codebase}) {
@codebase
=
ref
$args
{codebase} ? @{
$args
{codebase}} : (
$args
{codebase});
}
else
{
my
$distfile
=
$build
->ppm_name .
'.tar.gz'
;
print
"Using default codebase '$distfile'\n"
;
@codebase
= (
$distfile
);
}
my
%dist
;
foreach
my
$info
(
qw(name author abstract version)
) {
my
$method
=
"dist_$info"
;
$dist
{
$info
} =
$build
->
$method
() or
die
"Can't determine distribution's $info\n"
;
}
$dist
{version} =
$self
->_ppd_version(
$dist
{version});
$self
->_simple_xml_escape(
$_
)
foreach
$dist
{abstract}, @{
$dist
{author}};
my
$ppd
=
<<"PPD";
<SOFTPKG NAME=\"$dist{name}\" VERSION=\"$dist{version}\">
<TITLE>$dist{name}</TITLE>
<ABSTRACT>$dist{abstract}</ABSTRACT>
@{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
<IMPLEMENTATION>
PPD
foreach
my
$type
(
qw(requires)
) {
my
$prereq
=
$build
->
$type
();
while
(
my
(
$modname
,
$spec
) =
each
%$prereq
) {
next
if
$modname
eq
'perl'
;
my
$min_version
=
'0.0'
;
foreach
my
$c
(
$build
->_parse_conditions(
$spec
)) {
my
(
$op
,
$version
) =
$c
=~ /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x;
if
(
$op
eq
'>='
) {
$min_version
=
$version
;
last
;
}
}
$modname
=~ s/::/-/g;
$ppd
.=
sprintf
(
<<'EOF', $modname, $self->_ppd_version($min_version));
<DEPENDENCY NAME="%s" VERSION="%s" />
EOF
}
}
if
(
keys
%{
$build
->find_xs_files}) {
my
$perl_version
=
$self
->_ppd_version(
$build
->perl_version);
$ppd
.=
sprintf
(
<<'EOF', $perl_version, $^O, $self->_varchname($build->config) );
<PERLCORE VERSION="%s" />
<OS NAME="%s" />
<ARCHITECTURE NAME="%s" />
EOF
}
foreach
my
$codebase
(
@codebase
) {
$self
->_simple_xml_escape(
$codebase
);
$ppd
.=
sprintf
(
<<'EOF', $codebase);
<CODEBASE HREF="%s" />
EOF
}
$ppd
.=
<<'EOF';
</IMPLEMENTATION>
</SOFTPKG>
EOF
my
$ppd_file
=
"$dist{name}.ppd"
;
my
$fh
= IO::File->new(
">$ppd_file"
)
or
die
"Cannot write to $ppd_file: $!"
;
print
$fh
$ppd
;
close
$fh
;
return
$ppd_file
;
}
sub
_ppd_version {
my
(
$self
,
$version
) =
@_
;
return
join
','
, (
split
(/\./,
$version
), (0)x4)[0..3];
}
sub
_varchname {
my
(
$self
,
$config
) =
@_
;
my
$varchname
=
$config
->{archname};
if
($] >= 5.008) {
my
$vstring
=
sprintf
"%vd"
, $^V;
$vstring
=~ s/\.\d+$//;
$varchname
.=
"-$vstring"
;
}
return
$varchname
;
}
{
my
%escapes
= (
"\n"
=>
"\\n"
,
'"'
=>
'"'
,
'&'
=>
'&'
,
'>'
=>
'>'
,
'<'
=>
'<'
,
);
my
$rx
=
join
'|'
,
keys
%escapes
;
sub
_simple_xml_escape {
$_
[1] =~ s/(
$rx
)/
$escapes
{$1}/go;
}
}
1;