[perl-ldap-checkins] CVS: ldap/contrib tklkup,1.24,1.25

[Clif H. <ch...@us...>]

Update of /cvsroot/perl-ldap/ldap/contrib
In directory usw-pr-cvs1:/tmp/cvs-serv17902/ldap/contrib

Modified Files:
	tklkup 
Log Message:

Change schema code to comprehend the new Schema.pm file.
Added code to determine new x and y position when the main window moves.



Index: tklkup
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -d -r1.24 -r1.25
--- tklkup	3 Jan 2002 02:53:53 -0000	1.24
+++ tklkup	25 May 2002 05:05:55 -0000	1.25
@@ -22,6 +22,11 @@
 #
 # Revisions:
 # $Log$
+# Revision 1.25  2002/05/25 05:05:55  charden
+#
+# Change schema code to comprehend the new Schema.pm file.
+# Added code to determine new x and y position when the main window moves.
+#
 # Revision 1.24  2002/01/03 02:53:53  charden
 #
 # Corrected schema parse and display code to comprehend that a multi-valued
@@ -209,6 +214,9 @@
 eval { use Tk::JPEG; }; 
 $Global{'jpeg'}   = 0 if ( $@ );
 
+#
+# Window roots
+#
 $Global{'mainWindow'}   = undef();
 $Global{'schemaWindow'} = undef();
 $Global{'histWindow'}   = undef();
@@ -1055,6 +1063,8 @@
  
 $dn_data = "";
 $pw_data = "";
+&globalPos();
+
 my $x = $Global{'horz'} + 150;
 my $y = $Global{'vert'} + 150;
  
