/[A3C]/bin/ldap2model.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /bin/ldap2model.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 102 by dpavlin, Thu May 1 13:41:44 2008 UTC revision 105 by dpavlin, Thu May 1 16:31:00 2008 UTC
# Line 2  Line 2 
2  use warnings;  use warnings;
3  use strict;  use strict;
4    
5  # schema2model.pl - convert LDAP schema file into jifty model  =head1 NAME
 #  
 # 04/30/08 20:55:21 CEST Dobrica Pavlinusic <dpavlin@rot13.org>  
 #  
 # ./bin/ldap2model.pl data/all.ldif hrEduOrg  
6    
7    schema2model.pl - convert LDAP schema file into jifty model
8    
9    =head1 DESCRIPTION
10    
11    Create model from ldif data
12    
13      ./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif
14    
15    or directly from LDAP server
16    
17      ./bin/ldap2model.pl --model inetOrgPerson
18      ./bin/ldap2model.pl --model organization
19    
20    which must match C<LDAP.objectClass> in C<etc/conf.yml>
21    
22    With C<--debug> switch all output will go to C<STDOUT>
23    instead to files.
24    
25    =cut
26    
27    use lib 'lib';
28    
29    use Jifty;
30    use A3C::LDAP;
31  use Net::LDAP::Schema;  use Net::LDAP::Schema;
32  use File::Slurp;  use File::Slurp;
33  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
34    use Getopt::Long;
35    
36  my ( $path, $objectClass ) = @ARGV;  my ( $path, $objectClass, $debug );
37    
38  die "usage: $0 path/to/schema.ldif inetOrgPerson\n" unless $path && $objectClass;  GetOptions(
39            'model|objectClass=s', => \$objectClass,
40  my $schema = Net::LDAP::Schema->new;          'path=s', => \$path,
41  $schema->parse ( $path ) or die $schema->error;          'debug+', => \$debug,
42    );
43    
44    die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;
45    
46    my $schema;
47    if ( $path ) {
48            $schema = Net::LDAP::Schema->new;
49            $schema->parse ( $path ) or die $schema->error;
50            warn "# loaded schema from $path\n";
51    } else {
52            my $l = A3C::LDAP->new;
53            $schema = $l->ldap->schema;
54    }
55    
56  die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );  die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );
57    
# Line 54  $model .= qq/\t# $objectClass must:\n\n/ Line 88  $model .= qq/\t# $objectClass must:\n\n/
88    
89    
90  map {  map {
91          warn "# $objectClass must: ",dump( $_ );          warn "# $objectClass must: ",dump( $_ ) if $debug;
92          $model .= entry( $_, 'is mandatory' );          $model .= entry( $_, 'is mandatory' );
93          $create->{$_->{name}} = $_->{name};          $create->{$_->{name}} = $_->{name};
94  } $schema->must( $objectClass );  } $schema->must( $objectClass );
# Line 62  map { Line 96  map {
96  $model .= qq/\t# $objectClass may:\n\n/;  $model .= qq/\t# $objectClass may:\n\n/;
97    
98  map {  map {
99          warn "# $objectClass may: ",dump( $_ );          warn "# $objectClass may: ",dump( $_ ) if $debug;
100          $model .= entry( $_ );          $model .= entry( $_ );
101  } $schema->may( $objectClass );  } $schema->may( $objectClass );
102    
# Line 79  use A3C::DefaultACL; Line 113  use A3C::DefaultACL;
113  1;  1;
114  /;  /;
115    
116  my $model_path = "lib/A3C/Model/$objectClass.pm";  if ( $debug ) {
117  write_file( $model_path, $model );          print "##### ----- created model test\n$model\n";
118  warn "Created $model_path\n";  } else {
119            my $model_path = "lib/A3C/Model/$objectClass.pm";
120            write_file( $model_path, $model );
121            print "Created $model_path\n";
122    }
123    
124  my $test = <<'__END_OF_TEST__';  my $test = <<'__END_OF_TEST__';
125  #!/usr/bin/env perl  #!/usr/bin/env perl
# Line 141  $test =~ s/_objectClass_/$objectClass/gs Line 179  $test =~ s/_objectClass_/$objectClass/gs
179  foreach my $round ( 1 .. 2 ) {  foreach my $round ( 1 .. 2 ) {
180          my $data;          my $data;
181          $data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create;          $data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create;
182          warn "data = $data\n";          warn "$round data = $data\n" if $debug;
183          $test =~ s/_create_${round}_/$data/gs;          $test =~ s/_create_${round}_/$data/gs;
184  }  }
185    
186  my $test_path = "t/00-model-$objectClass.t";  if ( $debug ) {
187  write_file( $test_path, $test );          print "##### ----- template test\n$test\n";
188  warn "Created $test_path\n";  } else {
189  chmod 0755, $test_path;          my $test_path = "t/00-model-$objectClass.t";
190            write_file( $test_path, $test );
191            print "Created $test_path\n";
192            chmod 0755, $test_path;
193    }
Legend:
Removed from v.102  
changed lines
  Added in v.105
  ViewVC Help
Powered by ViewVC 1.1.26