/[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 101 by dpavlin, Wed Apr 30 23:44:43 2008 UTC revision 102 by dpavlin, Thu May 1 13:41:44 2008 UTC
# Line 32  use A3C::Record schema { Line 32  use A3C::Record schema {
32  /;  /;
33    
34  my $methods;  my $methods;
35    my $create;
36    my $columns;
37    
38  sub entry {  sub entry {
39          my ( $e, $add ) = @_;          my ( $e, $add ) = @_;
# Line 42  sub entry { Line 44  sub entry {
44          $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};          $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
45          $out .= qq/,\n\t\t$add/ if $add;          $out .= qq/,\n\t\t$add/ if $add;
46          $out .= qq/;\n\n/;          $out .= qq/;\n\n/;
47            $columns->{$name}++;
48          return $out;          return $out;
49  }  }
50    
# Line 49  $model .= qq/\t# $objectClass super: / . Line 52  $model .= qq/\t# $objectClass super: / .
52    
53  $model .= qq/\t# $objectClass must:\n\n/;  $model .= qq/\t# $objectClass must:\n\n/;
54    
55    
56  map {  map {
57          warn "# $objectClass must: ",dump( $_ );          warn "# $objectClass must: ",dump( $_ );
58          $model .= entry( $_, 'is mandatory' );          $model .= entry( $_, 'is mandatory' );
59            $create->{$_->{name}} = $_->{name};
60  } $schema->must( $objectClass );  } $schema->must( $objectClass );
61    
62  $model .= qq/\t# $objectClass may:\n\n/;  $model .= qq/\t# $objectClass may:\n\n/;
# Line 61  map { Line 66  map {
66          $model .= entry( $_ );          $model .= entry( $_ );
67  } $schema->may( $objectClass );  } $schema->may( $objectClass );
68    
69    $methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};
70    
71  $model .= qq/  $model .= qq/
72    
73  };  };
# Line 75  use A3C::DefaultACL; Line 82  use A3C::DefaultACL;
82  my $model_path = "lib/A3C/Model/$objectClass.pm";  my $model_path = "lib/A3C/Model/$objectClass.pm";
83  write_file( $model_path, $model );  write_file( $model_path, $model );
84  warn "Created $model_path\n";  warn "Created $model_path\n";
85    
86    my $test = <<'__END_OF_TEST__';
87    #!/usr/bin/env perl
88    use warnings;
89    use strict;
90    
91    =head1 DESCRIPTION
92    
93    A basic test harness for the _objectClass_ model.
94    
95    =cut
96    
97    use Jifty::Test tests => 11;
98    
99    # Make sure we can load the model
100    use_ok('A3C::Model::_objectClass_');
101    
102    # Grab a system user
103    my $system_user = A3C::CurrentUser->superuser;
104    ok($system_user, "Found a system user");
105    
106    # Try testing a create
107    my $o = A3C::Model::_objectClass_->new(current_user => $system_user);
108    my ($id) = $o->create(
109    _create_1_);
110    ok($id, "_objectClass_ create returned success");
111    ok($o->id, "New _objectClass_ has valid id set");
112    is($o->id, $id, "Create returned the right id");
113    
114    # And another
115    $o->create(
116    _create_2_);
117    ok($o->id, "_objectClass_ create returned another value");
118    isnt($o->id, $id, "And it is different from the previous one");
119    
120    # Searches in general
121    my $collection =  A3C::Model::_objectClass_Collection->new(current_user => $system_user);
122    $collection->unlimit;
123    is($collection->count, 2, "Finds two records");
124    
125    # Searches in specific
126    $collection->limit(column => 'id', value => $o->id);
127    is($collection->count, 1, "Finds one record with specific id");
128    
129    # Delete one of them
130    $o->delete;
131    $collection->redo_search;
132    is($collection->count, 0, "Deleted row is gone");
133    
134    # And the other one is still there
135    $collection->unlimit;
136    is($collection->count, 1, "Still one left");
137    __END_OF_TEST__
138    
139    $test =~ s/_objectClass_/$objectClass/gs;
140    
141    foreach my $round ( 1 .. 2 ) {
142            my $data;
143            $data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create;
144            warn "data = $data\n";
145            $test =~ s/_create_${round}_/$data/gs;
146    }
147    
148    my $test_path = "t/00-model-$objectClass.t";
149    write_file( $test_path, $test );
150    warn "Created $test_path\n";
151    chmod 0755, $test_path;
Legend:
Removed from v.101  
changed lines
  Added in v.102
  ViewVC Help
Powered by ViewVC 1.1.26