@@ -1195,6 +1205,7 @@
 sub PORT {
  
 $port_data = $Global{'port'};
+&globalPos();
 my $x = $Global{'horz'} + 150;
 my $y = $Global{'vert'} + 150;
  
@@ -1263,46 +1274,76 @@
 my $list = shift;
 my $ocs = shift;
 my $Title = shift;
-my $method = shift;
+#my $method = shift;
 
-foreach ( @$ocs)
+my $asize;
+my $ahash;
+my $var;
+
+foreach $ahash ( @$ocs)
 {
    $list->insert("end", "$Title\n");
 
    #
-   # Get and display the oid number of the objectclass.
+   # Get and display the data for this object
    #
-   my $oid = $schemaHash{'schema'}->$method( "$_" );
-#   my $oid = $schemaHash{'schema'}->name2oid( "$_" );
-   
+
+   my @hkeys = keys(%$ahash);
+ 
+   foreach $var (@hkeys)
+   {
+   # Step thru the hash keys
+  
+   next if ( $var =~ /type/);  # do not care about type
+
+   $alArray =  $$ahash{$var};
+ 
+   if ( ref($alArray) eq 'ARRAY' )
+   {
+   # it is a n array pointer so there is probably a list.
+ 
+   my $asize = @$alArray;  # get the size of the list.
    #
-   # Get the various other items associated with
-   # this attribute.
+   # if the array has size then print the array
+   # else ignore the array.
    #
-   my @items = $schemaHash{'schema'}->items( "$oid" );
-   foreach my $value ( @items )
+   if ( $asize  )
    {
-      next if ( $value eq 'type');
+   # Okay, there is something in the array. 
 
-      @item = $schemaHash{'schema'}->item( $oid, $value );
-      $value =~ tr/a-z/A-Z/;
-      if ( @item && $item[0] eq '1' )
-      {
-         $list->insert("end", "\t$value\n");
-         next;
-      }
-      if ( defined(@item) )
-      {
-         if ( $value eq 'MAY' || $value eq 'MUST' )
-         {
-         $list->insert("end", "\t$value contain:  @item\n");
-         }
-         else
-         {
-         $list->insert("end", "\t$value:  @item\n");
-         }
-      }                                                                    
+   $list->insert("end", "\t$var: ");
+
+   foreach $a ( @$alArray )
+   {
+   $list->insert("end", "$a ");
+   }
+   $list->insert("end", "\n");
+   }
+   }
+   else
+   {
+   # There is not an array
+   if ( $alArray ==  1)
+   { 
+   # it is just information attribute for the object
+   $list->insert("end", "\t$var\n");
    }
+   else
+   {
+   $list->insert("end", "\t$var:  $alArray\n");
+   }
+   }
+ 
+}                                                                               
+
+
+   #
+   # Get the various other items associated with
+   # this attribute.
+   #
+#      next if ( $value eq 'type');
+
+#      $value =~ tr/a-z/A-Z/;
 
 }
 
@@ -1328,6 +1369,7 @@
 my $tframe;
 my $sbframe;
 #my $sslist;
+&globalPos();
 my $x = $Global{'horz'} + 100;
 my $y = $Global{'vert'} + 100;
 #
@@ -1655,7 +1697,7 @@
 #
 # Get the attributes
 #
-@$ra_atts = $schemaHash{'schema'}->attributes(); 
+@$ra_atts = $schemaHash{'schema'}->all_attributes(); 
 $schemaHash{'atts'} = $ra_atts; 
 
 
@@ -1665,7 +1707,7 @@
  
 if ( $selectAll || $selectAtt  )
 {
-&print_loop($schema_list, $schemaHash{'atts'}, "attributeType", "is_attribute") 
+&print_loop($schema_list, $schemaHash{'atts'}, "attributeType") 
   if ( defined($schemaHash{'atts'}) );
 }
 
@@ -1673,14 +1715,18 @@
 #
 # Get the schema objectclasses
 #
-@$ra_atts = $schemaHash{'schema'}->objectclasses(); 
+@$ra_atts = $schemaHash{'schema'}->all_objectclasses(); 
 $schemaHash{'ocs'} = $ra_atts;
 
 #
 # Calculate the text length of each objectclass string.
 #
-foreach (@$ra_atts) { $Global{'max'} = length($_) 
-        if length($_) > $Global{'max'} }
+foreach my $var (@$ra_atts) 
+{ 
+$Global{'max'} = length($$var{'name'}) 
+        if length($$var{'name'}) > $Global{'max'} 
+
+}
 
 #
 # Add 6 to the max objectclass string size,
@@ -1695,7 +1741,7 @@
  
 if ( $selectAll || $selectObj )
 {
-&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses", "is_objectclass") 
+&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses") 
     if ( defined($schemaHash{'ocs'}) );
 }
 
@@ -1704,7 +1750,7 @@
 # Get the schema matchingrules
 #
 $ra_atts = [];
-@$ra_atts = $schemaHash{'schema'}->matchingrules(); 
+@$ra_atts = $schemaHash{'schema'}->all_matchingrules(); 
 $schemaHash{'mrs'} = $ra_atts;
 
 #
@@ -1713,7 +1759,7 @@
  
 if ( $selectAll || $selectMatch )
 {
-&print_loop($schema_list, $schemaHash{'mrs'}, "matchingRules", "is_matchingrule" ) 
+&print_loop($schema_list, $schemaHash{'mrs'}, "matchingRules" ) 
     if ( defined($schemaHash{'mrs'}) );
 }
 
@@ -1721,7 +1767,7 @@
 # Get the schema matchingruleuse
 #
 $ra_atts = [];
-@$ra_atts = $schemaHash{'schema'}->matchingruleuse(); 
+@$ra_atts = $schemaHash{'schema'}->all_matchingruleuses(); 
 $schemaHash{'mru'} = $ra_atts;
 
 #
@@ -1730,7 +1776,7 @@
  
 if ( $selectAll || $selectMru )
 {
-&print_loop($schema_list, $schemaHash{'mru'}, "matchingRuleUse", "is_matchinruleuse" ) 
+&print_loop($schema_list, $schemaHash{'mru'}, "matchingRuleUse" ) 
     if ( defined($schemaHash{'mru'}) );
 }
 
@@ -1738,7 +1784,7 @@
 # Get the schema ldapsyntaxes
 #
 $ra_atts = [];
-@$ra_atts = $schemaHash{'schema'}->syntaxes(); 
+@$ra_atts = $schemaHash{'schema'}->all_syntaxes(); 
 $schemaHash{'lsyn'} = $ra_atts;
 
 #
@@ -1747,7 +1793,7 @@
  
 if ( $selectAll || $selectSyn )
 {
-&print_loop($schema_list, $schemaHash{'lsyn'}, "ldapSyntax", "is_syntax" ) 
+&print_loop($schema_list, $schemaHash{'lsyn'}, "ldapSyntax" ) 
     if ( defined($schemaHash{'lsyn'}) );
 }
 
@@ -1755,7 +1801,7 @@
 # Get the schema nameForms
 #
 $ra_atts = [];
-@$ra_atts = $schemaHash{'schema'}->nameforms(); 
+@$ra_atts = $schemaHash{'schema'}->all_nameforms(); 
 $schemaHash{'nfm'} = $ra_atts;
 
 #
@@ -1764,7 +1810,7 @@
  
 if ( $selectAll || $selectNf )
 {
-&print_loop($schema_list, $schemaHash{'nfm'}, "nameForms", "is_nameform" ) 
+&print_loop($schema_list, $schemaHash{'nfm'}, "nameForms" ) 
     if ( defined($schemaHash{'nfm'}) );
 }
 
@@ -1772,7 +1818,7 @@
 # Get the schema ditstructurerules
 #
 $ra_atts = [];
-@$ra_atts = $schemaHash{'schema'}->ditstructurerules(); 
+@$ra_atts = $schemaHash{'schema'}->all_ditstructurerules(); 
 $schemaHash{'dits'} = $ra_atts;
 
 #
@@ -1781,7 +1827,7 @@
  
 if ( $selectAll || $selectDsr )
 {
-&print_loop($schema_list, $schemaHash{'dits'}, "ditstructurerules", "is_ditstructurerule" ) 
+&print_loop($schema_list, $schemaHash{'dits'}, "ditstructurerules" ) 
     if ( defined($schemaHash{'dits'}) );
 }
 
@@ -1789,7 +1835,7 @@
 # Get the schema ditcontentrules
 #
 $ra_atts = [];
-@$ra_atts = $schemaHash{'schema'}->ditcontentrules(); 
+@$ra_atts = $schemaHash{'schema'}->all_ditcontentrules(); 
 $schemaHash{'ditc'} = $ra_atts;
 
 #
@@ -1798,7 +1844,7 @@
  
 if ( $selectAll || $selectDcr )
 {
-&print_loop($schema_list, $schemaHash{'ditc'}, "ditcontentrules", "is_ditcontentrule" ) 
+&print_loop($schema_list, $schemaHash{'ditc'}, "ditcontentrules" ) 
     if ( defined($schemaHash{'ditc'}) );
 }
 
@@ -1847,6 +1893,7 @@
 
 sub Hierarchial 
 {
+&globalPos();
 my $x = $Global{'horz'};
 my $y = $Global{'vert'}  + 200 ;
 my $ocs = $schemaHash{'ocs'};
@@ -1878,24 +1925,31 @@
 #
 # Get the schema objectClasses
 #
-foreach ( @$ocs)
+foreach my $aobj ( @$ocs)
 {
    #
    # Get the oid number of the objectclass.
    #
    my $oid;
    undef($oid);
-
-   $oid = $schema->name2oid( "$_" ); 
+#   print "$aobj\n";
+   $oid = $$aobj{'oid'}; 
    next if ( !defined($oid) );
- 
-   @sup = $schema->item( $oid, 'sup' ); # objectclass superior
-   @name = $schema->item( $oid, 'name' ); # objectclass name
+#   print "oid; $oid\n";
+#   print "sup ",$$aobj{'sup'},"\n"; 
+#   print "name ",$$aobj{'name'},"\n"; 
+    @sup = $$aobj{'sup'}[0];
+    @name = $$aobj{'name'};
+#    print "sup : @sup\n";
+#   @sup = $schema->item( $oid, 'sup' ); # objectclass superior
+#   @name = $schema->item( $oid, 'name' ); # objectclass name
 
    $$obj{"$name[0]"} = [ "$oid", "$sup[0]" ]; # store data
 
 }
 
+#return;
+
 #
 # get objectclass hash keys.
 #
@@ -2030,36 +2084,66 @@
 
             foreach my $var (@objectclasses)
             {
-            $oid = $$obj{$var}->[0];
-
+               $oid = $$obj{$var}->[0];
                #
                # Get the various other items associated with
-               # this attribute.
+               # this objectclass.
                #
-               my @items = $schema->items( "$oid" );
-               foreach my $value ( @items )
+               my $ahash = $schema->objectclass( "$var" );
+
+               my @hkeys = sort(keys(%$ahash));
+               #
+               # Get and display the objectclass name.
+               #
+               $alArray =  $$ahash{'name'};
+               $Global{'list'}->insert("end", "name:  $alArray\n");
+
+               foreach $varr (@hkeys)
                {
-                  next if ( $value eq 'type');
+                # Step thru the hash keys
+  
+                next if ( $varr =~ /name/);  # already done name.
+                next if ( $varr =~ /type/);  # do not care about type
 
-                  @item = $schema->item( $oid, $value );
-                  $value =~ tr/a-z/A-Z/;
-                  if ( @item && $item[0] eq '1' )
-                  {
-                     $Global{'list'}->insert("end", "$value\n");
-                     next;
-                  }
-                  if ( defined(@item) )
+                $alArray =  $$ahash{$varr};
+ 
+                if ( ref($alArray) eq 'ARRAY' )
+                {
+                 # it is a n array pointer so there is probably a list.
+ 
+                 my $asize = @$alArray;  # get the size of the list.
+                 #
+                 # if the array has size then print the array
+                 # else ignore the array.
+                 #
+                 if ( $asize  )
+                 {
+                 # Okay, there is something in the array. 
+ 
+                  $Global{'list'}->insert("end", "\t$varr: ");
+ 
+                  foreach $a ( @$alArray )
                   {
-                     if ( $value eq 'MAY' || $value eq 'MUST' )
-                     {
-                     $Global{'list'}->insert("end", "$value contain:  @item\n");
-                     }
-                     else
-                     {
-                     $Global{'list'}->insert("end", "$value:  @item\n");
-                     }
+                   $Global{'list'}->insert("end", "$a ");
                   }
-               }
+                  $Global{'list'}->insert("end", "\n");
+                 }
+                }
+                else
+                {
+                 # It is not an array
+                 if ( $alArray ==  1)
+                 { 
+                  # it is just and information attribute for the object
+                  $Global{'list'}->insert("end", "\t$varr\n");
+                 }
+                 else
+                 {
+                  $Global{'list'}->insert("end", "\t$varr:  $alArray\n");
+                 }
+                }
+ 
+               } 
 
             $Global{'list'}->insert("end", " \n");
             $Global{'list'}->insert("end", "--------------------------------------------------\n");
@@ -2141,6 +2225,7 @@
 #
  
 sub questionAction {
+&globalPos();
 my $x = $Global{'horz'} + 0;
 my $y = $Global{'vert'} + 50;
  
@@ -2180,7 +2265,7 @@
 &ldapActionDelete;
  
 } # End of accept subroutine
-} # End of BIND subroutine
+} # End of questionAction subroutine
 
  
 #
