File Coverage

blib/lib/Net/LDAP/Constant.pm

Criterion	Covered	Total	%
statement	5	26	19.2
branch	3	24	12.5
condition	0	3	0.0
subroutine	2	3	66.6
pod	2	2	100.0
total	12	58	20.6

# Copyright (c) 1998-2009 Graham Barr . All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Net::LDAP::Constant;

our $VERSION = '0.23';

use Exporter qw(import);

my @err2name;

local $_;
while () {
  last  if /^=cut/;
  my $protocol_const = /^=head2 Protocol Constants/ ... /^=head2/;
  next  unless /^=item\s+(LDAP_\S+)\s+\((.*)\)/;
  my ($name, $value) = ($1, $2);
  *{$name} = sub () { $value };
  push @EXPORT_OK, $name;
  $err2name[$value] = $name  if $protocol_const;
}


# These subs are really in Net::LDAP::Util, but need to access
# so its easier for them to be here.


sub Net::LDAP::Util::ldap_error_name {
  my $code = 0 + (ref($_[0]) ? $_[0]->code : $_[0]);

  $err2name[$code] || sprintf('LDAP error code %d(0x%02X)', $code, $code);
}


sub Net::LDAP::Util::ldap_error_text {
  my $code = 0 + (ref($_[0]) ? $_[0]->code : $_[0]);
  my $text;

  seek(DATA, 0, 0);
  local $/=''; # paragraph mode
  local $_;
  my $n = -1;
  while () {
    last  if /^=head2/ and ++$n;
    last  if /^=cut/;
    next  if $n;
    if (/^=item\s+(LDAP_\S+)\s+\((\d+)\)/) {
      last  if defined $text;
      $text = ''  if $2 == $code;
    }
    elsif (defined $text) {
      $text .= $_;
    }
  }

  if (defined $text) {
    # Do some cleanup. Really should use a proper pod parser here.

    $text =~ s/^=item\s+\*\s+/ * /msg;
    $text =~ s/^=(over\s*\d*|back)//msg;
    $text =~ s/ +\n//g;
    $text =~ s/\n\n+/\n\n/g;
    $text =~ s/\n+\Z/\n/  if defined $text;
  }

  return $text;
}

1;

__DATA__