don't leak in DSO_open() on various failures

[imager.git] / T1 / T1.pm

diff --git a/T1/T1.pm b/T1/T1.pm
index 188fa0dee488598adbb12f2f0fc730fbf8f054f7..a9c28af733e4e6c816c9cf41c636943930b483e0 100644 (file)
--- a/T1/T1.pm
+++ b/T1/T1.pm
@@ -3,9 +3,10 @@ use strict;
 use Imager::Color;
 use vars qw(@ISA $VERSION);
 @ISA = qw(Imager::Font);
+use Scalar::Util ();
 
 BEGIN {
-  $VERSION = "1.018";
+  $VERSION = "1.026";
 
   require XSLoader;
   XSLoader::load('Imager::Font::T1', $VERSION);
@@ -14,10 +15,7 @@ BEGIN {
 
 *_first = \&Imager::Font::_first;
 
-my $t1aa;
-
-# $T1AA is in there because for some reason (probably cache related) antialiasing
-# is a system wide setting in t1 lib.
+my $t1aa = 2;
 
 sub new {
   my $class = shift;
@@ -70,26 +68,33 @@ sub new {
                type  => 't1',
                size  => $hsh{size},
                color => $hsh{color},
+               t1aa  => $t1aa,
               }, $class;
 }
 
 sub _draw {
   my $self = shift;
+
+  $self->_valid
+    or return;
+
   my %input = @_;
   my $flags = '';
   $flags .= 'u' if $input{underline};
   $flags .= 's' if $input{strikethrough};
   $flags .= 'o' if $input{overline};
+  my $aa = $input{aa} ? $self->{t1aa} : 0;
   if (exists $input{channel}) {
     $self->{t1font}->cp($input{image}{IMG}, $input{'x'}, $input{'y'},
                    $input{channel}, $input{size},
-                   $input{string}, length($input{string}), $input{align},
-                    $input{utf8}, $flags, $input{aa});
+                   $input{string}, $input{align},
+                    $input{utf8}, $flags, $aa)
+      or return;
   } else {
     $self->{t1font}->text($input{image}{IMG}, $input{'x'}, $input{'y'}, 
                      $input{color}, $input{size}, 
-                     $input{string}, length($input{string}), 
-                     $input{align}, $input{utf8}, $flags, $input{aa});
+                     $input{string}, $input{align}, $input{utf8}, $flags, $aa)
+      or return;
   }
 
   return $self;
@@ -97,48 +102,126 @@ sub _draw {
 
 sub _bounding_box {
   my $self = shift;
+
+  $self->_valid
+    or return;
+
   my %input = @_;
   my $flags = '';
   $flags .= 'u' if $input{underline};
   $flags .= 's' if $input{strikethrough};
   $flags .= 'o' if $input{overline};
-  return $self->{t1font}->bbox($input{size}, $input{string},
-                          length($input{string}), $input{utf8}, $flags);
+  my @bbox =  $self->{t1font}->bbox($input{size}, $input{string},
+                                   $input{utf8}, $flags);
+  unless (@bbox) {
+    Imager->_set_error(Imager->_error_as_msg);
+    return;
+  }
+
+  return @bbox;
 }
 
 # check if the font has the characters in the given string
 sub has_chars {
   my ($self, %hsh) = @_;
 
-  unless (defined $hsh{string} && length $hsh{string}) {
+  $self->_valid
+    or return;
+
+  unless (defined $hsh{string}) {
     $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
     return;
   }
-  return $self->{t1font}->has_chars($hsh{string}, 
-                                   _first($hsh{'utf8'}, $self->{utf8}, 0));
+  if (wantarray) {
+    my @result = $self->{t1font}
+      ->has_chars($hsh{string}, _first($hsh{'utf8'}, $self->{utf8}, 0));
+    unless (@result) {
+      Imager->_set_error(Imager->_error_as_msg);
+      return;
+    }
+
+    return @result;
+  }
+  else {
+    my $result = $self->{t1font}
+      ->has_chars($hsh{string}, _first($hsh{'utf8'}, $self->{utf8}, 0));
+    unless (defined $result) {
+      Imager->_set_error(Imager->_error_as_msg);
+      return;
+    }
+    return $result;
+  }
 }
 
 sub utf8 {
   1;
 }
 
+sub can_glyph_names {
+  1;
+}
+
 sub face_name {
   my ($self) = @_;
 
+  $self->_valid
+    or return;
+
   return $self->{t1font}->face_name();
 }
 
 sub glyph_names {
   my ($self, %input) = @_;
 
+  $self->_valid
+    or return;
+
   my $string = $input{string};
   defined $string
     or return Imager->_set_error("no string parameter passed to glyph_names");
   my $utf8 = _first($input{utf8} || 0);
 
-  return $self->{t1font}->glyph_name($string, $utf8);
+  my @result = $self->{t1font}->glyph_names($string, $utf8);
+  unless (@result) {
+    Imager->_set_error(Imager->_error_as_msg);
+    return;
+  }
+
+  return @result;
+}
+
+sub set_aa_level {
+  my ($self, $new_t1aa) = @_;
+
+  if (!defined $new_t1aa ||
+      ($new_t1aa != 1 && $new_t1aa != 2)) {
+    Imager->_set_error("set_aa_level: parameter must be 1 or 2");
+    return;
+  }
+
+  if (ref $self) {
+    $self->_valid
+      or return;
+
+    $self->{t1aa} = $new_t1aa;
+  }
+  else {
+    $t1aa = $new_t1aa;
+  }
+
+  return 1;
 }
 
+sub _valid {
+  my $self = shift;
+
+  unless ($self->{t1font} && Scalar::Util::blessed($self->{t1font})) {
+    Imager->_set_error("font object was created in another thread");
+    return;
+  }
+
+  return 1;
+}
 
 1;
 
@@ -189,6 +272,32 @@ C<strikethrough> - Draw the text with a strikethrough.
 Obviously, if you're calculating the bounding box the size of the line
 is included in the box, and the line isn't drawn :)
 
+=head2 Anti-aliasing
+
+T1Lib supports multiple levels of anti-aliasing, by default, if you
+request anti-aliased output, Imager::Font::T1 will use the maximum
+level.
+
+You can override this with the set_t1_aa() method:
+
+=over
+
+=item set_aa_level()
+
+Usage:
+
+  $font->set_aa_level(1);
+  Imager::Font::T1->set_aa_level(2);
+
+Sets the T1Lib anti-aliasing level either for the specified font, or
+for new font objects.
+
+The only parameter must be 1 or 2.
+
+Returns true on success.
+
+=back
+
 =head1 AUTHOR
 
 Addi, Tony