/[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 99 by dpavlin, Wed Apr 30 23:44:43 2008 UTC revision 103 by dpavlin, Thu May 1 14:30:06 2008 UTC
# Line 6  use strict; Line 6  use strict;
6  #  #
7  # 04/30/08 20:55:21 CEST Dobrica Pavlinusic <dpavlin@rot13.org>  # 04/30/08 20:55:21 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
8  #  #
9  # ./bin/ldap2model.pl data/all.ldif hrEduOrg  # ./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif
10    
11    use lib 'lib';
12    
13    use Jifty;
14    use A3C::LDAP;
15  use Net::LDAP::Schema;  use Net::LDAP::Schema;
16  use File::Slurp;  use File::Slurp;
17  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
18    use Getopt::Long;
19    
20  my ( $path, $objectClass ) = @ARGV;  my ( $path, $objectClass );
   
 die "usage: $0 path/to/schema.ldif inetOrgPerson\n" unless $path && $objectClass;  
21    
22  my $schema = Net::LDAP::Schema->new;  GetOptions(
23  $schema->parse ( $path ) or die $schema->error;          'model|objectClass=s', => \$objectClass,
24            'path=s', => \$path,
25    );
26    
27    die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;
28    
29    my $schema;
30    if ( $path ) {
31            $schema = Net::LDAP::Schema->new;
32            $schema->parse ( $path ) or die $schema->error;
33            warn "# loaded schema from $path\n";
34    } else {
35            my $l = A3C::LDAP->new;
36            $schema = $l->ldap->schema;
37    }
38    
39  die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );  die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );
40    
# Line 32  use A3C::Record schema { Line 49  use A3C::Record schema {
49  /;  /;
50    
51  my $methods;  my $methods;
52    my $create;
53    my $columns;
54    
55  sub entry {  sub entry {
56          my ( $e, $add ) = @_;          my ( $e, $add ) = @_;
# Line 42  sub entry { Line 61  sub entry {
61          $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};          $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
62          $out .= qq/,\n\t\t$add/ if $add;          $out .= qq/,\n\t\t$add/ if $add;
63          $out .= qq/;\n\n/;          $out .= qq/;\n\n/;
64            $columns->{$name}++;
65          return $out;          return $out;
66  }  }
67    
# Line 49  $model .= qq/\t# $objectClass super: / . Line 69  $model .= qq/\t# $objectClass super: / .
69    
70  $model .= qq/\t# $objectClass must:\n\n/;  $model .= qq/\t# $objectClass must:\n\n/;
71    
72    
73  map {  map {
74          warn "# $objectClass must: ",dump( $_ );          warn "# $objectClass must: ",dump( $_ );
75          $model .= entry( $_, 'is mandatory' );          $model .= entry( $_, 'is mandatory' );
76            $create->{$_->{name}} = $_->{name};
77  } $schema->must( $objectClass );  } $schema->must( $objectClass );
78    
79  $model .= qq/\t# $objectClass may:\n\n/;  $model .= qq/\t# $objectClass may:\n\n/;
# Line 61  map { Line 83  map {
83          $model .= entry( $_ );          $model .= entry( $_ );
84  } $schema->may( $objectClass );  } $schema->may( $objectClass );
85    
86    $methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};
87    
88  $model .= qq/  $model .= qq/
89    
90  };  };
# Line 75  use A3C::DefaultACL; Line 99  use A3C::DefaultACL;
99  my $model_path = "lib/A3C/Model/$objectClass.pm";  my $model_path = "lib/A3C/Model/$objectClass.pm";
100  write_file( $model_path, $model );  write_file( $model_path, $model );
101  warn "Created $model_path\n";  warn "Created $model_path\n";
102    
103    my $test = <<'__END_OF_TEST__';
104    #!/usr/bin/env perl
105    use warnings;
106    use strict;
107    
108    =head1 DESCRIPTION
109    
110    A basic test harness for the _objectClass_ model.
111    
112    =cut
113    
114    use Jifty::Test tests => 11;
115    
116    # Make sure we can load the model
117    use_ok('A3C::Model::_objectClass_');
118    
119    # Grab a system user
120    my $system_user = A3C::CurrentUser->superuser;
121    ok($system_user, "Found a system user");
122    
123    # Try testing a create
124    my $o = A3C::Model::_objectClass_->new(current_user => $system_user);
125    my ($id) = $o->create(
126    _create_1_);
127    ok($id, "_objectClass_ create returned success");
128    ok($o->id, "New _objectClass_ has valid id set");
129    is($o->id, $id, "Create returned the right id");
130    
131    # And another
132    $o->create(
133    _create_2_);
134    ok($o->id, "_objectClass_ create returned another value");
135    isnt($o->id, $id, "And it is different from the previous one");
136    
137    # Searches in general
138    my $collection =  A3C::Model::_objectClass_Collection->new(current_user => $system_user);
139    $collection->unlimit;
140    is($collection->count, 2, "Finds two records");
141    
142    # Searches in specific
143    $collection->limit(column => 'id', value => $o->id);
144    is($collection->count, 1, "Finds one record with specific id");
145    
146    # Delete one of them
147    $o->delete;
148    $collection->redo_search;
149    is($collection->count, 0, "Deleted row is gone");
150    
151    # And the other one is still there
152    $collection->unlimit;
153    is($collection->count, 1, "Still one left");
154    __END_OF_TEST__
155    
156    $test =~ s/_objectClass_/$objectClass/gs;
157    
158    foreach my $round ( 1 .. 2 ) {
159            my $data;
160            $data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create;
161            warn "data = $data\n";
162            $test =~ s/_create_${round}_/$data/gs;
163    }
164    
165    my $test_path = "t/00-model-$objectClass.t";
166    write_file( $test_path, $test );
167    warn "Created $test_path\n";
168    chmod 0755, $test_path;

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

  ViewVC Help
Powered by ViewVC 1.1.26