Menu
▾
▴
perl-ldap-checkins — CVS checkin diffs
You can subscribe to this list here.
| 2001 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
(9) |
Nov
(4) |
Dec
(15) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2002 |
Jan
(23) |
Feb
(18) |
Mar
(11) |
Apr
(3) |
May
(23) |
Jun
(13) |
Jul
(16) |
Aug
(11) |
Sep
(5) |
Oct
(4) |
Nov
(2) |
Dec
(4) |
| 2003 |
Jan
(18) |
Feb
(13) |
Mar
(56) |
Apr
(3) |
May
(124) |
Jun
(21) |
Jul
(2) |
Aug
(8) |
Sep
(1) |
Oct
(23) |
Nov
(4) |
Dec
(2) |
| 2004 |
Jan
(18) |
Feb
(5) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Graham B. <gb...@us...> - 2002-01-09 17:19:50
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv31983/lib/Net/LDAP
Modified Files:
Filter.pm
Log Message:
Fix filters to be RFC compliant
Index: Filter.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Filter.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Filter.pm 2001/05/18 21:06:47 1.5
+++ Filter.pm 2002/01/09 17:19:47 1.6
@@ -7,7 +7,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = "0.12";
+$VERSION = "0.13";
# filter = "(" filtercomp ")"
# filtercomp = and / or / not / item
@@ -87,10 +87,8 @@
/soxeg;
$_[0];
}
-
-my %ch = split(/\s+/, '( \\( ) \\) \\ \\\\ * \\*');
-sub _escape { (my $t = $_[0]) =~ s/([\\\(\)\*\0-\37])/$ch{$1}||sprintf("\\%02x",ord($1))/sge; $t }
+sub _escape { (my $t = $_[0]) =~ s/([\\\(\)\*\0-\37])/sprintf("\\%02x",ord($1))/sge; $t }
sub _encode {
my($attr,$op,$val) = @_;
@@ -109,9 +107,9 @@
return ( {
extensibleMatch => {
matchingRule => $rule,
- type => $type,
+ type => length($type) ? $type : undef,
matchValue => _unescape($val),
- dnAttributes => $dn ? 1 : 0
+ dnAttributes => $dn ? 1 : undef
}
});
}
@@ -119,14 +117,14 @@
# If the op is = and contains one or more * not
# preceeded by \ then do partial matches
- if ($op eq '=' && $val =~ /^(\\.|[^\\*]+)*\*/o ) {
+ if ($op eq '=' && $val =~ /^(\\.|[^\\*]*)*\*/o ) {
my $n = [];
my $type = 'initial';
- while ($val =~ s/^((\\.|[^\\*]+)*)\*+//) {
+ while ($val =~ s/^((\\.|[^\\*]*)*)\*//) {
push(@$n, { $type, _unescape("$1") }) # $1 is readonly, copy it
- if length $1;
+ if length($1) or $type eq 'any';
$type = 'any';
}
|
|
From: Clif H. <ch...@us...> - 2002-01-03 03:01:16
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv31109/ldap/lib/Net/LDAP
Modified Files:
DSML.pm
Log Message:
Corrected _schemaToXML function to comprehend that a multi-valued oid
number could be returned from name2oid method. Now use the is_attribute,
is_objectclass, ..., methods to determine oid number.
Index: DSML.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- DSML.pm 2002/01/01 03:39:36 1.11
+++ DSML.pm 2002/01/03 03:01:14 1.12
@@ -30,7 +30,7 @@
use Net::LDAP::Entry;
use vars qw($VERSION);
-$VERSION = "0.11";
+$VERSION = "0.12";
sub new {
my $pkg = shift;
@@ -173,7 +173,8 @@
#
# Get the oid number of the object.
#
- $oid = $schema->name2oid( "$var" );
+# $oid = $schema->name2oid( "$var" );
+ $oid = $schema->is_matchingrule( "$var" );
#
# Get the name of this matchingrule
#
@@ -188,14 +189,14 @@
@atts = $schema->attributes();
$self->{'net_ldap_title'} = "attribute-type";
-$self->_schemaToXML( \@atts, $schema,$mrs) if ( @atts );
+$self->_schemaToXML( \@atts, $schema,$mrs,"is_attribute") if ( @atts );
#
# Get the schema objectclasses
#
@atts = $schema->objectclasses();
$self->{'net_ldap_title'} = "objectclass-type";
-$self->_schemaToXML( \@atts,$schema,$mrs) if ( @atts );
+$self->_schemaToXML( \@atts,$schema,$mrs,"is_objectclass") if ( @atts );
} # End of _print_schema subroutine
@@ -205,7 +206,7 @@
sub _schemaToXML()
{
-my ( $self,$ocs,$schema,$mrs ) = @_;
+my ( $self,$ocs,$schema,$mrs,$method ) = @_;
my $fh = $self->{'net_ldap_dsml_array'} or return;
my $title = $self->{'net_ldap_title'} or return;
@@ -219,7 +220,8 @@
#
# Get the oid number of the object.
#
- my $oid = $schema->name2oid( "$var" );
+# my $oid = $schema->name2oid( "$var" );
+ my $oid = $schema->$method( "$var" );
$container{'id'} = $var;
$container{'oid'} = $oid;
|
|
From: Clif H. <ch...@us...> - 2002-01-03 02:53:56
|
Update of /cvsroot/perl-ldap/ldap/contrib
In directory usw-pr-cvs1:/tmp/cvs-serv29596/ldap/contrib
Modified Files:
tklkup
Log Message:
Corrected schema parse and display code to comprehend that a multi-valued
oid number could be returned from name2oid method. Now use the
is_attribute, is_objectclass, ..., methods to determine oid number.
Index: tklkup
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- tklkup 2001/12/29 22:53:47 1.23
+++ tklkup 2002/01/03 02:53:53 1.24
@@ -22,6 +22,12 @@
#
# Revisions:
# $Log$
+# Revision 1.24 2002/01/03 02:53:53 charden
+#
+# Corrected schema parse and display code to comprehend that a multi-valued
+# oid number could be returned from name2oid method. Now use the
+# is_attribute, is_objectclass, ..., methods to determine oid number.
+#
# Revision 1.23 2001/12/29 22:53:47 charden
#
# Added code to allow the schema information to be stored in a file as
@@ -1257,6 +1263,7 @@
my $list = shift;
my $ocs = shift;
my $Title = shift;
+my $method = shift;
foreach ( @$ocs)
{
@@ -1265,7 +1272,8 @@
#
# Get and display the oid number of the objectclass.
#
- my $oid = $schemaHash{'schema'}->name2oid( "$_" );
+ my $oid = $schemaHash{'schema'}->$method( "$_" );
+# my $oid = $schemaHash{'schema'}->name2oid( "$_" );
#
# Get the various other items associated with
@@ -1657,7 +1665,7 @@
if ( $selectAll || $selectAtt )
{
-&print_loop($schema_list, $schemaHash{'atts'}, "attributeType")
+&print_loop($schema_list, $schemaHash{'atts'}, "attributeType", "is_attribute")
if ( defined($schemaHash{'atts'}) );
}
@@ -1687,7 +1695,7 @@
if ( $selectAll || $selectObj )
{
-&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses")
+&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses", "is_objectclass")
if ( defined($schemaHash{'ocs'}) );
}
@@ -1705,7 +1713,7 @@
if ( $selectAll || $selectMatch )
{
-&print_loop($schema_list, $schemaHash{'mrs'}, "matchingRules" )
+&print_loop($schema_list, $schemaHash{'mrs'}, "matchingRules", "is_matchingrule" )
if ( defined($schemaHash{'mrs'}) );
}
@@ -1722,7 +1730,7 @@
if ( $selectAll || $selectMru )
{
-&print_loop($schema_list, $schemaHash{'mru'}, "matchingRuleUse" )
+&print_loop($schema_list, $schemaHash{'mru'}, "matchingRuleUse", "is_matchinruleuse" )
if ( defined($schemaHash{'mru'}) );
}
@@ -1739,7 +1747,7 @@
if ( $selectAll || $selectSyn )
{
-&print_loop($schema_list, $schemaHash{'lsyn'}, "ldapSyntax" )
+&print_loop($schema_list, $schemaHash{'lsyn'}, "ldapSyntax", "is_syntax" )
if ( defined($schemaHash{'lsyn'}) );
}
@@ -1756,7 +1764,7 @@
if ( $selectAll || $selectNf )
{
-&print_loop($schema_list, $schemaHash{'nfm'}, "nameForms" )
+&print_loop($schema_list, $schemaHash{'nfm'}, "nameForms", "is_nameform" )
if ( defined($schemaHash{'nfm'}) );
}
@@ -1773,7 +1781,7 @@
if ( $selectAll || $selectDsr )
{
-&print_loop($schema_list, $schemaHash{'dits'}, "ditstructurerules" )
+&print_loop($schema_list, $schemaHash{'dits'}, "ditstructurerules", "is_ditstructurerule" )
if ( defined($schemaHash{'dits'}) );
}
@@ -1790,7 +1798,7 @@
if ( $selectAll || $selectDcr )
{
-&print_loop($schema_list, $schemaHash{'ditc'}, "ditcontentrules" )
+&print_loop($schema_list, $schemaHash{'ditc'}, "ditcontentrules", "is_ditcontentrule" )
if ( defined($schemaHash{'ditc'}) );
}
|
|
From: Graham B. <gb...@us...> - 2002-01-02 16:56:50
|
Update of /cvsroot/perl-ldap/asn/lib/Convert/ASN1
In directory usw-pr-cvs1:/tmp/cvs-serv21146/lib/Convert/ASN1
Modified Files:
_encode.pm
Log Message:
Change the encode errors to include the hierarchical name of the
element in the ASN.1 which is causing the problem
Index: _encode.pm
===================================================================
RCS file: /cvsroot/perl-ldap/asn/lib/Convert/ASN1/_encode.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- _encode.pm 2001/09/22 00:16:49 1.11
+++ _encode.pm 2002/01/02 16:56:47 1.12
@@ -34,46 +34,47 @@
sub _encode {
- my $optn = shift;
- my $ops = shift;
- my $stash = shift;
+ my ($optn, $ops, $stash, $path) = @_;
+ my $var;
foreach my $op (@{$ops}) {
if (defined(my $opt = $op->[cOPT])) {
next unless defined $stash->{$opt};
}
- foreach my $var (defined($op->[cVAR]) ? $stash->{$op->[cVAR]} : undef) {
- $_[0] .= $op->[cTAG];
-
- die $op->[cVAR] unless defined($var) || !defined($op->[cVAR]);
+ if (defined($var = $op->[cVAR])) {
+ push @$path, $var;
+ require Carp, Carp::croak(join(".", @$path)," is undefined") unless defined $stash->{$var};
+ }
+ $_[4] .= $op->[cTAG];
- &{$encode[$op->[cTYPE]]}(
- $optn,
- $op,
- $stash,
- $var,
- $_[0],
- $op->[cLOOP]
- );
+ &{$encode[$op->[cTYPE]]}(
+ $optn,
+ $op,
+ $stash,
+ defined($var) ? $stash->{$var} : undef,
+ $_[4],
+ $op->[cLOOP],
+ $path,
+ );
- }
+ pop @$path if defined $var;
}
- $_[0];
+ $_[4];
}
sub _enc_boolean {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
$_[4] .= pack("CC",1, $_[3] ? 0xff : 0);
}
sub _enc_integer {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
if (abs($_[3]) >= 2**31) {
my $os = i2osp($_[3], ref($_[3]) || $_[0]->{encode_bigint} || 'Math::BigInt');
my $len = length $os;
@@ -97,8 +98,8 @@
sub _enc_bitstring {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
if (ref($_[3])) {
my $less = (8 - ($_[3]->[1] & 7)) & 7;
@@ -119,8 +120,8 @@
sub _enc_string {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
$_[4] .= asn_encode_length(length $_[3]);
$_[4] .= $_[3];
@@ -128,16 +129,16 @@
sub _enc_null {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
$_[4] .= chr(0);
}
sub _enc_object_id {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
my @data = ($_[3] =~ /(\d+)/g);
@@ -158,8 +159,8 @@
sub _enc_real {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
# Zero
unless ($_[3]) {
@@ -225,8 +226,8 @@
sub _enc_sequence {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
if (my $ops = $_[1]->[cCHILD]) {
my $l = length $_[4];
@@ -237,7 +238,10 @@
my $tag = $op->[cTAG];
my $loop = $op->[cLOOP];
+ push @{$_[6]}, -1;
+
foreach my $var (@{$_[3]}) {
+ $_[6]->[-1]++;
$_[4] .= $tag;
&{$enc}(
@@ -246,12 +250,14 @@
$_[2], # $stash
$var, # $var
$_[4], # $buf
- $loop # $loop
+ $loop, # $loop
+ $_[6], # $path
);
}
+ pop @{$_[6]};
}
else {
- _encode($_[0],$_[1]->[cCHILD], defined($_[3]) ? $_[3] : $_[2] , $_[4]);
+ _encode($_[0],$_[1]->[cCHILD], defined($_[3]) ? $_[3] : $_[2], $_[6], $_[4]);
}
substr($_[4],$l,2) = asn_encode_length(length($_[4]) - $l - 2);
}
@@ -265,8 +271,8 @@
my %_enc_time_opt = ( utctime => 1, withzone => 0, raw => 2);
sub _enc_time {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
my $mode = $_enc_time_opt{$_[0]->{'encode_time'} || ''} || 0;
@@ -316,8 +322,8 @@
sub _enc_utf8 {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
$_[4] .= asn_encode_length(length $_[3]);
$_[4] .= $_[3];
@@ -325,26 +331,29 @@
sub _enc_any {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
$_[4] .= $_[3];
}
sub _enc_choice {
-# 0 1 2 3 4 5
-# $optn, $op, $stash, $var, $buf, $loop
+# 0 1 2 3 4 5 6
+# $optn, $op, $stash, $var, $buf, $loop, $path
my $stash = defined($_[3]) ? $_[3] : $_[2];
for my $op (@{$_[1]->[cCHILD]}) {
my $var = $op->[cVAR];
if (exists $stash->{$var}) {
- _encode($_[0],[$op], $stash, $_[4]);
+ push @{$_[6]}, $var;
+ _encode($_[0],[$op], $stash, $_[6], $_[4]);
+ pop @{$_[6]};
return;
}
}
- die "No value found for CHOICE\n";
+ require Carp;
+ Carp::croak("No value found for CHOICE " . join(".", @{$_[6]}));
}
|
|
From: Graham B. <gb...@us...> - 2002-01-02 16:31:41
|
Update of /cvsroot/perl-ldap/asn/lib/Convert
In directory usw-pr-cvs1:/tmp/cvs-serv13765/lib/Convert
Modified Files:
ASN1.pm
Log Message:
Remove unwanted warn statement
Index: ASN1.pm
===================================================================
RCS file: /cvsroot/perl-ldap/asn/lib/Convert/ASN1.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- ASN1.pm 2001/09/24 23:05:56 1.18
+++ ASN1.pm 2002/01/02 16:31:37 1.19
@@ -153,7 +153,7 @@
my $buf = '';
local $SIG{__DIE__};
eval { _encode($self->{options}, $self->{script}, $stash, [], $buf) }
- or do { warn $self->{error} = $@; undef }
+ or do { $self->{error} = $@; undef }
}
|
|
From: Clif H. <ch...@us...> - 2002-01-01 03:39:39
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv13319/ldap/lib/Net/LDAP
Modified Files:
DSML.pm
Log Message:
Corrected VERSION number. No code changes were made.
Index: DSML.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- DSML.pm 2001/12/29 22:51:14 1.10
+++ DSML.pm 2002/01/01 03:39:36 1.11
@@ -30,7 +30,7 @@
use Net::LDAP::Entry;
use vars qw($VERSION);
-$VERSION = "0.9";
+$VERSION = "0.11";
sub new {
my $pkg = shift;
|
|
From: Clif H. <ch...@us...> - 2001-12-29 22:53:50
|
Update of /cvsroot/perl-ldap/ldap/contrib
In directory usw-pr-cvs1:/tmp/cvs-serv22555/ldap/contrib
Modified Files:
tklkup
Log Message:
Added code to allow the schema information to be stored in a file as
DSML XML data. User can now select to store the data as text or XML.
Index: tklkup
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- tklkup 2001/12/29 01:50:27 1.22
+++ tklkup 2001/12/29 22:53:47 1.23
@@ -22,6 +22,11 @@
#
# Revisions:
# $Log$
+# Revision 1.23 2001/12/29 22:53:47 charden
+#
+# Added code to allow the schema information to be stored in a file as
+# DSML XML data. User can now select to store the data as text or XML.
+#
# Revision 1.22 2001/12/29 01:50:27 charden
#
# Added code to allow editing of a entry's attributes.
@@ -179,6 +184,7 @@
use Net::LDAP::Filter;
use Net::LDAP::Util qw(ldap_error_name ldap_error_text);
use Net::LDAP::Constant;
+use Net::LDAP::DSML;
use Getopt::Std;
use Tk;
@@ -1371,6 +1377,13 @@
-variable => \$Global{'sfile'}, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-anchor => "w" );
+
+$srbfilelabel -> Checkbutton(
+ -text => "Write schema data to file in DSML XML format.",
+ -variable => \$Global{'xml'}, -onvalue => 1, -offvalue => 0,
+ -font => $Global{'Font'} )
+ -> pack(-anchor => "w" );
+
#
# Create Text Entry list box.
#
@@ -1403,7 +1416,8 @@
$selframe = $slframe -> LabFrame(-label => "DISPLAY SELECTED OBJECTS",
-labelside => "acrosstop" )
- ->pack( -side => $Global{'hand'}, -expand => 1, -fill => "both" );
+ ->pack( -side => $Global{'hand'},
+ -expand => 1, -fill => "both" );
$sellframe = $selframe->Frame( -borderwidth => 0,
-relief => "raised")->pack(
@@ -1518,7 +1532,7 @@
#
#
-# Search the directory for data
+# Get the directory schema
#
#
#
@@ -1591,6 +1605,7 @@
$schema = undef();
my @items;
my @item;
+my $dsml;
$schemaHash{'schema'} = $ldap->schema();
@@ -1598,15 +1613,34 @@
{
if ( $Global{'sfile'} && defined($schemaHash{'schema'}) )
{
+ if ( $Global{'xml'} )
+ {
#
- # write to file instead of text box
+ # write XML text to file instead of text box
#
+ $dsml = Net::LDAP::DSML->new();
+ open(FXML, ">$Global{'fdata'}");
+ $dsml->open(*FXML);
+ $dsml->write($schemaHash{'schema'});
+ $dsml->finish();
+ close(FXML);
+ }
+ else
+ {
+ #
+ # write straight text to file instead of text box
+ #
$schemaHash{'schema'}->dump( $Global{'fdata'} );
- $schema_list->insert("end", "Schema data written to file: $Global{'fdata'}\n");
+ }
+
+ $schema_list->insert("end",
+ "Schema data written to file: $Global{'fdata'}\n");
$Global{'sfile'} = 0;
$Global{'fdata'} = "";
+ $Global{'xml'} = 0;
$ldap->unbind if ( defined($ldap));
return;
+
}
$ra_atts = [];
|
|
From: Clif H. <ch...@us...> - 2001-12-29 22:51:17
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv21739/ldap/lib/Net/LDAP
Modified Files:
DSML.pm
Log Message:
Added close method. The close method does not do anything, but is called
by the DESTROY method. For some reason the close method was never coded.
Original DSML writter must have had a reason for doing this, just never
implement it.
Index: DSML.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- DSML.pm 2001/12/25 01:09:47 1.9
+++ DSML.pm 2001/12/29 22:51:14 1.10
@@ -108,6 +108,10 @@
qq!</dsml:dsml>\n!;
}
+sub close
+{
+my $self = shift;
+}
sub DESTROY { shift->close }
#transform any entity chararcters
|
|
From: Clif H. <ch...@us...> - 2001-12-29 01:50:30
|
Update of /cvsroot/perl-ldap/ldap/contrib
In directory usw-pr-cvs1:/tmp/cvs-serv3789/ldap/contrib
Modified Files:
tklkup
Log Message:
Added code to allow editing of a entry's attributes.
This makes this software a full featured LDAP directory interface.
Added pod documentation about new windows and features.
Index: tklkup
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- tklkup 2001/12/17 01:35:45 1.21
+++ tklkup 2001/12/29 01:50:27 1.22
@@ -16,11 +16,18 @@
#
# Purpose: This program is designed to retrieve data from a LDAP
# directory and display on the graphical user interface
-# created by this program.
+# created by this program. This program can edit the data
+# retrieved from the directory.
#
#
# Revisions:
# $Log$
+# Revision 1.22 2001/12/29 01:50:27 charden
+#
+# Added code to allow editing of a entry's attributes.
+# This makes this software a full featured LDAP directory interface.
+# Added pod documentation about new windows and features.
+#
# Revision 1.21 2001/12/17 01:35:45 charden
#
# Added fail safe code to the DELETE entry operation. This forces the
@@ -2319,6 +2326,7 @@
sub ldapActionEdit
{
my $dataArray;
+my $editArray;
my $blank = " ";
my $data;
my $dn;
@@ -2327,6 +2335,11 @@
my $info;
my @infoKeys;
my @DNs = ();
+my @tmp1 = ();
+#my $index;
+my $indexCount;
+my $text;
+
if ( !$Global{'ldapActionDN'} )
{
delete($Global{'ldapActionDN'});
@@ -2344,12 +2357,12 @@
if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'});
-return if Tk::Exists($editWindow);
+return if Tk::Exists($Global{'editWindow'});
&displayEdit();
# clear the entry data display window.
-if ( $edit_clear ) { &edit_clear(); }
+
#
# Format and display the data associcated with the dn
# passed to this subroutine.
@@ -2359,13 +2372,35 @@
$dataArray = $Global{'searchResults'};
$data = $$dataArray{$DNs[1]}; # get data associated with this dn
$dn = $$data[0]; # get DN
+my $tmpdn = $dn; # save DN
+$Global{'entryDN'} = $dn; # save DN
$max = $$data[1]; # get max size of atttributes
$info = $$data[2]; # get data hash address.
-@infoKeys = sort(keys(%$info)); # get a list of all attributes.
+@tmp1 = sort(keys(%$info)); # get a list of all attributes.
+
+foreach my $attrKey ( @tmp1 )
+{
+ #
+ # User can not edit these attributes, remove from the list of
+ # attributes to display.
+ #
+ if ( $attrKey =~ /createTimeStamp/i || $attrKey =~ /modifyTimeStamp/i ||
+ $attrKey =~ /creatorsName/i || $attrKey =~ /modifiersName/i )
+ {
+ next;
+ }
+
+ push( @infoKeys, $attrKey ); # get a list of all attributes.
+
+}
+
#
# create attribute label
#
-$lb = $elist->Label(-text => "DN:",
+$text = sprintf "%${max}s",'DN';
+
+$lb = $elist->Label(-text => $text,
+ -font => $Global{'Font'},
-relief => 'groove',
-anchor => 'e',
-width => ($max+2) );
@@ -2375,72 +2410,44 @@
# create data entry window
#
$lb = $elist->Entry(-width => 85,
- -textvariable => \$dn);
+ -textvariable => \$tmpdn);
$elist->windowCreate("end", -window => $lb );
$elist->insert("end", "\n"); # position to the next row.
+
#
# For each attribute display it's data
#
foreach my $var (@infoKeys)
{
-
- if ( $var =~ /^jpegPhoto/i )
- {
- #
- # Display jpegPhoto in separate window if Tk::JPEG is used.
- #
- my $Value = decode_base64($$info{$var});
- displayPhoto($Value, $dn ) if ( $Global{'jpeg'}) ;
- $dstring = "JpegPhoto binary data is not being displayed.\n";
- #
- # create attribute label
- #
- $lb = $elist->Label(-text => "$var:",
- -relief => 'groove',
- -anchor => 'e',
- -width => ($max+2) );
-
- $elist->windowCreate("end", -window => $lb );
- #
- # create data entry window
- #
- $lb = $elist->Entry(-width => 85,
- -textvariable => \$dstring);
- $elist->windowCreate("end", -window => $lb );
- $elist->insert("end", "\n"); # position to the next row.
- next;
- }
+$text = sprintf "%${max}s",$var;
my $values = $$info{$var}; # get attribute data array.
- foreach my $Value ( @$values)
+
+ foreach my $Value ( @$values )
{
+
+ if ( $var =~ /;binary$/ ) { next; } # We do not do binary data, yet.
+
#
- # create attribute label
+ # create attribute action button
#
- $lb = $elist->Label(-text => "$var:",
- -relief => 'groove',
- -anchor => 'e',
- -width => ($max+2) );
+ $ab = $elist->Button(-text => $text,
+ -font => $Global{'Font'},
+ -borderwidth => 3,
+ -relief => 'raised' );
- $elist->windowCreate("end", -window => $lb );
+ $elist->windowCreate("end", -window => $ab );
#
# Format data and print data into Entry Box
#
- if ( $var =~ /;binary$/ )
- {
- $encoded = encode_base64($Value);
- $lb = $elist->Entry(-width => 85,
- -textvariable => \$encoded);
- }
- else
- {
- $lb = $elist->Entry(-width => 85,
- -textvariable => \$Value);
- }
+ $lb = $elist->Listbox(-width => 85, -height => 1 );
$elist->windowCreate("end", -window => $lb );
+ $lb->insert('end', $Value );
+
+ $ab->configure( -command => [ \&changeAttribute, \$ab, \$lb, \$Value, \$var ] );
# position to the next row.
$elist->insert("end", "\n");
@@ -2456,7 +2463,323 @@
}
+
+sub changeAttribute
+{
+my ( $ab, $lb, $Value, $attr ) = @_;
+
#
+# Create change attribute Window
+#
+if (!Exists($Global{'changeWindow'}) )
+{
+my $x = $Global{'horz'} + 75;
+my $y = $Global{'vert'} + 75;
+my $acframe;
+my $alframe;
+my $attribute;
+$Global{'tmpADD'} = {};
+$Global{'tmpDELETE'} = {};
+$Global{'tmpREPLACE'} = {};
+
+$Global{'changeWindow'} = MainWindow->new;
+
+$Global{'changeWindow'}->title("ATTRIBUTE MODIFICATION WINDOW");
+
+$Global{'changeWindow'}->geometry("+$x+$y");
+
+#
+# Create process Cancel button
+#
+
+$Global{'changeWindow'}->Button(-text => "CANCEL ATTRIBUTE EDIT",
+ -command => \&change_cancel,
+ -font => $Global{'Font'}, -borderwidth => 5 )
+ -> pack(-fill => "both", -padx => 2, -pady => 2 ) ;
+#
+# Create frame for clear buttons.
+#
+
+
+$acframe = $Global{'changeWindow'}->Frame()
+ ->pack( -fill => "both", -side => "bottom", -padx => 5, -pady => 2);
+
+#
+# Create Clear Data
+#
+
+$acframe -> Button(-text => " ACCEPT DATA CHANGE ",
+ -command => \&makeChanges,
+# -command => [ \&makeChanges,\$ADD,\$DELETE,\$REPLACE ],
+ -font => $Global{'Font'},
+ -borderwidth => 3 )
+ ->pack( -fill => 'both' );
+
+
+#
+# Create list frame.
+#
+
+$outerframe = $Global{'changeWindow'}->Frame()
+ ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
+ -expand => 1);
+
+#
+# Create data frame.
+#
+
+$alframe = $outerframe->LabFrame(-label => "ATTRIBUTE DATA",
+ -labelside => "acrosstop" )
+ ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
+ -expand => 1);
+
+
+#
+# Create a Text Box that will actually contain the
+# returned directory data.
+#
+
+$attrlist = $alframe ->Text( -width => 80, -height => 1,
+ -wrap => 'none',
+ -font => $Global{'Font'} );
+
+$attrlist->pack(-fill => "both", -expand => 1 );
+$attrlist->insert('end', $$Value);
+
+if ( $Global{'add_new_attribute'} )
+{
+#
+# Create data frame.
+#
+
+$Global{'newAttributeFrame'} = $outerframe->LabFrame(
+ -label => "NEW ATTRBUTE NAME",
+ -labelside => "acrosstop" )
+ ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
+ -expand => 1);
+
+#
+# Create a Text Box that will actually contain the
+# returned directory data.
+#
+
+
+$Global{'newAttribute'} = $Global{'newAttributeFrame'}->Text(
+ -width => 80, -height => 1,
+ -wrap => 'none',
+ -font => $Global{'Font'} );
+
+$Global{'newAttribute'}->pack(-fill => "both", -expand => 1 );
+
+$Global{'newAttributeReady'} = 1 ;
+
+}
+
+
+#
+##
+## Create process add new attribute button
+##
+#
+#$Global{'changeWindow'}->Button(-text => "ADD\nATTRIBUTE",
+# -command => [\&add_attribute, $attr, $Value, \$outerframe],
+# -font => $Global{'Font'}, -borderwidth => 5 )
+# -> pack(-side => $Global{'hand'},
+# -padx => 2, -pady => 2 ) ;
+
+
+#
+# Create process Add button
+#
+
+$Global{'changeWindow'}->Button(-text => "ADD",
+ -command => [\&add_data, $attr, $Value, \$attrlist],
+ -font => $Global{'Font'}, -borderwidth => 5 )
+ -> pack(-side => $Global{'hand'},
+ -padx => 2, -pady => 2 ) ;
+
+
+if ( !defined($Global{'add_new_attribute'}) )
+{
+#
+# Create process Delete button
+#
+
+$Global{'changeWindow'}->Button(-text => "DELETE",
+ -command => [\&delete_data, $attr, $Value],
+ -font => $Global{'Font'}, -borderwidth => 5 )
+ -> pack(-side => $Global{'hand'},
+ -padx => 2, -pady => 2 ) ;
+
+
+#
+# Create process Replace button
+#
+
+$Global{'changeWindow'}->Button(-text => "REPLACE",
+ -command => [\&replace_data, $attr, $Value,\$attrlist],
+ -font => $Global{'Font'}, -borderwidth => 5 )
+ -> pack(-side => $Global{'hand'},
+ -padx => 2, -pady => 2 ) ;
+
+#
+# Create a multi value Checkbutton that will determine how multi-valued
+# attributes are handled. The schema can tell you but version 2
+# ldap servers can not deliver schema data.
+#
+
+$Global{'changeWindow'} -> Checkbutton(
+ -text => "SET MULTI-VALUED ATTRIBUTE",
+ -variable => \$Global{'multi'}, -onvalue => 1,
+ -offvalue => 0, -font => $Global{'Font'} )
+ -> pack(-side => "left", -anchor => "center" );
+
+}
+
+}
+else { return; }
+
+sub delete_data {
+my ( $attr, $Value ) = @_;
+#
+#
+#
+$Global{'tmpDELETE'}{$$attr} = $$Value;
+
+} # End of delete_data subroutine
+
+
+sub replace_data {
+my ( $attr, $Value, $tbox ) = @_;
+#
+# Replace this attributes value.
+# But what if this is a multi-valued attribute.
+#
+if ( $Global{'multi'} )
+{
+#
+# User says it is a multi-valued attribute.
+#
+# First I add the new data then delete the old data.
+#
+$Global{'tmpDELETE'}{$$attr} = $$Value;
+$Global{'tmpADD'}{$$attr} = $$tbox->get('1.0','1.end');
+
+# print '|',$Global{'tmpREPLACE'}{$$attr},"|\n";
+}
+else
+{
+$Global{'tmpREPLACE'}{$$attr} = $$tbox->get('1.0','1.end');
+# print '||',$Global{'tmpREPLACE'}{$$attr},"||\n";
+
+}
+
+} # End of replace_data subroutine
+
+
+sub add_data {
+my ( $attr, $Value, $tbox ) = @_;
+my $newAttribute;
+if ( $Global{'newAttributeReady'} )
+{
+#
+# add new attribute and it's value
+#
+$newAttribute = $Global{'newAttribute'}->get('1.0','1.end');
+#print $newAttribute, "\n";
+
+$Global{'tmpADD'}{$newAttribute} = $$tbox->get('1.0','1.end');
+
+}
+else
+{
+#
+# add new value to attribute
+#
+$Global{'tmpADD'}{$$attr} = $$tbox->get('1.0','1.end');
+
+}
+
+} # End of add_data subroutine
+
+sub makeChanges {
+
+my $tmp = $Global{'tmpADD'};
+my @Keys = sort(keys(%$tmp));
+
+if ( @Keys )
+{
+foreach my $var ( @Keys)
+{
+$Global{'add'}{$var} = $Global{'tmpADD'}{$var};
+# print $var, " == ", $Global{'tmpADD'}{$var},"\n";
+}
+
+$Global{tmpADD} = {};
+
+$Global{'newAttribute'}->destroy
+ if Tk::Exists($Global{'newAttribute'});
+$Global{'newAttributeFrame'}->destroy
+ if Tk::Exists($Global{'newAttributeFrame'});
+delete( $Global{'newAttributeReady'} )
+ if ( defined($Global{'newAttributeReady'} ));
+delete( $Global{'newAttribute'})
+ if ( defined($Global{'newAttribute'} ));
+delete( $Global{'newAttributeFrame'})
+ if ( defined($Global{'newAttributeFrame'} ));
+
+}
+
+$tmp = $Global{'tmpDELETE'};
+
+@Keys = sort(keys(%$tmp));
+
+if ( @Keys )
+{
+foreach my $var ( @Keys)
+{
+$Global{'delete'}{$var} = $Global{'tmpDELETE'}{$var};
+# print $Global{'tmpDELETE'}{$var},"\n";
+
+}
+
+$Global{tmpDELETE} = {};
+
+}
+
+
+$tmp = $Global{'tmpREPLACE'};
+@Keys = sort(keys(%$tmp));
+
+if ( @Keys )
+{
+foreach my $var ( @Keys)
+{
+$Global{'replace'}{$var} = $Global{'tmpREPLACE'}{$var};
+# print $Global{'tmpREPLACE'}{$var},"\n";
+}
+
+$Global{tmpREPLACE} = {};
+}
+
+$Global{'changeWindow'}->destroy if Tk::Exists($Global{'changeWindow'});
+
+} # End of clear subroutine
+
+sub change_cancel{
+
+$Global{tmpADD} = {};
+$Global{tmpDELETE} = {};
+$Global{tmpREPLACE} = {};
+$Global{'changeWindow'}->destroy if Tk::Exists($Global{'changeWindow'});
+
+} # End of cancel subroutine
+
+
+
+} # End of subroutine changeAttribute
+
+#
# Do LDAP entry delete.
#
sub ldapActionDelete
@@ -2858,20 +3181,20 @@
#
# Create Main Window
#
-if (!Exists($editWindow) )
+if (!Exists($Global{'editWindow'}) )
{
-$editWindow = MainWindow->new;
+$Global{'editWindow'} = MainWindow->new;
-$editWindow->title("DIRECTORY EDIT DISPLAY");
+$Global{'editWindow'}->title("ENTRY EDIT DISPLAY");
-$editWindow->geometry("+$x+$y");
+$Global{'editWindow'}->geometry("+$x+$y");
#
# Create process Exit button
#
-$editWindow->Button(-text => "CLOSE DIRECTORY EDIT DISPLAY WINDOW",
+$Global{'editWindow'}->Button(-text => "CANCEL ENTRY EDIT",
-command => \&edit_cancel,
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack(-fill => "both", -padx => 2, -pady => 2 ) ;
@@ -2881,15 +3204,15 @@
#
-$ecframe = $editWindow->Frame()
+$ecframe = $Global{'editWindow'}->Frame()
->pack( -fill => "both", -side => "bottom", -padx => 5, -pady => 2);
#
# Create Clear Data
#
-$ecframe -> Button(-text => " CLEAR DATA ",
- -command => \&edit_clear, -font => $Global{'Font'},
+$ecframe -> Button(-text => " CHANGE DATA ",
+ -command => \&changeEntry, -font => $Global{'Font'},
-borderwidth => 3 )
->pack( -fill => 'both' );
@@ -2897,64 +3220,196 @@
# Create list frame.
#
-$elframe = $editWindow->LabFrame(-label => "DIRECTORY DATA",
+$elframe = $Global{'editWindow'}->LabFrame(-label => "ENTRY DATA",
-labelside => "acrosstop" )
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
-expand => 1);
#
-# Create a Clear Data Radiobutton that will execute subroutine clear
-# to clear the List box before each directory query.
-#
-
-$erbclear = $elframe -> Checkbutton(-text => "CLEAR DIRECTORY DATA ON EACH QUERY",
- -variable => \$edit_clear, -onvalue => 1, -offvalue => 0,
- -font => $Global{'Font'} )
- -> pack(-anchor => 'sw' );
-
-$erbclear->select();
-
-#
# Create a ROText Box that will actually contain the
# returned directory data.
#
-$elist = $elframe ->Scrolled('ROText', -scrollbars => 'se',
+$elist = $elframe ->Scrolled('Text', -scrollbars => 'se',
-width => 80, -height => 20, -wrap => 'none',
-font => $Global{'Font'} );
$elist->pack(-fill => "both", -expand => 1 );
+
+#
+# Create process add new attribute button
+#
+
+$elframe->Button(-text => "ADD\nATTRIBUTE",
+ -command => \&add_new_attribute,
+ -font => $Global{'Font'}, -borderwidth => 5 )
+ -> pack(-side => $Global{'hand'},
+ -padx => 2, -pady => 2 ) ;
+
+
+
}
-#else
-#{
-#$editWindow->deiconify() if Tk::Exists($editWindow);
-#$editWindow->raise() if Tk::Exists($editWindow);
-#}
+sub edit_cancel{
-sub edit_clear {
+delete($Global{'add'});
+delete($Global{'delete'});
+delete($Global{'replace'});
+$Global{'editWindow'}->destroy if Tk::Exists($Global{'editWindow'});
+
+} # End of cancel subroutine
+} # End of subroutine displayEdit
+
#
-# Clear out text in List Box
+# Add new attribute to entry that is being edited.
#
+sub add_new_attribute
+{
+$Global{'add_new_attribute'} = 1;
+changeAttribute( 1,1,1,1);
+delete($Global{'add_new_attribute'});
+} # End of subroutine add_new_attribute
-$elist->delete("1.0", "end");
+#
+# Execute any LDAP add, delete, or replace changes.
+#
+sub changeEntry {
+my $errstr;
+my $mesg;
+my $error = 0; # initialize error flag.
+
+my $ldap = new Net::LDAP( $Global{'LDAP_SERVER'},
+ timeout => 1,
+ port => $Global{'port'},
+ ) or $error = 1;
+
+if ( $error == 1 )
+{
+ $errstr = "Connect error: $@\n";
+ ERROR($errstr);
+ return;
+}
+
+$mesg = $ldap->bind( password => $Global{'bindpw'},
+ dn => $Global{'binddn'},
+ version => $Global{'setVersion'},
+ ) or $error = 1;
-} # End of clear subroutine
+if ( $mesg->code )
+{
+ $errstr = $mesg->code;
+ ERROR($errstr);
+}
-sub edit_cancel{
+if ( $error == 1 )
+{
+ $errstr = "Bind error: $@\n";
+ ERROR($errstr);
+ return;
+}
+
+#
+# Execute any LDAP add changes.
+#
+if ( defined($Global{'add'}) )
+{
+
+$mesg = $ldap->modify( $Global{'entryDN'}, add => $Global{'add'})
+ or $error = 1;
-# $editWindow->withdraw if Tk::Exists($editWindow);
-$editWindow->destroy if Tk::Exists($editWindow);
-} # End of cancel subroutine
+if ( $error == 1 )
+{
+ $errstr = "Add modify error: $@\n";
+ ERROR($errstr);
+ return;
+}
+
+if ( $mesg->code )
+{
+ $errstr = $mesg->code;
+ ERROR($errstr);
+ return;
+}
-} # End of subroutine displayEdit
+delete( $Global{'add'} );
+
+}
+
+#
+# Execute any delete changes.
+#
+if ( defined($Global{'delete'}) )
+{
+$mesg = $ldap->modify( $Global{'entryDN'}, delete => $Global{'delete'})
+ or $error = 1;
+
+
+if ( $error == 1 )
+{
+ $errstr = "Delete modify error: $@\n";
+ ERROR($errstr);
+ return;
+}
+
+if ( $mesg->code )
+{
+ $errstr = $mesg->code;
+ ERROR($errstr);
+ return;
+}
+delete( $Global{'delete'} );
+}
+#
+# Execute any replace changes.
+#
+if ( defined($Global{'replace'}) )
+{
+$mesg = $ldap->modify( $Global{'entryDN'}, replace => $Global{'replace'})
+ or $error = 1;
+
+
+if ( $error == 1 )
+{
+ $errstr = "Replace modify error: $@\n";
+ ERROR($errstr);
+ return;
+}
+
+if ( $mesg->code )
+{
+ $errstr = $mesg->code;
+ ERROR($errstr);
+ return;
+}
+delete( $Global{'replace'} );
+}
+
+#
+# Clean up data and close windows, forces another search to
+# get valid new data.
+#
+delete($Global{'index'}) if ( defined($Global{'index'}));
+
+delete($Global{'tmpADD'}) if ( defined($Global{'tmpADD'}));
+delete($Global{'tmpDELETE'}) if ( defined($Global{'tmpDELETE'}));
+delete($Global{'tmpREPLACE'}) if ( defined($Global{'tmpREPLACE'}));
+
+delete($Global{'add'}) if ( defined($Global{'add'}));
+delete($Global{'delete'}) if ( defined($Global{'delete'}));
+delete($Global{'replace'}) if ( defined($Global{'replace'}));
+
+$Global{'editWindow'}->destroy if Tk::Exists($Global{'editWindow'});
+$Global{'changeWindow'}->destroy if Tk::Exists($Global{'changeWindow'});
+$Global{'searchHistWindow'}->destroy if Tk::Exists($Global{'searchHistWindow'});
+
+} # End of changeEntry subroutine
sub displayDnList
@@ -3303,37 +3758,7 @@
$$information{$_} = $attr; # record ldap data
next;
-
- if(ref($attr)) {
- foreach $a (@$attr) {
- #
- # Format data and print data into List Box
- #
- if ( /;binary$/ )
- {
- $encoded = encode_base64($a);
- $$information{$_} = $encoded; # record ldap data
- }
- else
- {
- $$information{$_} = $a; # record ldap data
- }
- }
- }
- else {
- #
- # Format data and print data into List Box
- #
- if ( /;binary$/ )
- {
- $encoded = encode_base64($attr);
- $$information{$_} = $encoded; # record ldap data
- }
- else
- {
- $$information{$_} = $attr; # record ldap data
- }
- }
+
}
}
push(@$data, $dn); # dn of entry
@@ -3677,12 +4102,12 @@
=head1 NAME
-tklkup - A script to do LDAP directory lookups and displaying directory schema information.
+tklkup - A script to do LDAP directory lookups, edits, and displaying directory schema information.
=head1 SYNOPSIS
-This script is used to lookup information from a LDAP
+This script is used to lookup and edit information from a LDAP
directory server. It is GUI based with several buttons for
selecting directory servers, search bases, attributes and
for enabling the Directory Schema Search window.
@@ -4001,8 +4426,10 @@
I<DELETE> - Will cause the selected DN to be deleted from the
directory.
-I<EDIT> - Will cause a window with the corresponding data in it.
-I<This function currently will not modify data but will show data.>
+I<EDIT> - Will cause a Entry Edit Display window with the
+corresponding entry data in it. It is from this window that the
+user can change directory data. This window is discribed in
+detail later in this document.
I<CANCEL> - Will cancel the action request for the select DN.
@@ -4012,7 +4439,7 @@
I<DIRECTORY SEARCH DISPLAY> is the window where data for the
selected DN is displayed. Data is displayed in the read only
-Directory Data text box.Associated with the Directory Data
+Directory Data text box. Associated with the Directory Data
text box is the "RadioButton" that determines how often the
data in the directory text box is cleared. If the "CheckButton"
is selected, colored red, the directory data text box will be
@@ -4110,15 +4537,109 @@
-------------------------------------------------------------------
-=head1 DIRECTORY EDIT DISPLAY WINDOW.
+=head1 ENTRY EDIT DISPLAY Window.
-When this fucntion is installed and working properly this is
-where the user will modify an entry's data.
+It is from this window that the user can modify an entry's data.
+There can only be one of these windows active at a time.
+Attributes that contain I<binary> information can I<NOT> be modified
+with this program.
-Currently this function is I<NOT> working. However it will
-display the data for the currently selected DN.
+At the top of the window is the I<CANCEL ENTRY EDIT> button. Pressing
+this button will cancel all pending data changes for this entry. It
+will also cause the window to be destroyed.
+
+At the bottom of the window is the I<CHANGE DATA> button. Pressing
+this button will cause all of the pending data changes to take
+place.
+
+Just above the I<CHANGE DATA> button is the I<ADD ATTRIBUTE> button.
+Pressing this button gives the user the option of entering a new
+attribute name and value so that this information can be put into
+the entry.
+
+In the middle of the window is the I<ENTRY DATA> box. In this box
+is the all of the entry's current attributes along with their data.
+
+Each line in the box is broken up into two parts; the attribute button and
+the attribute data list box. There is one attribute and data pair per
+line. Multi-valued attributes have one line per attribute value.
+
+The first line in the I<ENTRY DATA> box will be the DN of the entry.
+This line can not be edited.
+To edit an attribute, press the button that has the attributes name on
+it. This will cause a I<ATTRIBUTE MODIFICATION> window to be displayed.
+This window is discribed in detail later in this documentation.
+
+When the user has finished making changes, press the I<CHANGE DATA> button.
+This will start the process of making the change(s) in the LDAP
+directory. If any errors occur a error window will appear. After the
+error window is dismissed the I<ENTRY EDIT DISPLAY> window will still
+be active. The user can at this point do what ever it takes to correct
+the problem.
+
+If no errors occur the I<ENTRY EDIT DISPLAY> window and the
+I<SEARCH RESULTS> windows will be destroyed. This is due to the fact
+that the data in both windows is no longer valid. The user must
+research the LDAP directory to get the new updated information.
+
+
+-------------------------------------------------------------------
+
+=head1 ATTRIBUTE MODIFICATION Window.
+
+It is from this window that the user can modify an attribute's data.
There can only be one of these windows active at a time.
+
+At the top of the window is the I<CANCEL ATTRIBUTE EDIT> button. Pressing
+this button will cancel all pending data changes for this attribute. It
+will also cause the window to be destroyed.
+
+At the bottom of the window is the I<ACCEPT DATA CHANGE> button. Pressing
+this button will cause all of the current data changes to be put into
+the pending data change queue.
+
+In the middle of the window is the attribute data text box. It is in
+this text box that the user will find the current data for the attribute
+the user selected. Depending on the operation the user wants to do the
+user can change the data or leave the data as is.
+
+Below the attribute data text box are three buttons, ADD, DELETE, and
+REPLACE. To the right of the REPLACE button is a check button that
+controls operations on multi-valued attributes during REPLACE operations.
+
+
+=head2 ADD operations.
+
+If the user wishs to add a new value to an attribute; the user should
+enter the new data in the attribute data text box and then press
+the I<ADD> button.
+
+=head2 DELETE operations.
+
+If the user wishs to delete the value from an attribute; the user should
+not bother the data in the attribute data text box and should press
+the I<DELETE> button.
+
+=head2 REPLACE operations.
+
+The attribute replace operation is a little tricky depending whether the
+attribute is single or multi valued.
+
+If the user knows that the attribute is multi-valued and wants to preserve
+the other attribute values the user should press the check button to the
+right of the I<REPLACE> button. Doing this will control how the add and
+delete operations are staged. The user should then enter the new data in
+the attribute data text box and press the I<REPLACE> button.
+
+If the user wishs to replace all of the values for an attribute;
+the user should enter the new data in the attribute data text box and
+press the I<REPLACE> button.
+
+
+When the user done with the changes the user should press the
+I<ACCEPT DATA CHANGES> button. This will move the data changes onto
+the pending data change queue and close the window.
-------------------------------------------------------------------
|
|
From: Clif H. <ch...@us...> - 2001-12-25 01:09:51
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv20958/ldap/lib/Net/LDAP
Modified Files:
DSML.pm
Log Message:
Updated the VERSION variable, brings in more inline with the
CVS version number. No code changes were made.
Index: DSML.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- DSML.pm 2001/12/25 01:05:32 1.8
+++ DSML.pm 2001/12/25 01:09:47 1.9
@@ -30,7 +30,7 @@
use Net::LDAP::Entry;
use vars qw($VERSION);
-$VERSION = "0.06";
+$VERSION = "0.9";
sub new {
my $pkg = shift;
|
|
From: Clif H. <ch...@us...> - 2001-12-25 01:05:37
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv20284/ldap/lib/Net/LDAP
Modified Files:
DSML.pm
Log Message:
Made changes to _schemaToXML subroutine to speed it up.
Index: DSML.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- DSML.pm 2001/12/20 05:05:33 1.7
+++ DSML.pm 2001/12/25 01:05:32 1.8
@@ -1,5 +1,9 @@
package Net::LDAP::DSML;
+#
+# $Id$
+#
+
# For schema parsing, add ability to Net::LDAP::Schema to accecpt
# a Net::LDAP::Entry object. First
# we'll convert XML into Net::LDAP::Entry with schema attributes and
@@ -243,9 +247,6 @@
# Now comes the real work, parse and configure the
# data into DSML XML format.
#
- my @keys = keys(%container);
- foreach my $name ( @keys )
- {
#
# Take care of the attribute-type and objectclass-type
# section first.
@@ -332,7 +333,7 @@
# Opening element and attributes are done,
# finish the other elements.
#
- elsif ( $name eq "syntax" )
+ if ( $container{'syntax'} )
{
$dstring = "<dsml:syntax";
if ( $container{'max_length'} )
@@ -353,7 +354,8 @@
push(@$fh, $dstring);
delete($container{'syntax'} );
}
- elsif ( $name eq "desc" )
+
+ if ( $container{'desc'} )
{
$dstring = "<dsml:description>";
$raData = $container{'desc'};
@@ -362,7 +364,8 @@
push(@$fh, $dstring);
delete($container{'desc'} );
}
- elsif ( $name eq "ordering" )
+
+ if ( $container{'ordering'} )
{
$dstring = "<dsml:ordering>";
$raData = $container{'ordering'};
@@ -374,7 +377,8 @@
}
delete($container{'ordering'} );
}
- elsif ( $name eq "equality" )
+
+ if ( $container{'equality'} )
{
$dstring = "<dsml:equality>";
$raData = $container{'equality'};
@@ -386,7 +390,8 @@
}
delete($container{'equality'} );
}
- elsif ( $name eq "substr" )
+
+ if ( $container{'substr'} )
{
$dstring = "<dsml:substring>";
$raData = $container{'substr'};
@@ -398,7 +403,8 @@
}
delete($container{'substr'} );
}
- elsif ( $container{'may'} )
+
+ if ( $container{'may'} )
{
my $data = $container{'may'};
foreach my $t1 (@$data )
@@ -407,7 +413,8 @@
}
delete($container{'may'} );
}
- elsif ( $container{'must'} )
+
+ if ( $container{'must'} )
{
my $data = $container{'must'};
foreach my $t1 (@$data )
@@ -416,8 +423,6 @@
}
delete($container{'must'} );
}
-
- }
$dstring ="</dsml:$title>\n";
push(@$fh, $dstring);
|
|
From: Clif H. <ch...@us...> - 2001-12-20 05:05:36
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv29702/ldap/lib/Net/LDAP
Modified Files:
DSML.pm
Log Message:
Completed coding of schema to DSML xml process.
Changed the way file and array processing was done with schema data.
Added additional pod documentation.
Index: DSML.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- DSML.pm 2001/12/19 04:37:24 1.6
+++ DSML.pm 2001/12/20 05:05:33 1.7
@@ -1,7 +1,5 @@
package Net::LDAP::DSML;
-# $Id$
-
# For schema parsing, add ability to Net::LDAP::Schema to accecpt
# a Net::LDAP::Entry object. First
# we'll convert XML into Net::LDAP::Entry with schema attributes and
@@ -19,7 +17,10 @@
# Added code to put schema data into DSML XML format. Data
# can be stored in an array reference or file.
#
-
+# 12/19/01 Clif Harden
+# Completed coding to put schema data into DSML XML format.
+#
+#
use strict;
use Net::LDAP::Entry;
@@ -37,53 +38,59 @@
sub open {
my $self = shift;
my $file = shift ;
-
+ my $dsml;
my $fh = $file;
- my $close = 0;
$self->finish
if $self->{net_ldap_fh};
-
- if (ref($file) or ref(\$file) eq "GLOB" or ref($file) eq "ARRAY") {
- $close = 0;
+
+ if ( ref($file) eq "ARRAY")
+ {
+ $self->{net_ldap_fh} = $fh;
+ $self->{net_ldap_dsml_array} = $fh;
+ $dsml = $fh;
+ $self->{net_ldap_close} = -1;
+ }
+ elsif (ref($file) or ref(\$file) eq "GLOB")
+ {
$fh = $file;
+ $self->{net_ldap_fh} = $fh;
+ $self->{net_ldap_close} = 0;
+ $dsml = [];
+ $self->{net_ldap_dsml_array} = $dsml;
}
else {
local *FH;
- unless (open(FH,$file)) {
+ unless (open(FH,$file))
+ {
$self->{error} = "Cannot open file '$file'";
return 0;
}
- $close = 1;
$fh = \*FH;
+ $self->{net_ldap_fh} = $fh;
+ $self->{net_ldap_close} = 1;
+ $dsml = [];
+ $self->{net_ldap_dsml_array} = $dsml;
}
- $self->{net_ldap_fh} = $fh;
- $self->{net_ldap_close} = $close;
+ push(@$dsml, $self->start_dsml);
- if ( ref($fh) eq "ARRAY" )
- {
- push(@$fh, $self->start_dsml);
- }
- else
- {
- print $fh $self->start_dsml;
- }
1;
}
sub finish {
my $self = shift;
my $fh = $self->{net_ldap_fh};
+ my $dsml = $self->{net_ldap_dsml_array};
+ my $close = $self->{net_ldap_close};
- if ($fh) {
- if ( ref($fh) eq "ARRAY" )
- {
- push(@$fh, $self->end_dsml);
- }
- else
+
+ if ( $fh )
+ {
+ push(@$dsml, $self->end_dsml); #close both array or file.
+ if ( ref($fh) ne "ARRAY" )
{
- print $fh $self->end_dsml;
+ print $fh @$dsml;
close($fh) if $self->{net_ldap_close};
}
}
@@ -116,7 +123,7 @@
sub write {
my $self = shift;
my $entry = shift;
- #my @unknown = _print_schema(_print_entries(@_));
+
if (ref $entry eq 'Net::LDAP::Entry') {
$self->_print_entry($entry)
}
@@ -132,44 +139,67 @@
sub _print_schema {
my ($self,$schema) = @_;
my @atts;
- my $fh = $self->{'net_ldap_fh'} or return;
+ my $mrs;
+
+ my $fh = $self->{'net_ldap_dsml_array'} or return;
return undef unless ($schema->isa('Net::LDAP::Schema'));
- if ( ref($fh) eq "ARRAY" )
- {
- push(@$fh, "<dsml:directory-schema>\n");
- }
- else
- {
- print $fh "<dsml:directory-schema>\n";
- }
+ push(@$fh, "<dsml:directory-schema>\n");
+
+
+$mrs = {}; # Get hash space.
+#
+# Get the matchingrules
+#
+@atts = $schema->matchingrules();
+
+#
+# Build a hash of matchingrules, we will need their oids
+# for the ordering, equality, and substring XML elements.
+#
+foreach my $var ( @atts)
+{
+ my $name;
+ my $oid;
+ my $values;
+ #
+ # Get the oid number of the object.
+ #
+ $oid = $schema->name2oid( "$var" );
+ #
+ # Get the name of this matchingrule
+ #
+ @$values = $schema->item( $oid, 'name' );
+ $name = $$values[0];
+ $$mrs{$name} = $oid;
+}
#
# Get the attributes
#
-#@atts = $schema->attributes();
-#$self->{'net_ldap_title'} = "attribute-type";
-#$self->_print_loop( \@atts, $schema) if ( @atts );
+@atts = $schema->attributes();
+$self->{'net_ldap_title'} = "attribute-type";
+$self->_schemaToXML( \@atts, $schema,$mrs) if ( @atts );
#
# Get the schema objectclasses
#
@atts = $schema->objectclasses();
$self->{'net_ldap_title'} = "objectclass-type";
-$self->_print_loop( \@atts,$schema) if ( @atts );
+$self->_schemaToXML( \@atts,$schema,$mrs) if ( @atts );
-}
+} # End of _print_schema subroutine
#
# Subroutine to print items from the schema objects.
#
-sub _print_loop()
+sub _schemaToXML()
{
-my ( $self,$ocs,$schema ) = @_;
+my ( $self,$ocs,$schema,$mrs ) = @_;
-my $fh = $self->{'net_ldap_fh'} or return;
+my $fh = $self->{'net_ldap_dsml_array'} or return;
my $title = $self->{'net_ldap_title'} or return;
my %container;
my $values;
@@ -183,7 +213,7 @@
#
my $oid = $schema->name2oid( "$var" );
$container{'id'} = $var;
-
+
$container{'oid'} = $oid;
#
# Get the various other items associated with
@@ -216,17 +246,18 @@
my @keys = keys(%container);
foreach my $name ( @keys )
{
- if ( ref($fh) eq "ARRAY" )
- {
#
# Take care of the attribute-type and objectclass-type
- # section first. This part writes to a user supplied array.
+ # section first.
#
if( $container{'id'} )
{
+ # container{'id'} is just a place holder, formal beginning
+ # new objectclass or attribute.
$dstring ="<dsml:$title ";
$dstring .= "id=\"";
- $dstring .= $container{'id'};
+ $raData = $container{'name'};
+ $dstring .= "@$raData";
delete($container{'id'} );
if ( $container{'sup'} )
{
@@ -237,9 +268,9 @@
{
$dstring .= "$super #";
}
- }
chop($dstring); # Chop off "\""
chop($dstring); # Chop off "#"
+ }
if ( $container{'single-value'} )
{
$dstring .= "\" ";
@@ -330,148 +361,49 @@
$dstring .= "</dsml:description>\n";
push(@$fh, $dstring);
delete($container{'desc'} );
- }
- elsif ( $container{'may'} )
- {
- my $data = $container{'may'};
- foreach my $t1 (@$data )
- {
- push(@$fh, "<dsml:attribute ref=\"#$t1\" required=\"false\"/>\n");
- }
- delete($container{'may'} );
- }
- elsif ( $container{'must'} )
- {
- my $data = $container{'must'};
- foreach my $t1 (@$data )
- {
- push(@$fh, "<dsml:attribute ref=\"#$t1\" required=\"true\"/>\n");
- }
- delete($container{'must'} );
}
-
- }
- else
- {
- #
- # Take care of the attribute-type and objectclass-type
- # section first. This part writes to a file.
- #
- if( $container{'id'} )
- {
- $dstring ="<dsml:$title ";
- $dstring .= "id=\"";
- $dstring .= $container{'id'};
- delete($container{'id'} );
- if ( $container{'sup'} )
- {
- $dstring .= "\" ";
- $raData = $container{'sup'};
- $dstring .= "superior=\"#";
- foreach my $super (@$raData)
- {
- $dstring .= "$super #";
- }
- }
- chop($dstring); # Chop off "#"
- chop($dstring); # Chop off " "
- if ( $container{'single-value'} )
- {
- $dstring .= "\" ";
- $dstring .= "single-value=\"true";
- delete($container{'single-value'} );
- }
- if ( $container{'obsolete'} )
- {
- $dstring .= "\" ";
- $dstring .= "obsolete=\"true";
- delete($container{'obsolete'} );
- }
- if ( $container{'user-modification'} )
- {
- $dstring .= "\" ";
- $dstring .= "user-modification=\"true";
- delete($container{'user-modification'} );
- }
- if ( $container{'structural'} )
- {
- $dstring .= "\" ";
- $dstring .= "type=\"";
- $dstring .= $container{'structural'};
- delete($container{'structural'} );
- }
- if ( $container{'abstract'} )
- {
- $dstring .= "\" ";
- $dstring .= "type=\"";
- $dstring .= "$container{'abstract'}";
- delete($container{'abstract'} );
- }
- if ( $container{'auxiliary'} )
- {
- $dstring .= "\" ";
- $dstring .= "type=\"";
- $dstring .= "$container{'auxiliary'}";
- delete($container{'auxiliary'} );
- }
- $dstring .= "\">\n";
- print $fh $dstring; # print to file
-
- if ( $container{'name'} )
- {
- $dstring = "<dsml:name>";
- $raData = $container{'name'};
- $dstring .= "@$raData";
- $dstring .= "</dsml:name>\n";
- delete($container{'name'} );
- print $fh $dstring;
- }
- $dstring = "<dsml:object-identifier>";
- $dstring .= $container{'oid'};
- $dstring .= "</dsml:object-identifier>\n";
- delete($container{'oid'} );
- print $fh $dstring; # print to file
- }
- #
- # Opening element and attributes are done,
- # finish the other elements.
- #
- elsif ( $name eq "syntax" )
+ elsif ( $name eq "ordering" )
{
- $dstring = "<dsml:syntax";
- if ( $container{'max_length'} )
+ $dstring = "<dsml:ordering>";
+ $raData = $container{'ordering'};
+ if ( $$mrs{$$raData[0]} )
{
- $dstring .= " bound=\"";
- $raData = $container{'max_length'};
- $dstring .= "@$raData";
- $dstring .= "\">";
- delete($container{'max_length'} );
+ $dstring .= "$$mrs{$$raData[0]}";
+ $dstring .= "</dsml:ordering>\n";
+ push(@$fh, $dstring);
}
- else
+ delete($container{'ordering'} );
+ }
+ elsif ( $name eq "equality" )
+ {
+ $dstring = "<dsml:equality>";
+ $raData = $container{'equality'};
+ if ( $$mrs{$$raData[0]} )
{
- $dstring .= ">";
+ $dstring .= "$$mrs{$$raData[0]}";
+ $dstring .= "</dsml:equality>\n";
+ push(@$fh, $dstring);
}
- $raData = $container{'syntax'};
- $dstring .= "@$raData";
- $dstring .= "</dsml:syntax>\n";
- print $fh $dstring;
- delete($container{'syntax'} );
+ delete($container{'equality'} );
}
- elsif ( $name eq "desc" )
+ elsif ( $name eq "substr" )
{
- $dstring = "<dsml:description>";
- $raData = $container{'desc'};
- $dstring .= "@$raData";
- $dstring .= "</dsml:description>\n";
- print $fh $dstring;
- delete($container{'desc'} );
+ $dstring = "<dsml:substring>";
+ $raData = $container{'substr'};
+ if ( $$mrs{$$raData[0]} )
+ {
+ $dstring .= "$$mrs{$$raData[0]}";
+ $dstring .= "</dsml:substring>\n";
+ push(@$fh, $dstring);
+ }
+ delete($container{'substr'} );
}
elsif ( $container{'may'} )
{
my $data = $container{'may'};
foreach my $t1 (@$data )
{
- print $fh "<dsml:attribute ref=\"#$t1\" required=\"false\"/>\n";
+ push(@$fh, "<dsml:attribute ref=\"#$t1\" required=\"false\"/>\n");
}
delete($container{'may'} );
}
@@ -480,27 +412,19 @@
my $data = $container{'must'};
foreach my $t1 (@$data )
{
- print $fh "<dsml:attribute ref=\"#$t1\" required=\"true\"/>\n";
+ push(@$fh, "<dsml:attribute ref=\"#$t1\" required=\"true\"/>\n");
}
delete($container{'must'} );
}
- }
+
}
-if ( ref($fh) eq "ARRAY" )
-{
$dstring ="</dsml:$title>\n";
push(@$fh, $dstring);
-}
-else
-{
-print $fh "</dsml:$title>\n";
-}
-
%container = ();
}
-} # End of subroutine print_loop
+} # End of _schemaToXML subroutine
sub _print_entry {
@@ -509,29 +433,15 @@
my $count;
my $dstring;
- my $fh = $self->{'net_ldap_fh'} or return;
+ my $fh = $self->{'net_ldap_dsml_array'} or return;
return undef unless ($entry->isa('Net::LDAP::Entry'));
- if ( ref($fh) eq "ARRAY" )
- {
- push(@$fh, "<dsml:directory-entries>\n");
- }
- else
- {
- print $fh "<dsml:directory-entries>\n";
- }
+ push(@$fh, "<dsml:directory-entries>\n");
- if ( ref($fh) eq "ARRAY" )
- {
- $dstring = "<dsml:entry dn=\"";
- $dstring .= _normalize($entry->dn);
- $dstring .= "\">\n";
- push(@$fh, $dstring);
- }
- else
- {
- print $fh "<dsml:entry dn=\"",_normalize($entry->dn),"\">\n";
- }
+ $dstring = "<dsml:entry dn=\"";
+ $dstring .= _normalize($entry->dn);
+ $dstring .= "\">\n";
+ push(@$fh, $dstring);
my @attributes = $entry->attributes();
@@ -546,116 +456,57 @@
}
if ($isOC) {
- if ( ref($fh) eq "ARRAY" )
- {
push(@$fh, "<dsml:objectclass>\n");
- }
- else
- {
- print $fh "<dsml:objectclass>\n";
- }
}
else {
- if ( ref($fh) eq "ARRAY" )
- {
$dstring = "<dsml:attr name=\"";
$dstring .= _normalize($attr);
$dstring .= "\">\n";
push(@$fh, $dstring);
- }
- else
- {
- print $fh "<dsml:attr name=\"",_normalize($attr),"\">\n";
- }
}
my @values = $entry->get_value($attr);
for my $value (@values) {
if ($isOC) {
- if ( ref($fh) eq "ARRAY" )
- {
$dstring = "<dsml:oc-value>";
$dstring .= _normalize($value);
$dstring .= "</dsml:oc-value>\n";
push(@$fh, $dstring);
- }
- else
- {
- print $fh "<dsml:oc-value>",_normalize($value),"</dsml:oc-value>\n";
- }
}
else {
#at some point we'll use schema object to determine
#this but until then we'll borrow this from Net::LDAP::LDIF
if ($value=~ /(^[ :]|[\x00-\x1f\x7f-\xff])/) {
require MIME::Base64;
- if ( ref($fh) eq "ARRAY" )
- {
$dstring = qq!<dsml:value encoding="base64">!;
$dstring .= MIME::Base64::encode($value);
$dstring .= "</dsml:value>\n";
push(@$fh, $dstring);
- }
- else
- {
- print $fh qq!<dsml:value encoding="base64">!,
- MIME::Base64::encode($value),
- "</dsml:value>\n";
- }
}
else {
- if ( ref($fh) eq "ARRAY" )
- {
$dstring = "<dsml:value>";
$dstring .= _normalize($value);
$dstring .= "</dsml:value>\n";
push(@$fh, $dstring);
- }
- else
- {
- print $fh "<dsml:value>",_normalize($value),"</dsml:value>\n";
- }
}
}
}
if ($isOC) {
- if ( ref($fh) eq "ARRAY" )
- {
push(@$fh, "</dsml:objectclass>\n");
- }
- else
- {
- print $fh "</dsml:objectclass>\n";
- }
}
else {
- if ( ref($fh) eq "ARRAY" )
- {
push(@$fh, "</dsml:attr>\n");
- }
- else
- {
- print $fh "</dsml:attr>\n";
- }
}
}
- if ( ref($fh) eq "ARRAY" )
- {
- $dstring = "</dsml:entry>\n";
- $dstring .= "</dsml:directory-entries>\n";
- push(@$fh, $dstring);
- }
- else
- {
- print $fh "</dsml:entry>\n";
- print $fh "</dsml:directory-entries>\n";
- }
+ $dstring = "</dsml:entry>\n";
+ $dstring .= "</dsml:directory-entries>\n";
+ push(@$fh, $dstring);
1;
-}
+} # End of _print_entry subroutine
# only parse DSML entry elements, no schema here
sub read_entries {
@@ -731,6 +582,8 @@
=head1 SYNOPSIS
+ For a directory entry;
+
use Net::LDAP;
use Net::LDAP::DSML;
use IO::File;
@@ -744,18 +597,28 @@
my $dsml = Net::LDAP::DSML->new();
+ #
+ # For file i/o
+ #
my $file = "testdsml.xml";
my $io = IO::File->new($file,"w") or die ("failed to open $file as filehandle.$!\n");
$dsml->open($io) or die ("DSML problems opening $file.$!\n"); ;
- #or
+ # OR
+ #
+ # For file i/o
+ #
open (IO,">$file") or die("failed to open $file.$!");
$dsml->open(*IO) or die ("DSML problems opening $file.$!\n");
- #or
+ # OR
+ #
+ # For array usage.
+ # Pass a reference to an array.
+ #
my @data = ();
$dsml->open(\@data) or die ("DSML problems opening with an array.$!\n");
@@ -773,6 +636,9 @@
die ("search failed with ",$mesg->code(),"\n") if $mesg->code();
+ For directory schema;
+
+ my $dsml = $ldap->schema();
$dsml->write($schema);
$dsml->finish();
@@ -797,11 +663,34 @@
representing directory service information in XML.
At the moment this module only reads and writes DSML entry entities. It
-cannot process any schema entities because schema entities are processed
-differently than elements.
+can write DSML schema entities.
+Reading DSML schema entities is a future project.
Eventually this module will be a full level 2 consumer and producer
-enabling you to give you full DSML conformance.
+enabling you to give you full DSML conformance. Currently this
+module has the ability to be a level 2 producer. The user must
+understand the his/her directory server will determine the
+consumer and producer level they can achieve.
+
+To determine conformance, it is useful to divide DSML documents into
+four types:
+
+ 1.Documents containing no directory schema nor any references to
+ an external schema.
+ 2.Documents containing no directory schema but containing at
+ least one reference to an external schema.
+ 3.Documents containing only a directory schema.
+ 4.Documents containing both a directory schema and entries.
+
+A producer of DSML must be able to produce documents of type 1.
+A producer of DSML may, in addition, be able to produce documents of
+types 2 thru 4.
+
+A producer that can produce documents of type 1 is said to be a level
+1 producer. A producer than can produce documents of all four types is
+said to be a level 2 producer.
+
+=head1 CALLBACKS
The module uses callbacks to improve performance (at least the appearance
of improving performance ;) and to reduce the amount of memory required to
|
|
From: Graham B. <gb...@us...> - 2001-12-19 22:28:01
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv9279/lib/Net/LDAP
Modified Files:
Schema.pm
Log Message:
- Fix bug in ->item when $item_name is not specified
- Don't generate an element name from the description, use the OID
Index: Schema.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Schema.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- Schema.pm 2001/07/29 04:21:57 1.11
+++ Schema.pm 2001/12/19 22:27:58 1.12
@@ -7,7 +7,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = "0.10";
+$VERSION = "0.11";
#
# Get schema from the server (or read from LDIF) and parse it into
@@ -255,7 +255,8 @@
my $item_ref = $self->{oid}->{$oid[0]} or return _error($self, "Unknown OID");
- my $value = $item_ref->{$item_name} or return _error($self, "No such property");
+ my $value = defined($item_name) ? $item_ref->{lc $item_name} : $item_ref
+ or return _error($self, "No such property");
delete $self->{error};
if( ref $value eq "ARRAY" && wantarray ) {
@@ -544,12 +545,7 @@
# Force a name if we don't have one
#
if (!exists $schema_entry{name}) {
- if (exists $schema_entry{desc}) {
- ($schema_entry{name} = $schema_entry{desc}) =~ s/\s+//g
- }
- else {
- $schema_entry{name} = "$type:$schema_entry{oid}"
- }
+ $schema_entry{name} = $schema_entry{oid};
}
#
|
|
From: Clif H. <ch...@us...> - 2001-12-19 04:37:27
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv31115/ldap/lib/Net/LDAP
Modified Files:
DSML.pm
Log Message:
Added code to put schema data into DSML XML format. Data
can be stored in an array reference or file.
Index: DSML.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- DSML.pm 2001/12/18 12:59:11 1.5
+++ DSML.pm 2001/12/19 04:37:24 1.6
@@ -1,5 +1,7 @@
package Net::LDAP::DSML;
+# $Id$
+
# For schema parsing, add ability to Net::LDAP::Schema to accecpt
# a Net::LDAP::Entry object. First
# we'll convert XML into Net::LDAP::Entry with schema attributes and
@@ -13,6 +15,10 @@
# reference instead of a file handle. This touched all of the
# methods that wrote to a file.
#
+# 12/18/01 Clif Harden
+# Added code to put schema data into DSML XML format. Data
+# can be stored in an array reference or file.
+#
use strict;
@@ -114,8 +120,8 @@
if (ref $entry eq 'Net::LDAP::Entry') {
$self->_print_entry($entry)
}
- elsif (ref $entry eq 'Net::LDAP::Schem') {
- _print_schema($entry);
+ elsif (ref $entry eq 'Net::LDAP::Schema') {
+ $self->_print_schema($entry);
}
else {
return undef;
@@ -123,30 +129,385 @@
1;
}
-#coming soon! ;)
sub _print_schema {
- my ($self,$entry) = @_;
-
+ my ($self,$schema) = @_;
+ my @atts;
my $fh = $self->{'net_ldap_fh'} or return;
- return undef unless ($entry->isa('Net::LDAP::Schema'));
+ return undef unless ($schema->isa('Net::LDAP::Schema'));
if ( ref($fh) eq "ARRAY" )
{
- push(@$fh, "<dsml:directory-entries>\n");
+ push(@$fh, "<dsml:directory-schema>\n");
}
else
{
- print $fh "<dsml:directory-entries>\n";
+ print $fh "<dsml:directory-schema>\n";
}
- @_;
+#
+# Get the attributes
+#
+
+#@atts = $schema->attributes();
+#$self->{'net_ldap_title'} = "attribute-type";
+#$self->_print_loop( \@atts, $schema) if ( @atts );
+
+#
+# Get the schema objectclasses
+#
+@atts = $schema->objectclasses();
+$self->{'net_ldap_title'} = "objectclass-type";
+$self->_print_loop( \@atts,$schema) if ( @atts );
+
}
-
+#
+# Subroutine to print items from the schema objects.
+#
+
+sub _print_loop()
+{
+my ( $self,$ocs,$schema ) = @_;
+
+my $fh = $self->{'net_ldap_fh'} or return;
+my $title = $self->{'net_ldap_title'} or return;
+my %container;
+my $values;
+my $raData;
+my $dstring;
+
+foreach my $var ( @$ocs)
+{
+ #
+ # Get the oid number of the object.
+ #
+ my $oid = $schema->name2oid( "$var" );
+ $container{'id'} = $var;
+
+ $container{'oid'} = $oid;
+ #
+ # Get the various other items associated with
+ # this object.
+ #
+ my @items = $schema->items( "$oid" );
+
+ foreach my $value ( @items )
+ {
+ next if ( $value eq 'type');
+ next if ( $value eq 'oid');
+ $values = [];
+ @$values = $schema->item( $oid, $value );
+
+ if ( @$values && $$values[0] == 1 )
+ {
+ $container{ $value} = $value;
+ next;
+ }
+ if ( @$values )
+ {
+ $container{$value} = $values;
+ }
+ }
+
+#
+# Now comes the real work, parse and configure the
+# data into DSML XML format.
+#
+ my @keys = keys(%container);
+ foreach my $name ( @keys )
+ {
+ if ( ref($fh) eq "ARRAY" )
+ {
+ #
+ # Take care of the attribute-type and objectclass-type
+ # section first. This part writes to a user supplied array.
+ #
+ if( $container{'id'} )
+ {
+ $dstring ="<dsml:$title ";
+ $dstring .= "id=\"";
+ $dstring .= $container{'id'};
+ delete($container{'id'} );
+ if ( $container{'sup'} )
+ {
+ $dstring .= "\" ";
+ $raData = $container{'sup'};
+ $dstring .= "superior=\"#";
+ foreach my $super (@$raData)
+ {
+ $dstring .= "$super #";
+ }
+ }
+ chop($dstring); # Chop off "\""
+ chop($dstring); # Chop off "#"
+ if ( $container{'single-value'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "single-value=\"true";
+ delete($container{'single-value'} );
+ }
+ if ( $container{'obsolete'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "obsolete=\"true";
+ delete($container{'obsolete'} );
+ }
+ if ( $container{'user-modification'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "user-modification=\"true";
+ delete($container{'user-modification'} );
+ }
+ if ( $container{'structural'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "type=\"";
+ $dstring .= "$container{'structural'}";
+ delete($container{'structural'} );
+ }
+ if ( $container{'abstract'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "type=\"";
+ $dstring .= "$container{'abstract'}";
+ delete($container{'abstract'} );
+ }
+ if ( $container{'auxiliary'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "type=\"";
+ $dstring .= "$container{'auxiliary'}";
+ delete($container{'auxiliary'} );
+ }
+ $dstring .= "\">\n";
+ push(@$fh, $dstring);
+
+ if ( $container{'name'} )
+ {
+ $dstring = "<dsml:name>";
+ $raData = $container{'name'};
+ $dstring .= "@$raData";
+ $dstring .= "</dsml:name>\n";
+ delete($container{'name'} );
+ push(@$fh, $dstring);
+ }
+ $dstring = "<dsml:object-identifier>";
+ $dstring .= $container{'oid'};
+ $dstring .= "</dsml:object-identifier>\n";
+ delete($container{'oid'} );
+ push(@$fh, $dstring);
+ }
+ #
+ # Opening element and attributes are done,
+ # finish the other elements.
+ #
+ elsif ( $name eq "syntax" )
+ {
+ $dstring = "<dsml:syntax";
+ if ( $container{'max_length'} )
+ {
+ $dstring .= " bound=\"";
+ $raData = $container{'max_length'};
+ $dstring .= "@$raData";
+ $dstring .= "\">";
+ delete($container{'max_length'} );
+ }
+ else
+ {
+ $dstring .= ">";
+ }
+ $raData = $container{'syntax'};
+ $dstring .= "@$raData";
+ $dstring .= "</dsml:syntax>\n";
+ push(@$fh, $dstring);
+ delete($container{'syntax'} );
+ }
+ elsif ( $name eq "desc" )
+ {
+ $dstring = "<dsml:description>";
+ $raData = $container{'desc'};
+ $dstring .= "@$raData";
+ $dstring .= "</dsml:description>\n";
+ push(@$fh, $dstring);
+ delete($container{'desc'} );
+ }
+ elsif ( $container{'may'} )
+ {
+ my $data = $container{'may'};
+ foreach my $t1 (@$data )
+ {
+ push(@$fh, "<dsml:attribute ref=\"#$t1\" required=\"false\"/>\n");
+ }
+ delete($container{'may'} );
+ }
+ elsif ( $container{'must'} )
+ {
+ my $data = $container{'must'};
+ foreach my $t1 (@$data )
+ {
+ push(@$fh, "<dsml:attribute ref=\"#$t1\" required=\"true\"/>\n");
+ }
+ delete($container{'must'} );
+ }
+
+ }
+ else
+ {
+ #
+ # Take care of the attribute-type and objectclass-type
+ # section first. This part writes to a file.
+ #
+ if( $container{'id'} )
+ {
+ $dstring ="<dsml:$title ";
+ $dstring .= "id=\"";
+ $dstring .= $container{'id'};
+ delete($container{'id'} );
+ if ( $container{'sup'} )
+ {
+ $dstring .= "\" ";
+ $raData = $container{'sup'};
+ $dstring .= "superior=\"#";
+ foreach my $super (@$raData)
+ {
+ $dstring .= "$super #";
+ }
+ }
+ chop($dstring); # Chop off "#"
+ chop($dstring); # Chop off " "
+ if ( $container{'single-value'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "single-value=\"true";
+ delete($container{'single-value'} );
+ }
+ if ( $container{'obsolete'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "obsolete=\"true";
+ delete($container{'obsolete'} );
+ }
+ if ( $container{'user-modification'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "user-modification=\"true";
+ delete($container{'user-modification'} );
+ }
+ if ( $container{'structural'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "type=\"";
+ $dstring .= $container{'structural'};
+ delete($container{'structural'} );
+ }
+ if ( $container{'abstract'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "type=\"";
+ $dstring .= "$container{'abstract'}";
+ delete($container{'abstract'} );
+ }
+ if ( $container{'auxiliary'} )
+ {
+ $dstring .= "\" ";
+ $dstring .= "type=\"";
+ $dstring .= "$container{'auxiliary'}";
+ delete($container{'auxiliary'} );
+ }
+ $dstring .= "\">\n";
+ print $fh $dstring; # print to file
+
+ if ( $container{'name'} )
+ {
+ $dstring = "<dsml:name>";
+ $raData = $container{'name'};
+ $dstring .= "@$raData";
+ $dstring .= "</dsml:name>\n";
+ delete($container{'name'} );
+ print $fh $dstring;
+ }
+ $dstring = "<dsml:object-identifier>";
+ $dstring .= $container{'oid'};
+ $dstring .= "</dsml:object-identifier>\n";
+ delete($container{'oid'} );
+ print $fh $dstring; # print to file
+ }
+ #
+ # Opening element and attributes are done,
+ # finish the other elements.
+ #
+ elsif ( $name eq "syntax" )
+ {
+ $dstring = "<dsml:syntax";
+ if ( $container{'max_length'} )
+ {
+ $dstring .= " bound=\"";
+ $raData = $container{'max_length'};
+ $dstring .= "@$raData";
+ $dstring .= "\">";
+ delete($container{'max_length'} );
+ }
+ else
+ {
+ $dstring .= ">";
+ }
+ $raData = $container{'syntax'};
+ $dstring .= "@$raData";
+ $dstring .= "</dsml:syntax>\n";
+ print $fh $dstring;
+ delete($container{'syntax'} );
+ }
+ elsif ( $name eq "desc" )
+ {
+ $dstring = "<dsml:description>";
+ $raData = $container{'desc'};
+ $dstring .= "@$raData";
+ $dstring .= "</dsml:description>\n";
+ print $fh $dstring;
+ delete($container{'desc'} );
+ }
+ elsif ( $container{'may'} )
+ {
+ my $data = $container{'may'};
+ foreach my $t1 (@$data )
+ {
+ print $fh "<dsml:attribute ref=\"#$t1\" required=\"false\"/>\n";
+ }
+ delete($container{'may'} );
+ }
+ elsif ( $container{'must'} )
+ {
+ my $data = $container{'must'};
+ foreach my $t1 (@$data )
+ {
+ print $fh "<dsml:attribute ref=\"#$t1\" required=\"true\"/>\n";
+ }
+ delete($container{'must'} );
+ }
+ }
+ }
+
+if ( ref($fh) eq "ARRAY" )
+{
+$dstring ="</dsml:$title>\n";
+push(@$fh, $dstring);
+}
+else
+{
+print $fh "</dsml:$title>\n";
+}
+
+%container = ();
+}
+
+} # End of subroutine print_loop
+
+
sub _print_entry {
my ($self,$entry) = @_;
my @unknown;
my $count;
+ my $dstring;
my $fh = $self->{'net_ldap_fh'} or return;
return undef unless ($entry->isa('Net::LDAP::Entry'));
@@ -162,9 +523,10 @@
if ( ref($fh) eq "ARRAY" )
{
- push(@$fh, "<dsml:entry dn=\"");
- push(@$fh, _normalize($entry->dn));
- push(@$fh, "\">\n");
+ $dstring = "<dsml:entry dn=\"";
+ $dstring .= _normalize($entry->dn);
+ $dstring .= "\">\n";
+ push(@$fh, $dstring);
}
else
{
@@ -196,9 +558,10 @@
else {
if ( ref($fh) eq "ARRAY" )
{
- push(@$fh, "<dsml:attr name=\"");
- push(@$fh, _normalize($attr));
- push(@$fh, "\">\n");
+ $dstring = "<dsml:attr name=\"";
+ $dstring .= _normalize($attr);
+ $dstring .= "\">\n";
+ push(@$fh, $dstring);
}
else
{
@@ -212,9 +575,10 @@
if ($isOC) {
if ( ref($fh) eq "ARRAY" )
{
- push(@$fh, "<dsml:oc-value>");
- push(@$fh, _normalize($value));
- push(@$fh, "</dsml:oc-value>\n");
+ $dstring = "<dsml:oc-value>";
+ $dstring .= _normalize($value);
+ $dstring .= "</dsml:oc-value>\n";
+ push(@$fh, $dstring);
}
else
{
@@ -228,9 +592,10 @@
require MIME::Base64;
if ( ref($fh) eq "ARRAY" )
{
- push(@$fh, qq!<dsml:value encoding="base64">!);
- push(@$fh, MIME::Base64::encode($value));
- push(@$fh, "</dsml:value>\n");
+ $dstring = qq!<dsml:value encoding="base64">!;
+ $dstring .= MIME::Base64::encode($value);
+ $dstring .= "</dsml:value>\n";
+ push(@$fh, $dstring);
}
else
{
@@ -242,9 +607,10 @@
else {
if ( ref($fh) eq "ARRAY" )
{
- push(@$fh, "<dsml:value>");
- push(@$fh, _normalize($value));
- push(@$fh, "</dsml:value>\n");
+ $dstring = "<dsml:value>";
+ $dstring .= _normalize($value);
+ $dstring .= "</dsml:value>\n";
+ push(@$fh, $dstring);
}
else
{
@@ -278,8 +644,9 @@
if ( ref($fh) eq "ARRAY" )
{
- push(@$fh, "</dsml:entry>\n");
- push(@$fh, "</dsml:directory-entries>\n");
+ $dstring = "</dsml:entry>\n";
+ $dstring .= "</dsml:directory-entries>\n";
+ push(@$fh, $dstring);
}
else
{
|
|
From: Clif H. <ch...@us...> - 2001-12-18 12:59:14
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv6061/ldap/lib/Net/LDAP
Modified Files:
DSML.pm
Log Message:
Changed code to allow and comprehend the passing of an array
referrence instead of a file handle. This touched all of the
methods that wrote to a file. The new code does/should not affect
the way the code worked with a file handle.
Index: DSML.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- DSML.pm 2001/08/24 19:31:14 1.4
+++ DSML.pm 2001/12/18 12:59:11 1.5
@@ -1,10 +1,19 @@
package Net::LDAP::DSML;
-# For schema parsing, add ability to Net::LDAP::Schema to accecpt a Net::LDAP::Entry object. First
-# we'll convert XML into Net::LDAP::Entry with schema attributes and then pass to schema object constructor
+# For schema parsing, add ability to Net::LDAP::Schema to accecpt
+# a Net::LDAP::Entry object. First
+# we'll convert XML into Net::LDAP::Entry with schema attributes and
+# then pass to schema object constructor
#
# move XML::DSML to Net::LDAP::DSML::Parser
# change parser so that it uses callbacks
+#
+# 12/18/01 Clif Harden
+# Changed code to allow and comprehend the passing of an array
+# reference instead of a file handle. This touched all of the
+# methods that wrote to a file.
+#
+
use strict;
use Net::LDAP::Entry;
@@ -29,7 +38,7 @@
$self->finish
if $self->{net_ldap_fh};
- if (ref($file) or ref(\$file) eq "GLOB") {
+ if (ref($file) or ref(\$file) eq "GLOB" or ref($file) eq "ARRAY") {
$close = 0;
$fh = $file;
}
@@ -46,7 +55,14 @@
$self->{net_ldap_fh} = $fh;
$self->{net_ldap_close} = $close;
- print $fh $self->start_dsml;
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, $self->start_dsml);
+ }
+ else
+ {
+ print $fh $self->start_dsml;
+ }
1;
}
@@ -55,8 +71,15 @@
my $fh = $self->{net_ldap_fh};
if ($fh) {
- print $fh $self->end_dsml;
- close($fh) if $self->{net_ldap_close};
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, $self->end_dsml);
+ }
+ else
+ {
+ print $fh $self->end_dsml;
+ close($fh) if $self->{net_ldap_close};
+ }
}
}
@@ -102,7 +125,19 @@
#coming soon! ;)
sub _print_schema {
- my $self = shift;
+ my ($self,$entry) = @_;
+
+ my $fh = $self->{'net_ldap_fh'} or return;
+ return undef unless ($entry->isa('Net::LDAP::Schema'));
+
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "<dsml:directory-entries>\n");
+ }
+ else
+ {
+ print $fh "<dsml:directory-entries>\n";
+ }
@_;
}
@@ -116,9 +151,25 @@
my $fh = $self->{'net_ldap_fh'} or return;
return undef unless ($entry->isa('Net::LDAP::Entry'));
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "<dsml:directory-entries>\n");
+ }
+ else
+ {
print $fh "<dsml:directory-entries>\n";
+ }
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "<dsml:entry dn=\"");
+ push(@$fh, _normalize($entry->dn));
+ push(@$fh, "\">\n");
+ }
+ else
+ {
print $fh "<dsml:entry dn=\"",_normalize($entry->dn),"\">\n";
+ }
my @attributes = $entry->attributes();
@@ -133,43 +184,108 @@
}
if ($isOC) {
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "<dsml:objectclass>\n");
+ }
+ else
+ {
print $fh "<dsml:objectclass>\n";
+ }
}
else {
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "<dsml:attr name=\"");
+ push(@$fh, _normalize($attr));
+ push(@$fh, "\">\n");
+ }
+ else
+ {
print $fh "<dsml:attr name=\"",_normalize($attr),"\">\n";
+ }
}
my @values = $entry->get_value($attr);
for my $value (@values) {
if ($isOC) {
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "<dsml:oc-value>");
+ push(@$fh, _normalize($value));
+ push(@$fh, "</dsml:oc-value>\n");
+ }
+ else
+ {
print $fh "<dsml:oc-value>",_normalize($value),"</dsml:oc-value>\n";
+ }
}
else {
#at some point we'll use schema object to determine
#this but until then we'll borrow this from Net::LDAP::LDIF
if ($value=~ /(^[ :]|[\x00-\x1f\x7f-\xff])/) {
require MIME::Base64;
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, qq!<dsml:value encoding="base64">!);
+ push(@$fh, MIME::Base64::encode($value));
+ push(@$fh, "</dsml:value>\n");
+ }
+ else
+ {
print $fh qq!<dsml:value encoding="base64">!,
MIME::Base64::encode($value),
"</dsml:value>\n";
+ }
}
else {
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "<dsml:value>");
+ push(@$fh, _normalize($value));
+ push(@$fh, "</dsml:value>\n");
+ }
+ else
+ {
print $fh "<dsml:value>",_normalize($value),"</dsml:value>\n";
+ }
}
}
}
if ($isOC) {
- print $fh "</dsml:objectclass>\n";
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "</dsml:objectclass>\n");
+ }
+ else
+ {
+ print $fh "</dsml:objectclass>\n";
+ }
}
else {
- print $fh "</dsml:attr>\n";
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "</dsml:attr>\n");
+ }
+ else
+ {
+ print $fh "</dsml:attr>\n";
+ }
}
}
- print $fh "</dsml:entry>\n";
- print $fh "</dsml:directory-entries>\n";
+ if ( ref($fh) eq "ARRAY" )
+ {
+ push(@$fh, "</dsml:entry>\n");
+ push(@$fh, "</dsml:directory-entries>\n");
+ }
+ else
+ {
+ print $fh "</dsml:entry>\n";
+ print $fh "</dsml:directory-entries>\n";
+ }
1;
}
@@ -272,6 +388,12 @@
$dsml->open(*IO) or die ("DSML problems opening $file.$!\n");
+ #or
+
+ my @data = ();
+ $dsml->open(\@data) or die ("DSML problems opening with an array.$!\n");
+
+
my $mesg = $ldap->search(
base => 'o=airius.com',
scope => 'sub',
@@ -319,6 +441,60 @@
parse large DSML files. Every time a single entry or schema is processed
we pass the Net::LDAP object (either an Entry or Schema object) to the
callback routine.
+
+=head1 CONSTRUCTOR
+
+new ()
+Creates a new Net::LDAP::DSML object. There are no options
+to this method.
+
+B<Example>
+
+ my $dsml = Net::LDAP::DSML->new();
+
+=head1 METHODS
+
+=over 4
+
+=item open ( OUTPUT )
+
+OUTPUT is a referrence to either a file handle that has already
+been opened or to an array.
+
+B<Example>
+
+ For a file.
+
+ my $io = IO::File->new($file,"w");
+ my $dsml = Net::LDAP::DSML->new();
+ $dsml->open($io) or die ("DSML problems opening $file.$!\n");
+
+ For an array.
+
+ my @data = ();
+ my $dsml = Net::LDAP::DSML->new();
+ $dsml->open(\@data) or die ("DSML opening problems.$!\n");
+
+=item write( ENTRY )
+
+Entry is a Net::LDAP::Entry object. The write method will parse
+the LDAP data in the Entry object and put it into DSML XML
+format.
+
+B<Example>
+
+ my $entry = $mesg->entry();
+ $dsml->write($entry);
+
+=item finish ()
+
+This method writes the closing DSML XML statements to the file or
+array.
+
+B<Example>
+
+ $dsml->finish();
+
=head1 AUTHOR
|
|
From: Clif H. <ch...@us...> - 2001-12-17 16:51:02
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv957/ldap/lib/Net/LDAP
Modified Files:
FAQ.pod
Log Message:
Added text about simulated server failover.
Index: FAQ.pod
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/FAQ.pod,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- FAQ.pod 2001/08/26 22:16:32 1.20
+++ FAQ.pod 2001/12/17 16:50:59 1.21
@@ -1031,6 +1031,23 @@
print ldap_error_name($result->code);
+=head2 How can I simiulate server failover.
+
+Perl-LDAP does not do server failover, however there are several
+programming options for getting around this situation.
+
+Here is one possible solution.
+
+ unless ( $ldaps =
+ Net::LDAPS->new($ldapserverone,
+ port=>636,timeout=>5) )
+ {
+ $ldaps = Net::LDAPS->new($ldapservertwo,
+ port=>636,timeout=>20) ||
+ return
+ "Can't connect to $ldapserverone or $ldapservertwo via LDAPS: $@";
+ }
+
=head1 Using X.509 certificates.
=head2 How do I store X.509 certificates in the directory?
|
|
From: Clif H. <ch...@us...> - 2001-12-17 16:50:06
|
Update of /cvsroot/perl-ldap/website
In directory usw-pr-cvs1:/tmp/cvs-serv609/website
Modified Files:
FAQ.html
Log Message:
Added text about how to simulate server failover.
Index: FAQ.html
===================================================================
RCS file: /cvsroot/perl-ldap/website/FAQ.html,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- FAQ.html 2001/08/26 22:14:37 1.7
+++ FAQ.html 2001/12/17 16:50:02 1.8
@@ -112,6 +112,7 @@
<LI><A HREF="#How_do_I_add_an_ACI_ACL_entry_to">How do I add an ACI/ACL entry to a directory server with</A>
<LI><A HREF="#How_do_I_avoid_file_type_and_dat">How do I avoid file type and data type miss-matching when loading</A>
<LI><A HREF="#How_do_I_create_a_Microsoft_Exch">How do I create a Microsoft Exchange user.</A>
+ <LI><A HREF="#How_can_I_simiulate_server_failo">How can I simiulate server failover.</A>
</UL>
<LI><A HREF="#Using_X_509_certificates_">Using X.509 certificates.</A>
@@ -626,7 +627,7 @@
<DT><STRONG><A NAME="item_URI">URI::ldap</A></STRONG><DD>
<P>
This module is optional. You only need to install URI::ldap if you are
-going to need to parse ldap referrals. <A HREF="/Net/LDAP|Net/LDAP.html">Net::LDAP|Net::LDAP</A> does not do this automatically yet, so this module is not used by
+going to need to parse ldap referrals. <A HREF="/Net/LDAP.html">Net::LDAP</A> does not do this automatically yet, so this module is not used by
perl-ldap.
<P>
@@ -688,7 +689,7 @@
<H2><A NAME="How_can_I_tell_when_the_server_r">How can I tell when the server returns an error, bind() always returns
true ?</A></H2>
<P>
-Most methods in Net::LDAP return a <A HREF="/Net/LDAP/Message|Net/LDAP/Message.html">Net::LDAP::Message|Net::LDAP::Message</A>
+Most methods in Net::LDAP return a <A HREF="/Net/LDAP/Message.html">Net::LDAP::Message</A>
object, or a sub-class of that. This object will hold the results from the
server, including the result code.
@@ -738,14 +739,14 @@
<P>
<CODE>$mesg</CODE> is a search object container. It is a reference blessed
into the
-<A HREF="/Net/LDAP/Search|Net/LDAP/Search.html">Net::LDAP::Search|Net::LDAP::Search</A> package. By calling methods on this object you can obtain information about
+<A HREF="/Net/LDAP/Search.html">Net::LDAP::Search</A> package. By calling methods on this object you can obtain information about
the result and also the individual entries.
<P>
The first thing to check is if the search was successful. This is done with
with the method $mesg->code. This method will return the status code
that the server returned. A success will yield a zero value, but there are
-other values, some of which could also be considered a success. See <A HREF="/Net/LDAP/Constant|Net/LDAP/Constant.html">Net::LDAP::Constant|Net::LDAP::Constant</A>
+other values, some of which could also be considered a success. See <A HREF="/Net/LDAP/Constant.html">Net::LDAP::Constant</A>
@@ -783,7 +784,7 @@
</PRE>
<P>
In each case <CODE>$entry</CODE> is an entry object container. It is a
-reference blessed into the <A HREF="/Net/LDAP/Entry|Net/LDAP/Entry.html">Net::LDAP::Entry|Net::LDAP::Entry</A> package. By calling methods on this object you can obtain information about
+reference blessed into the <A HREF="/Net/LDAP/Entry.html">Net::LDAP::Entry</A> package. By calling methods on this object you can obtain information about
the entry.
<P>
@@ -1402,6 +1403,27 @@
</PRE>
<P>
<HR>
+<H2><A NAME="How_can_I_simiulate_server_failo">How can I simiulate server failover.</A></H2>
+<P>
+Perl-LDAP does not do server failover, however there are several
+programming options for getting around this situation.
+
+<P>
+Here is one possible solution.
+
+<P>
+<PRE> unless ( $ldaps =
+ Net::LDAPS->new($ldapserverone,
+ port=>636,timeout=>5) )
+ {
+ $ldaps = Net::LDAPS->new($ldapservertwo,
+ port=>636,timeout=>20) ||
+ return
+ "Can't connect to $ldapserverone or $ldapservertwo via LDAPS: $@";
+ }
+</PRE>
+<P>
+<HR>
<H1><A NAME="Using_X_509_certificates_">Using X.509 certificates.</A></H1>
<P>
<HR>
@@ -1539,12 +1561,11 @@
HREF="http://www.java.sun.com/jndi/">http://www.java.sun.com/jndi/</A>
<P>
-Eine deutsche LDAP Website<br>
-A german LDAP Website<br>
-<A HREF="http://verzeichnisdienst.de/ldap/Perl/index.html">http://verzeichnisdienst.de/ldap/Perl/index.html</a>
+Eine deutsche LDAP Website A german LDAP Website <A
+HREF="http://verzeichnisdienst.de/ldap/Perl/index.html">http://verzeichnisdienst.de/ldap/Perl/index.html</A>
-<P>
+<P>
The 2 following URLs deal mainly with Microsoft's Active Directory.
<P>
|
|
From: Clif H. <ch...@us...> - 2001-12-17 01:35:48
|
Update of /cvsroot/perl-ldap/ldap/contrib
In directory usw-pr-cvs1:/tmp/cvs-serv1078/ldap/contrib
Modified Files:
tklkup
Log Message:
Added fail safe code to the DELETE entry operation. This forces the
user to confirm the delete entry request.
Added pod documentation for the DELETE fail safe window.
Index: tklkup
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- tklkup 2001/12/15 05:06:43 1.20
+++ tklkup 2001/12/17 01:35:45 1.21
@@ -21,6 +21,12 @@
#
# Revisions:
# $Log$
+# Revision 1.21 2001/12/17 01:35:45 charden
+#
+# Added fail safe code to the DELETE entry operation. This forces the
+# user to confirm the delete entry request.
+# Added pod documentation for the DELETE fail safe window.
+#
# Revision 1.20 2001/12/15 05:06:43 charden
#
# Corrected pod documentation error.
@@ -2079,8 +2085,56 @@
} # End of subroutine Hierarchial
+
+
+#
+# Create Accept/Cancel Window
+#
+
+sub questionAction {
+my $x = $Global{'horz'} + 0;
+my $y = $Global{'vert'} + 50;
+
+#
+# Create Main Window
+#
+$Global{'answerWindow'} = MainWindow->new;
+
+$Global{'answerWindow'}->title("BIND TO DIRECTORY");
+
+$Global{'answerWindow'}->geometry("+$x+$y");
+#
+# Create process accept button
#
+$Global{'answerWindow'}->Button( -text => "ACCEPT", -command => \&doAction,
+ -font => $Global{'Font'}, -borderwidth => 3 )
+ -> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
+
+#
+# Create process cancel button
+#
+$Global{'answerWindow'}->Button(-text => "CANCEL", -command => \&cancelAction,
+ -font => $Global{'Font'}, -borderwidth => 3)
+ -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
+
+sub cancelAction{
+
+$Global{'answerWindow'}->destroy() if Tk::Exists($Global{'answerWindow'});
+delete($Global{'answerWindow'});
+} # End of cancel subroutine
+
+sub doAction{
+
+$Global{'answerWindow'}->destroy() if Tk::Exists($Global{'answerWindow'});
+delete($Global{'answerWindow'});
+&ldapActionDelete;
+
+} # End of accept subroutine
+} # End of BIND subroutine
+
+
+#
# Create ldapAction Window
#
@@ -2129,7 +2183,7 @@
# Create ldap delete button
#
$Global{'ldapActionWindow'}->Button(-text => "DELETE",
- -command => \&ldapActionDelete,
+ -command => \&questionAction,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -padx => 5, -pady => 5 ) ;
@@ -4065,6 +4119,17 @@
display the data for the currently selected DN.
There can only be one of these windows active at a time.
+
+-------------------------------------------------------------------
+
+=head1 DIRECTORY DELETE CONFIRM WINDOW.
+
+When the DELETE button is selected, before the actual deletion
+takes place, a window will be displayed with a Cancel and Accept
+buttons. This gives the user a fail safe in case the user selects
+the DELETE button by accident. Pressing the Cancel will cancel
+the delete request, pressing the Accept button will cause the
+directory entry to be deleted.
-------------------------------------------------------------------
|
|
From: Clif H. <ch...@us...> - 2001-12-15 05:06:49
|
Update of /cvsroot/perl-ldap/ldap/contrib In directory usw-pr-cvs1:/tmp/cvs-serv8723/ldap/contrib Modified Files: tklkup Log Message: Corrected pod documentation error. Index: tklkup =================================================================== RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- tklkup 2001/12/15 04:57:15 1.19 +++ tklkup 2001/12/15 05:06:43 1.20 @@ -21,6 +21,10 @@ # # Revisions: # $Log$ +# Revision 1.20 2001/12/15 05:06:43 charden +# +# Corrected pod documentation error. +# # Revision 1.19 2001/12/15 04:57:15 charden # # Added code to allow various entry modifications. @@ -4052,13 +4056,15 @@ ------------------------------------------------------------------- -=head1 DIRECTORY SEARCH DISPLAY - EDIT WINDOW. +=head1 DIRECTORY EDIT DISPLAY WINDOW. When this fucntion is installed and working properly this is where the user will modify an entry's data. Currently this function is I<NOT> working. However it will display the data for the currently selected DN. + +There can only be one of these windows active at a time. ------------------------------------------------------------------- |
|
From: Clif H. <ch...@us...> - 2001-12-15 04:57:18
|
Update of /cvsroot/perl-ldap/ldap/contrib
In directory usw-pr-cvs1:/tmp/cvs-serv6609/ldap/contrib
Modified Files:
tklkup
Log Message:
Added code to allow various entry modifications.
Added code to delete an entry.
Added code to do a mod RDN on an entry.
Changed search code to display in a ROText box.
Started code for entry data modification, this code is not complete
but will not break anything if used. It will just display the data
in the Text box that will be used of modification.
Updated pod documentation to reflect the code changes.
Index: tklkup
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- tklkup 2001/09/09 04:50:31 1.18
+++ tklkup 2001/12/15 04:57:15 1.19
@@ -21,6 +21,17 @@
#
# Revisions:
# $Log$
+# Revision 1.19 2001/12/15 04:57:15 charden
+#
+# Added code to allow various entry modifications.
+# Added code to delete an entry.
+# Added code to do a mod RDN on an entry.
+# Changed search code to display in a ROText box.
+# Started code for entry data modification, this code is not complete
+# but will not break anything if used. It will just display the data
[...1049 lines suppressed...]
+When this fucntion is installed and working properly this is
+where the user will modify an entry's data.
+
+Currently this function is I<NOT> working. However it will
+display the data for the currently selected DN.
+
+-------------------------------------------------------------------
+
=head1 Schema Window.
=head2 Directory Schema Search Window
@@ -3402,7 +4123,7 @@
with 4 additional functions will be displayed inside the
Directory Data text box. These 4 functions are;
- File -> This function exits the program. You can not edit
+ File -> This function exits the window. You can not edit
the Directory Data text box because it is created
as a read only text box.
|
|
From: Graham B. <gb...@us...> - 2001-12-03 16:20:29
|
Update of /cvsroot/perl-ldap/ldap
In directory usw-pr-cvs1:/tmp/cvs-serv22844
Modified Files:
Makefile.PL
Log Message:
Add check for MIME::Base64
Index: Makefile.PL
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/Makefile.PL,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Makefile.PL 2001/04/10 17:02:34 1.6
+++ Makefile.PL 2001/12/03 16:20:26 1.7
@@ -67,6 +67,10 @@
The XML::Parser module is needed ONLY IF you intend to read/write DSML files
EDQ
+check_module('MIME::Base64') or print <<"EDQ","\n";
+The MIME::Base64 module is needed ONLY IF you intend to read/write LDIF files
+EDQ
+
print "\n",<<"EDQ","\n" if $missing;
****************************************************************************
You are missing some modules that MAY be needed for some of the features
|
|
From: Graham B. <gb...@us...> - 2001-11-10 06:35:15
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv31289/lib/Net/LDAP
Modified Files:
Entry.pm
Log Message:
Fix case-sensitively in get_value with alloptions=>1
Index: Entry.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Entry.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- Entry.pm 2001/10/05 14:36:00 1.8
+++ Entry.pm 2001/11/10 06:35:12 1.9
@@ -9,7 +9,7 @@
use Net::LDAP::Constant qw(LDAP_LOCAL_ERROR);
use vars qw($VERSION);
-$VERSION = "0.15";
+$VERSION = "0.16";
sub new {
my $self = shift;
@@ -78,7 +78,7 @@
if ($opt{alloptions}) {
my %ret = map {
- $_->{type} =~ /^\Q$type\E(.*)/ ? (lc($1), $_->{vals}) : ()
+ $_->{type} =~ /^\Q$type\E(.*)/i ? (lc($1), $_->{vals}) : ()
} @{$self->{asn}{attributes}};
return %ret ? \%ret : undef;
}
|
|
From: Graham B. <gb...@us...> - 2001-11-10 06:29:57
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv30498/lib/Net/LDAP
Modified Files:
Util.pm
Log Message:
Added ldap_explode_dn
Index: Util.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Util.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- Util.pm 2001/06/11 16:29:05 1.12
+++ Util.pm 2001/11/10 06:29:54 1.13
@@ -38,8 +38,9 @@
ldap_error_text
ldap_error_desc
canonical_dn
+ ldap_explode_dn
);
-$VERSION = "0.06";
+$VERSION = "0.07";
=item ldap_error_name ( NUM )
@@ -275,10 +276,68 @@
sub canonical_dn {
my ($dn, $rev) = @_;
+ my @dn = ldap_explode_dn($dn) or return undef;
- $dn = $dn->dn if ref($dn);
+ my($comma, $plus) = $rev ? ("\000","\001") : (",", "+");
+
+ join($comma,
+ map {
+ my $h = $_;
+ my @t = sort keys %$h;
+ join($plus,
+ map {
+ my $val = $h->{$_};
+ if ($val !~ /^#/) {
+ $val =~ s/([\\",=+<>#;])/\\$1/g;
+ $val =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\%02x",ord($1))/eg;
+ $val =~ s/(^\s+|\s+$)/"\\20" x length $1/ge;
+ }
+ "$_=$val";
+ } $rev ? reverse(@t) : @t)
+ } $rev ? reverse(@dn) : @dn);
- my (@dn, @rdn);
+}
+
+
+=item ldap_explode_dn ( DN )
+
+Explodes the given DN into a list of hashes. Each RDN will be
+a separate element in the list returned.
+
+Each RDN is returned as a hash.
+
+Returns the empty list if DN is
+not a valid Distinguished Name
+
+It also performs the following operations on the given DN
+
+=over 4
+
+=item *
+
+Lowercases values that are # followed by hex.
+
+=item *
+
+Uppercases type names.
+
+=item *
+
+Removes the leading OID. characters if the type is an OID instead
+of a name.
+
+=back
+
+B<Note> values that are hex encoded (ie start with a #) are not
+decoded. So C<SN=Barr> is not treated the same as C<SN=#42617272>
+
+=cut
+
+
+sub ldap_explode_dn {
+ my ($dn) = @_;
+
+ my (@dn, %rdn);
while (
$dn =~ /\G(?:
\s*
@@ -304,25 +363,21 @@
if ($val !~ /^#/) {
$val =~ s/^"(.*)"$/$1/;
$val =~ s/\\([\\ ",=+<>#;]|[0-9a-fA-F]{2})
- /length($1)==1 ? $1 : chr(hex($1))
- /xeg;
- $val =~ s/([\\",=+<>#;])/\\$1/g;
- $val =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\%02x",ord($1))/eg;
-
- $val =~ s/(^\s+|\s+$)/"\\20" x length $1/ge;
+ /length($1)==1 ? $1 : chr(hex($1))
+ /xeg;
}
- push @rdn, "\U$type\E=$val";
+ $rdn{uc $type} = $val;
unless (defined $sep and $sep eq '+') {
- push @dn, join($rev ? "\001" : "+", sort @rdn);
- @rdn = ();
+ push @dn, { %rdn };
+ %rdn = ();
}
}
(length($dn) != (pos($dn)||0))
- ? undef
- : join($rev ? "\000" : ",",$rev ? (reverse @dn) : @dn);
+ ? ()
+ : @dn;
}
=back
|
|
From: Clif H. <ch...@us...> - 2001-11-09 05:03:06
|
Update of /cvsroot/perl-ldap/website In directory usw-pr-cvs1:/tmp/cvs-serv26743/website Modified Files: index.html Log Message: Corrected a minor html slip of the fingers. Index: index.html =================================================================== RCS file: /cvsroot/perl-ldap/website/index.html,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- index.html 2001/11/09 05:00:35 1.13 +++ index.html 2001/11/09 05:03:04 1.14 @@ -127,7 +127,7 @@ in a database and the Faq-o-matic does not work that way for a number of reasons. This means we can not update our Faq-o-matic, but we can view the static content. - +<p> PERL-LDAP <a href="http://perl-ldap.sourceforge.net/faqomatic/cache/1.html"> Faq-o-matic</A> |
|
From: Clif H. <ch...@us...> - 2001-11-09 05:00:37
|
Update of /cvsroot/perl-ldap/website In directory usw-pr-cvs1:/tmp/cvs-serv26128/website Modified Files: index.html Log Message: Added url for static faq-o-matic content. Index: index.html =================================================================== RCS file: /cvsroot/perl-ldap/website/index.html,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- index.html 2001/10/30 03:30:48 1.12 +++ index.html 2001/11/09 05:00:35 1.13 @@ -121,16 +121,15 @@ <p> <H2>FAQ-O-MATIC</H2> -Due to delibrate actions by the system administration staff of -sourceforge the Perl-LDAP Faq-o-matic has been destroyed. It -appears that the system administration staff of sourceforge has -no intention of restoring the Perl-LDAP Faq-o-matic files. <P> -When the Perl-LDAP Faq-o-matic will be rebuilt is unknown. -<P> -<! The newest addition to the PERL-LDAP web page, -<! the PERL-LDAP <a href="http://perl-ldap.sourceforge.net/cgi-bin/fom"> -<! Faq-o-matic</A> +The Perl-LDAP Faq-o-matic is back online to a certain extent, the content +is now static. Sourceforge requires that state information be stored +in a database and the Faq-o-matic does not work that way for a number of +reasons. This means we can not update our Faq-o-matic, but we can view the +static content. + +PERL-LDAP <a href="http://perl-ldap.sourceforge.net/faqomatic/cache/1.html"> + Faq-o-matic</A> <hr> |
