Gecko [ www.thearyasamaj.org ]

Name	Size	Permission
Control	[ DIR ]	drwxr-xr-x
Extension	[ DIR ]	drwxr-xr-x
Extra	[ DIR ]	drwxr-xr-x
Intermediate	[ DIR ]	drwxr-xr-x
ASN.pm	14.67 KB	-rw-r--r--
Bind.pm	2.1 KB	-rw-r--r--
Constant.pm	21.5 KB	-rw-r--r--
Control.pm	9.5 KB	-rw-r--r--
Entry.pm	8.24 KB	-rw-r--r--
Entry.pod	9.49 KB	-rw-r--r--
Examples.pod	11.47 KB	-rw-r--r--
Extension.pm	668 B	-rw-r--r--
Extra.pm	1.53 KB	-rw-r--r--
FAQ.pod	58.21 KB	-rw-r--r--
Filter.pm	7.02 KB	-rw-r--r--
Filter.pod	2.83 KB	-rw-r--r--
FilterMatch.pm	14.38 KB	-rw-r--r--
Intermediate.pm	6 KB	-rw-r--r--
LDIF.pm	18.15 KB	-rw-r--r--
LDIF.pod	6.17 KB	-rw-r--r--
Message.pm	5.54 KB	-rw-r--r--
Message.pod	3.11 KB	-rw-r--r--
RFC.pod	49.75 KB	-rw-r--r--
Reference.pod	1.08 KB	-rw-r--r--
RootDSE.pm	2.25 KB	-rw-r--r--
Schema.pm	10.3 KB	-rw-r--r--
Schema.pod	4.08 KB	-rw-r--r--
Search.pm	3.77 KB	-rw-r--r--
Search.pod	3.14 KB	-rw-r--r--
Security.pod	7.06 KB	-rw-r--r--
Util.pm	25.23 KB	-rw-r--r--

Code Editor : Message.pm

# Copyright (c) 1997-2004 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::Message;

use Net::LDAP::Constant qw(LDAP_SUCCESS LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE);
use Net::LDAP::ASN qw(LDAPRequest);
use strict;

our $VERSION = '1.12';

my $MsgID = 0;

# We do this here so when we add threading we can lock it
sub NewMesgID {
  $MsgID = 1  if ++$MsgID > 65535;
  $MsgID;
}

sub new {
  my $self   = shift;
  my $type   = ref($self) || $self;
  my $parent = shift->inner;
  my $arg    = shift;

$self = bless {
    parent   => $parent,
    mesgid   => NewMesgID(),
    callback => $arg->{callback} || undef,
    raw      => $arg->{raw} || undef,
  }, $type;

$self;
}

sub code {
  my $self = shift;

$self->sync  unless exists $self->{resultCode};

exists $self->{resultCode}
    ? $self->{resultCode}
    : undef
}

sub done {
  my $self = shift;

exists $self->{resultCode};
}

sub dn {
  my $self = shift;

$self->sync  unless exists $self->{resultCode};

exists $self->{matchedDN}
    ? $self->{matchedDN}
    : undef
}

sub referrals {
  my $self = shift;

$self->sync  unless exists $self->{resultCode};

exists $self->{referral}
    ? @{$self->{referral}}
    : ();
}

sub server_error {
  my $self = shift;

$self->sync  unless exists $self->{resultCode};

exists $self->{errorMessage}
    ? $self->{errorMessage}
    : undef
}

sub error {
  my $self = shift;
  my $return;

unless ($return = $self->server_error) {
    require Net::LDAP::Util and
    $return = Net::LDAP::Util::ldap_error_desc( $self->code );
  }

$return;
}

sub set_error {
  my $self = shift;
  ($self->{resultCode}, $self->{errorMessage}) = ($_[0]+0, "$_[1]");
  $self->{callback}->($self)
    if (defined $self->{callback});
  $self;
}

sub error_name {
  require Net::LDAP::Util;
  Net::LDAP::Util::ldap_error_name(shift->code);
}

sub error_text {
  require Net::LDAP::Util;
  Net::LDAP::Util::ldap_error_text(shift->code);
}

sub error_desc {
  require Net::LDAP::Util;
  Net::LDAP::Util::ldap_error_desc(shift->code);
}

