File Coverage

lib/LEOCHARRE/FontFind.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package LEOCHARRE::FontFind;
use strict;
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @ISA @FONTPATH $CACHE $_files_found_in_fontpaths);
use Exporter;
use Carp;
$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)/g;
# setting manually, no longer access to cvs
@ISA = qw/Exporter/;
@EXPORT_OK = qw(find_ttf find_ttfs);
%EXPORT_TAGS = ( all => \@EXPORT_OK );
@FONTPATH = ('/usr/share/fonts');
use Cache::File;
#use Smart::Comments;

sub find_ttfs { # return whole list..
   my $substring = shift;

   if( my @extra_FONTPATHS = @_ ){
      push @FONTPATH, @extra_FONTPATHS;
      _cache_reset();
   }

   my @ttfs =  _abs_ttfs();
   my $ac = scalar @ttfs or warn("no ttf files at all") and return;

   ### ttf cached: $ac
   ## cached are: @ttfs

   my @found;
   if( $substring=~/\.ttf$/i){
      ### then assume whole filename
      @found = grep { /\Q$substring\E$/i } @ttfs;
   }
   else {
      ### regular substring: $substring
      @found = grep { /\Q$substring\E[^\/]*\.ttf$/i} @ttfs;
   }


   # sort by filename...
   my %filename;
   map { $_=~/([^\/]+)$/; $filename{$_} = $1 } @found;

   @found = sort { $filename{$a} cmp $filename{$b} } @found;

   ### grepped to: @found
   @found or return;
   @found; # return all
}

sub find_ttf {
   my $substring = shift;
   my @found = find_ttfs($substring,@_) or return;
   $found[0];
}



sub _cache {
   $CACHE ||= Cache::File->new( cache_root => "$ENV{HOME}/.fontfind/cache" ) or die;
}
sub _cache_reset { _cache()->clear('_files_found_in_fontpaths') }

sub _files_found_in_fontpaths { # can be all files. . later we worry about
   # grepping ttf, or whatever extension/name

   # did we already figure it out?
   defined $_files_found_in_fontpaths and return $_files_found_in_fontpaths;

   # is it cached ?
   if( $_files_found_in_fontpaths = _cache()->thaw('_files_found_in_fontpaths') ){
      return    $_files_found_in_fontpaths;
   }

   ### finding fonts..

   # go ahead and find all files
   my @found;   # as is.. will not prevent dupes. . don't streamline early..
   for (@FONTPATH){
      push @found, (split(/\n/, `find '$_' -type f`));
   }
   _cache()->freeze('_files_found_in_fontpaths' => \@found, 'never' );

   $_files_found_in_fontpaths = [@found]; # or \@found ? .. may cause problems?


   my $files_found = scalar @found;
   ### $files_found

   return $_files_found_in_fontpaths;
}

sub _abs_ttfs { ( grep { /[^\/]+.ttf$/i } @{_files_found_in_fontpaths()} ) }



1;











1;

__END__