/[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 105 by dpavlin, Thu May 1 16:31:00 2008 UTC revision 181 by dpavlin, Mon Jun 16 20:08:28 2008 UTC
# Line 4  use strict; Line 4  use strict;
4    
5  =head1 NAME  =head1 NAME
6    
7  schema2model.pl - convert LDAP schema file into jifty model  ldap2model.pl - convert LDAP schema file into Jifty model
8    
9  =head1 DESCRIPTION  =head1 DESCRIPTION
10    
# Line 22  which must match C<LDAP.objectClass> in Line 22  which must match C<LDAP.objectClass> in
22  With C<--debug> switch all output will go to C<STDOUT>  With C<--debug> switch all output will go to C<STDOUT>
23  instead to files.  instead to files.
24    
25    If your schema for model doesn't include some objectClasses
26    and you want to mixin them manually, use something like:
27    
28      ./bin/ldap2model.pl --model hrEduOrg --mixin dcObject --mixin posixAccount
29    
30  =cut  =cut
31    
32  use lib 'lib';  use lib 'lib';
33    
34  use Jifty;  use JiftyModelCreator;
35  use A3C::LDAP;  use A3C::LDAP;
36  use Net::LDAP::Schema;  use Net::LDAP::Schema;
37  use File::Slurp;  use File::Slurp;
# Line 34  use Data::Dump qw/dump/; Line 39  use Data::Dump qw/dump/;
39  use Getopt::Long;  use Getopt::Long;
40    
41  my ( $path, $objectClass, $debug );  my ( $path, $objectClass, $debug );
42    my @mixin;
43    
44  GetOptions(  GetOptions(
45          'model|objectClass=s', => \$objectClass,          'model|objectClass=s', => \$objectClass,
46            'mixin=s', => \@mixin,
47          'path=s', => \$path,          'path=s', => \$path,
48          'debug+', => \$debug,          'debug+', => \$debug,
49  );  );
# Line 69  my $methods; Line 76  my $methods;
76  my $create;  my $create;
77  my $columns;  my $columns;
78    
79  sub entry {  sub model_columns {
80          my ( $e, $add ) = @_;          my $objectClass = shift;
81          my $name = $_->{name} || die "no name?";          my $model;
82          $methods .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};          warn "Creating columns for model $objectClass\n";
83          my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;  
84          $out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};          my $aliases = qq/\n=head1 $objectClass helper methods\n=cut\n\n/;
85          $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};  
86          $out .= qq/,\n\t\t$add/ if $add;          sub entry {
87          $out .= qq/;\n\n/;                  my ( $e, $add ) = @_;
88          $columns->{$name}++;                  my $name = $_->{name} || die "no name?";
89          return $out;                  if ( $columns->{$name} ) {
90  }                          warn "WARNING: column $name found again, skipping...\n";
91                            return '';
92  $model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);                  }
93                    $aliases .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};
94                    my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;
95    #               $out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
96    #               $out .= qq/,\n\t\tfilters are qw(A3C::Filter::Array)/ unless $_->{'single-value'};
97                    $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
98                    $out .= qq/,\n\t\t$add/ if $add;
99                    $out .= qq/;\n\n/;
100                    $columns->{$name}++;
101                    return $out;
102            }
103    
104            $model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);
105    
106            my $must;
107            map {
108                    warn "# $objectClass must: ",dump( $_ ),$/ if $debug;
109                    $must .= entry( $_, 'is mandatory' );
110                    $create->{$_->{name}} = $_->{'single-value'} ? $_->{name} : [ $_->{name}, $_->{desc} ];
111            } $schema->must( $objectClass );
112            $model .= qq/\t# $objectClass must:\n\n$must\n/ if $must;
113    
114            my $may;
115            map {
116                    warn "# $objectClass may: ",dump( $_ ),$/ if $debug;
117                    $may .= entry( $_ );
118            } $schema->may( $objectClass );
119            $model .= qq/\t# $objectClass may:\n\n$may\n/ if $may;
120    
121  $model .= qq/\t# $objectClass must:\n\n/;          $methods .= $aliases unless $aliases;
122    
123            return $model;
124    }
125    
126  map {  $model .= model_columns( $objectClass );
127          warn "# $objectClass must: ",dump( $_ ) if $debug;  $model .= model_columns( $_ ) foreach @mixin;
         $model .= entry( $_, 'is mandatory' );  
         $create->{$_->{name}} = $_->{name};  
 } $schema->must( $objectClass );  
   
 $model .= qq/\t# $objectClass may:\n\n/;  
   
 map {  
         warn "# $objectClass may: ",dump( $_ ) if $debug;  
         $model .= entry( $_ );  
 } $schema->may( $objectClass );  
