view release on metacpan or  search on metacpan

lib/Net/LDAP/Constant.pm  view on Meta::CPAN

# Copyright (c) 1998-2009 Graham Barr <gbarr@pobox.com>. 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.24';

use Exporter qw(import);

my @err2name;

local $_;
while (<DATA>) {
  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;
  push @{$EXPORT_TAGS{codes}}, $name  if $protocol_const;
  push @{$EXPORT_TAGS{controls}}, $name      if ($name =~ /^LDAP_CONTROL_/);
  push @{$EXPORT_TAGS{features}}, $name      if ($name =~ /^LDAP_FEATURE_/);
  push @{$EXPORT_TAGS{extensions}}, $name    if ($name =~ /^LDAP_EXTENSION_/);
  push @{$EXPORT_TAGS{capabilities}}, $name  if ($name =~ /^LDAP_CAP_/);
  $err2name[$value] = $name  if $protocol_const;
}


# These subs are really in Net::LDAP::Util, but need to access <DATA>
# 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 (<DATA>) {
    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__

=head1 NAME

Net::LDAP::Constant - Constants for use with Net::LDAP

=head1 SYNOPSIS

 use Net::LDAP qw(LDAP_SUCCESS LDAP_PROTOCOL_ERROR);

=head1 DESCRIPTION

B<Net::LDAP::Constant> exports constants, technically: constant subroutines,
for the LDAP status codes and OIDs listed in the sections below.

In addition to exporting individual constants, the following tags can be used to
export groups of constants.

=over 4

=item :all

Export all constants known to C<Net::LDAP::Constant>.

=item C<:codes>

Export all LDAP status codes mentioned in the section L</Protocol Constants>.

=item C<:controls>