/usr/share/perl5/PDF/API2/Win32.pm is in libpdf-api2-perl 2.020-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | package PDF::API2::Win32;
our $VERSION = '2.020'; # VERSION
no warnings qw[ deprecated recursion uninitialized ];
package PDF::API2;
use Win32::TieRegistry;
no warnings qw[ recursion uninitialized ];
our $wf = {};
$Registry->Delimiter("/");
my $fontdir = $Registry->{"HKEY_CURRENT_USER/Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders"}->{Fonts};
my $subKey = $Registry->{"HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Fonts/"};
foreach my $k (sort keys %{$subKey}) {
next unless($subKey->{$k}=~/\.[ot]tf$/i);
my $kk=lc($k);
$kk=~s|^/||;
$kk=~s|\s+\(truetype\).*$||g;
$kk=~s|\s+\(opentype\).*$||g;
$kk=~s/[^a-z0-9]+//g;
$wf->{$kk}={};
$wf->{$kk}->{display}=$k;
$wf->{$kk}->{display}=~s|^/||;
if(-e "$fontdir/$subKey->{$k}") {
$wf->{$kk}->{ttfile}="$fontdir/$subKey->{$k}";
} else {
$wf->{$kk}->{ttfile}=$subKey->{$k};
}
}
$subKey = $Registry->{"HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Type 1 Installer/Type 1 Fonts/"};
foreach my $k (sort keys %{$subKey}) {
my $kk=lc($k);
$kk=~s|^/||;
$kk=~s/[^a-z0-9]+//g;
$wf->{$kk}={};
$wf->{$kk}->{display}=$k;
$wf->{$kk}->{display}=~s|^/||;
my $t;
($t,$wf->{$kk}->{pfmfile},$wf->{$kk}->{pfbfile})=split(/\0/,$subKey->{$k});
if(-e "$fontdir/$wf->{$kk}->{pfmfile}") {
$wf->{$kk}->{pfmfile}="$fontdir/".$wf->{$kk}->{pfmfile};
$wf->{$kk}->{pfbfile}="$fontdir/".$wf->{$kk}->{pfbfile};
}
}
sub enumwinfonts {
my $self=shift @_;
return(map { $_ => $wf->{$_}->{display} } keys %{$wf});
}
sub winfont {
my $self=shift @_;
my $key=lc(shift @_);
$key=~s/[^a-z0-9]+//g;
return(undef) unless(defined $wf && defined $wf->{$key});
if(defined $wf->{$key}->{ttfile}) {
return($self->ttfont($wf->{$key}->{ttfile}, @_));
} else {
return($self->psfont($wf->{$key}->{pfbfile}, -pfmfile => $wf->{$key}->{pfmfile}, @_));
}
}
1;
|