@@ -2190,7 +2275,8 @@
 sub ldapAction {
 
 $Global{'ldapActionDN'} = shift;
- 
+
+&globalPos(); 
 my $x = $Global{'horz'} + 0;
 my $y = $Global{'vert'} + 30;
  
@@ -2515,6 +2601,7 @@
 #
 if (!Exists($Global{'changeWindow'}) )
 {
+&globalPos();
 my $x = $Global{'horz'} + 75;
 my $y = $Global{'vert'} + 75;
 my $acframe;
@@ -2897,6 +2984,8 @@
    ERROR($errstr);
 }
 
+$ldap->unbind;
+
 }
 
 #
@@ -2975,6 +3064,7 @@
 $Global{'newrdn'} = "";
 $Global{'RenameDN'} = "";
 $Global{'deleteoldrdn'} = 1;
+&globalPos();
 my $x = $Global{'horz'} + 0;
 my $y = $Global{'vert'} + 50;
 my @rdnData;
@@ -3110,6 +3200,7 @@
 my $lframe;
 my $rbclear;
 #my $list;
+&globalPos();
 my $x = $Global{'horz'} + 100;
 my $y = $Global{'vert'} + 100;
 #
@@ -3218,6 +3309,7 @@
 my $ecframe;
 my $elframe;
 my $erbclear;
+&globalPos();
 my $x = $Global{'horz'} + 75;
 my $y = $Global{'vert'} + 75;
 #
@@ -3456,6 +3548,7 @@
 
 sub displayDnList
 {
+&globalPos();
 my $x = $Global{'horz'};
 my $y = $Global{'vert'}  + 230 ;
 
@@ -4017,6 +4110,7 @@
 sub rootDse
 {
 my $base;
+&globalPos();
 my $x = $Global{'horz'} + 150;
 my $y = $Global{'vert'} + 150;
 my $error;
@@ -4114,6 +4208,19 @@
 }
 
 $ldap->unbind;
+
+}
+
+#
+# Determine new mainWindow position.
+#
+sub globalPos 
+{
+
+my @pos;
+@pos = split(/\+/,$Global{'mainWindow'}->geometry());
+$Global{'horz'} = $pos[1];
+$Global{'vert'} = $pos[2];
 
 }