sub sync {
  my $self = shift;
  my $ldap = $self->{parent};
  my $err;

until(exists $self->{resultCode}) {
    $err = $ldap->sync($self->mesg_id)  or next;
    $self->set_error($err, 'Protocol Error')
      unless exists $self->{resultCode};
    return $err;
  }

LDAP_SUCCESS;
}

sub decode { # $self, $pdu, $control
  my $self = shift;
  my $result = shift;
  my $data = (values %{$result->{protocolOp}})[0];

@{$self}{keys %$data} = values %$data;

@{$self}{qw(controls ctrl_hash)} = ($result->{controls}, undef);

# free up memory as we have a result so we will not need to re-send it
  delete $self->{pdu};

if ($data = delete $result->{protocolOp}{intermediateResponse}) {

my $intermediate = Net::LDAP::Intermediate->from_asn($data);

if (defined $self->{callback}) {
      $self->{callback}->($self, $intermediate);
    } else {
      push(@{$self->{intermediate} ||= []}, $intermediate);
    }

return $self;
  } else {
    # tell our LDAP client to forget us as this message has now completed
    # all communications with the server
    $self->parent->_forgetmesg($self);
  }

$self->{callback}->($self)
    if (defined $self->{callback});

$self;
}

sub abandon {
  my $self = shift;

return  if exists $self->{resultCode}; # already complete

my $ldap = $self->{parent};

$ldap->abandon($self->{mesgid});
}

sub saslref {
  my $self = shift;

$self->sync  unless exists $self->{resultCode};

exists $self->{sasl}
    ? $self->{sasl}
    : undef
}

sub encode {
  my $self = shift;

$self->{pdu} = $LDAPRequest->encode(@_, messageID => $self->{mesgid})
    or return;
  1;
}

sub control {
  my $self = shift;

if ($self->{controls}) {
    require Net::LDAP::Control;
    my $hash = $self->{ctrl_hash} = {};
    foreach my $asn (@{delete $self->{controls}}) {
      my $ctrl = Net::LDAP::Control->from_asn($asn);
      $ctrl->{raw} = $self->{parent}->{raw}
        if ($self->{parent});
      push @{$hash->{$ctrl->type} ||= []}, $ctrl;
    }
  }

my $ctrl_hash = $self->{ctrl_hash}
    or return;

my @oid = @_ ? @_ : keys %$ctrl_hash;
  my @control = map {@$_} grep $_, @{$ctrl_hash}{@oid}
    or return;

# return a list, so in a scalar context we do not just get array length
  return @control[0 .. $#control];
}

sub pdu      {  shift->{pdu}      }
sub callback {  shift->{callback} }
sub parent   {  shift->{parent}->outer   }
sub mesg_id  {  shift->{mesgid}   }
sub is_error {  shift->code       }

##
##
##

@Net::LDAP::Add::ISA     = qw(Net::LDAP::Message);
@Net::LDAP::Delete::ISA  = qw(Net::LDAP::Message);
@Net::LDAP::Modify::ISA  = qw(Net::LDAP::Message);
@Net::LDAP::ModDN::ISA   = qw(Net::LDAP::Message);
@Net::LDAP::Compare::ISA = qw(Net::LDAP::Message);
@Net::LDAP::Unbind::ISA  = qw(Net::LDAP::Message::Dummy);
@Net::LDAP::Abandon::ISA = qw(Net::LDAP::Message::Dummy);

sub Net::LDAP::Compare::is_error {
  my $mesg = shift;
  my $code = $mesg->code;
  $code != LDAP_COMPARE_FALSE and $code != LDAP_COMPARE_TRUE
}

{
  package Net::LDAP::Message::Dummy;
  our @ISA = qw(Net::LDAP::Message);
  use Net::LDAP::Constant qw(LDAP_SUCCESS);

sub new {
    my $self   = shift;
    my $type   = ref($self) || $self;

$self = bless {
      mesgid   => Net::LDAP::Message::NewMesgID(),
    }, $type;

$self;
  }

sub sync    { shift }
  sub decode  { shift }
  sub abandon { shift }
  sub code { shift->{resultCode} || LDAP_SUCCESS }
  sub error { shift->{errorMessage} || '' }
  sub dn { '' }
  sub done { 1 }
}

${this.title}

Code Editor : Message.pm