librarian/font-optimizer/ext/Font-TTF/lib/Font/TTF/Win32.pm

   1 package Font::TTF::Win32;
   2
   3 # use strict;
   4 # use vars qw($HKEY_LOCAL_MACHINE);
   5
   6 use Win32::Registry;
   7 use Win32;
   8 use File::Spec;
   9 use Font::TTF::Font;
  10
  11
  12 sub findfonts
  13 {
  14     my ($sub) = @_;
  15     my ($font_key) = 'SOFTWARE\Microsoft\Windows' . (Win32::IsWinNT() ? ' NT' : '') . '\CurrentVersion\Fonts';
  16     my ($regFont, $list, $l, $font, $file);
  17
  18 # get entry from registry for a font of this name
  19     $::HKEY_LOCAL_MACHINE->Open($font_key, $regFont);
  20     $regFont->GetValues($list);
  21
  22     foreach $l (sort keys %{$list})
  23     {
  24         my ($fname) = $list->{$l}[0];
  25         next unless ($fname =~ s/\(TrueType\)$//o);
  26         $file = File::Spec->rel2abs($list->{$l}[2], "$ENV{'windir'}/fonts");
  27         $font = Font::TTF::Font->open($file) || next;
  28         &{$sub}($font, $fname);
  29         $font->release;
  30     }
  31 }
  32
  33 1;