/[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 103 by dpavlin, Thu May 1 14:30:06 2008 UTC revision 108 by dpavlin, Fri May 2 14:38:45 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
6  #  
7  # 04/30/08 20:55:21 CEST Dobrica Pavlinusic <dpavlin@rot13.org>  schema2model.pl - convert LDAP schema file into jifty model
8  #  
9  # ./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif  =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';  use lib 'lib';
28    
# Line 17  use File::Slurp; Line 33  use File::Slurp;
33  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
34  use Getopt::Long;  use Getopt::Long;
35    
36  my ( $path, $objectClass );  my ( $path, $objectClass, $debug );
37    
38  GetOptions(  GetOptions(
39          'model|objectClass=s', => \$objectClass,          'model|objectClass=s', => \$objectClass,
40          'path=s', => \$path,          'path=s', => \$path,
41            'debug+', => \$debug,
42  );  );
43    
44  die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;  die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;
# Line 57  sub entry { Line 74  sub entry {
74          my $name = $_->{name} || die "no name?";          my $name = $_->{name} || die "no name?";
75          $methods .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};          $methods .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};
76          my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;          my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;
77          $out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};  #       $out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
78    #       $out .= qq/,\n\t\tfilters are qw(A3C::Filter::Array)/ unless $_->{'single-value'};
79          $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};          $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
80          $out .= qq/,\n\t\t$add/ if $add;          $out .= qq/,\n\t\t$add/ if $add;
81          $out .= qq/;\n\n/;          $out .= qq/;\n\n/;
# Line 71  $model .= qq/\t# $objectClass must:\n\n/ Line 89  $model .= qq/\t# $objectClass must:\n\n/
89    
90    
91  map {  map {
92          warn "# $objectClass must: ",dump( $_ );          warn "# $objectClass must: ",dump( $_ ) if $debug;
93          $model .= entry( $_, 'is mandatory' );          $model .= entry( $_, 'is mandatory' );
94          $create->{$_->{name}} = $_->{name};          $create->{$_->{name}} = $_->{'single-value'} ? $_->{name} : [ $_->{name}, $_->{desc} ];
95  } $schema->must( $objectClass );  } $schema->must( $objectClass );
96    
97  $model .= qq/\t# $objectClass may:\n\n/;  $model .= qq/\t# $objectClass may:\n\n/;
98    
99  map {  map {
100          warn "# $objectClass may: ",dump( $_ );          warn "# $objectClass may: ",dump( $_ ) if $debug;
101          $model .= entry( $_ );          $model .= entry( $_ );
102  } $schema->may( $objectClass );  } $schema->may( $objectClass );
103    
# Line 96  use A3C::DefaultACL; Line 114  use A3C::DefaultACL;
114  1;  1;
115  /;  /;
116    
117  my $model_path = "lib/A3C/Model/$objectClass.pm";  if ( $debug ) {
118  write_file( $model_path, $model );          print "##### ----- created model test\n$model\n";
119  warn "Created $model_path\n";  } else {
120            my $model_path = "lib/A3C/Model/$objectClass.pm";
121            write_file( $model_path, $model );
122            print "Created $model_path\n";
123    }
124    
125  my $test = <<'__END_OF_TEST__';  my $test = <<'__END_OF_TEST__';
126  #!/usr/bin/env perl  #!/usr/bin/env perl
# Line 157  $test =~ s/_objectClass_/$objectClass/gs Line 179  $test =~ s/_objectClass_/$objectClass/gs
179    
180  foreach my $round ( 1 .. 2 ) {  foreach my $round ( 1 .. 2 ) {
181          my $data;          my $data;
182          $data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create;          $data .= qq/\t\t'$_' => / . dump( $create->{$_} ) . qq/,\n/ foreach keys %$create;
183          warn "data = $data\n";          warn "$round data = $data\n" if $debug;
184          $test =~ s/_create_${round}_/$data/gs;          $test =~ s/_create_${round}_/$data/gs;
185  }  }
186    
187  my $test_path = "t/00-model-$objectClass.t";  if ( $debug ) {
188  write_file( $test_path, $test );          print "##### ----- template test\n$test\n";
189  warn "Created $test_path\n";  } else {
190  chmod 0755, $test_path;          my $test_path = "t/00-model-$objectClass.t";
191            write_file( $test_path, $test );
192            print "Created $test_path\n";
193            chmod 0755, $test_path;
194    }

Legend:
Removed from v.103  
changed lines
  Added in v.108

  ViewVC Help
Powered by ViewVC 1.1.26