128    
129  $methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};  $methods .= qq/\n=head2 name\n\nAuto-generated human readable id for generic access to name\n\n=cut\n\nsub name { \$_[0]->id }\n/ unless $columns->{name};
130    
131  $model .= qq/  $model .= qq/
132    
# Line 108  $model .= qq/ Line 134  $model .= qq/
134    
135  $methods  $methods
136    
137  use A3C::DefaultACL;  =head2 ACL
   
 1;  
 /;  
   
 if ( $debug ) {  
         print "##### ----- created model test\n$model\n";  
 } else {  
         my $model_path = "lib/A3C/Model/$objectClass.pm";  
         write_file( $model_path, $model );  
         print "Created $model_path\n";  
 }  
   
 my $test = <<'__END_OF_TEST__';  
 #!/usr/bin/env perl  
 use warnings;  
 use strict;  
138    
139  =head1 DESCRIPTION  We use L<A3C::DefaultACL> for access control
   
 A basic test harness for the _objectClass_ model.  
140    
141  =cut  =cut
142    
143  use Jifty::Test tests => 11;  use A3C::DefaultACL;
   
 # Make sure we can load the model  
 use_ok('A3C::Model::_objectClass_');  
144    
145  # Grab a system user  1;
146  my $system_user = A3C::CurrentUser->superuser;  /;
 ok($system_user, "Found a system user");  
   
 # Try testing a create  
 my $o = A3C::Model::_objectClass_->new(current_user => $system_user);  
 my ($id) = $o->create(  
 _create_1_);  
 ok($id, "_objectClass_ create returned success");  
 ok($o->id, "New _objectClass_ has valid id set");  
 is($o->id, $id, "Create returned the right id");  
   
 # And another  
 $o->create(  
 _create_2_);  
 ok($o->id, "_objectClass_ create returned another value");  
 isnt($o->id, $id, "And it is different from the previous one");  
   
 # Searches in general  
 my $collection =  A3C::Model::_objectClass_Collection->new(current_user => $system_user);  
 $collection->unlimit;  
 is($collection->count, 2, "Finds two records");  
   
 # Searches in specific  
 $collection->limit(column => 'id', value => $o->id);  
 is($collection->count, 1, "Finds one record with specific id");  
   
 # Delete one of them  
 $o->delete;  
 $collection->redo_search;  
 is($collection->count, 0, "Deleted row is gone");  
   
 # And the other one is still there  
 $collection->unlimit;  
 is($collection->count, 1, "Still one left");  
 __END_OF_TEST__  
   
 $test =~ s/_objectClass_/$objectClass/gs;  
   
 foreach my $round ( 1 .. 2 ) {  
         my $data;  
         $data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create;  
         warn "$round data = $data\n" if $debug;  
         $test =~ s/_create_${round}_/$data/gs;  
 }  
147    
148  if ( $debug ) {  JiftyModelCreator->write( $objectClass, $model, $create );
         print "##### ----- template test\n$test\n";  
 } else {  
         my $test_path = "t/00-model-$objectClass.t";  
         write_file( $test_path, $test );  
         print "Created $test_path\n";  
         chmod 0755, $test_path;  
 }  
Legend:
Removed from v.105  
changed lines
  Added in v.181
  ViewVC Help
Powered by ViewVC 1.1.26