File Coverage

blib/lib/Xorg/XLFD.pm

Criterion	Covered	Total	%
statement	12	55	21.8
branch	0	28	0.0
condition	0	3	0.0
subroutine	4	5	80.0
pod	1	1	100.0
total	17	92	18.4

package Xorg::XLFD;
use strict;

BEGIN {
  use Exporter;
  use vars qw($VERSION @ISA @EXPORT_OK);

  $VERSION = '0.128';

  @ISA = qw(Exporter);

  @EXPORT_OK = qw(get_xlfd);

};

sub get_xlfd {
  my $fam = shift; # fixed
  my %fonts;

  open(my $fh, '-|', 'xlsfonts') or croak("xlsfonts: $!\n");

  while(<$fh>) {
    chomp;
    $_ =~ s/^-//;
    my($foundary, $family, $weight, $slant, $set_width, $pixels, $tenths,
        $h_dpi, $v_dpi, $spacing, $avg_width, $charset)
      =  split(/--?/, $_);

    if( ($family =~ /^\d+$/m) or ($family eq '') ) {
      next;
    }

    push(@{$fonts{family}->{$family}->{weight}}, $weight)
      unless $weight ~~ @{$fonts{family}->{$family}->{weight}};

    push(@{$fonts{family}->{$family}->{width}}, $avg_width)
      unless $avg_width ~~ @{$fonts{family}->{$family}->{width}};

    push(@{$fonts{family}->{$family}->{vert_dpi}}, $v_dpi)
      unless $v_dpi ~~ @{$fonts{family}->{$family}->{vert_dpi}};

    push(@{$fonts{family}->{$family}->{horiz_dpi}}, $h_dpi)
      unless $h_dpi ~~ @{$fonts{family}->{$family}->{horiz_dpi}};

    push(@{$fonts{family}->{$family}->{tenths}}, $tenths)
      unless $tenths ~~ @{$fonts{family}->{$family}->{tenths}};

    push(@{$fonts{family}->{$family}->{spacing}}, $spacing)
      unless $spacing ~~ @{$fonts{family}->{$family}->{spacing}};

    push(@{$fonts{family}->{$family}->{slant}}, $slant)
      unless $slant ~~ @{$fonts{family}->{$family}->{slant}};

    push(@{$fonts{family}->{$family}->{'set width'}}, $set_width)
      unless $set_width ~~ @{$fonts{family}->{$family}->{'set width'}};

    push(@{$fonts{family}->{$family}->{pixels}}, $pixels)
      unless $pixels ~~ @{$fonts{family}->{$family}->{pixels}};

    push(@{$fonts{family}->{$family}->{charset}}, $charset)
      unless $charset ~~ @{$fonts{family}->{$family}->{charset}};

    push(@{$fonts{family}->{$family}->{foundary}}, $foundary)
      unless $foundary ~~ @{$fonts{family}->{$family}->{foundary}};

  }
  return (exists($fonts{family}{$fam}))
    ? $fonts{family}{$fam}
    : \%fonts
    ;
}


1;


__END__