A3C/bin/ldap2model.pl

#!/usr/bin/perl
use warnings;
use strict;

=head1 NAME

schema2model.pl - convert LDAP schema file into jifty model

=head1 DESCRIPTION

Create model from ldif data

  ./bin/ldap2model.pl --model hrEduOrg --path data/all.ldif

or directly from LDAP server

  ./bin/ldap2model.pl --model inetOrgPerson
  ./bin/ldap2model.pl --model organization

which must match C<LDAP.objectClass> in C<etc/conf.yml>

With C<--debug> switch all output will go to C<STDOUT>
instead to files.

=cut

use lib 'lib';

use Jifty;
use A3C::LDAP;
use Net::LDAP::Schema;
use File::Slurp;
use Data::Dump qw/dump/;
use Getopt::Long;

my ( $path, $objectClass, $debug );

GetOptions(
        'model|objectClass=s', => \$objectClass,
        'path=s', => \$path,
        'debug+', => \$debug,
);

die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;

my $schema;
if ( $path ) {
        $schema = Net::LDAP::Schema->new;
        $schema->parse ( $path ) or die $schema->error;
        warn "# loaded schema from $path\n";
} else {
        my $l = A3C::LDAP->new;
        $schema = $l->ldap->schema;
}

die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );

my $model = qq/package A3C::Model::$objectClass;
use strict;
use warnings;

use Jifty::DBI::Schema;

use A3C::Record schema {

/;

my $methods;
my $create;
my $columns;

sub entry {
        my ( $e, $add ) = @_;
        my $name = $_->{name} || die "no name?";
        $methods .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};
        my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;
        $out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
        $out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
        $out .= qq/,\n\t\t$add/ if $add;
        $out .= qq/;\n\n/;
        $columns->{$name}++;
        return $out;
}

$model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);

$model .= qq/\t# $objectClass must:\n\n/;


map {
        warn "# $objectClass must: ",dump( $_ ) if $debug;
        $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 );

$methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};

$model .= qq/

};

$methods

use A3C::DefaultACL;

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;

=head1 DESCRIPTION

A basic test harness for the _objectClass_ model.

=cut

use Jifty::Test tests => 11;

# Make sure we can load the model
use_ok('A3C::Model::_objectClass_');

# Grab a system user
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;
}

if ( $debug ) {
        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;
}
1	dpavlin	98	#!/usr/bin/perl
2			use warnings;
3			use strict;
4
5	dpavlin	105	=head1 NAME
6	dpavlin	98
7	dpavlin	105	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	dpavlin	103	use lib 'lib';
28
29			use Jifty;
30			use A3C::LDAP;
31	dpavlin	98	use Net::LDAP::Schema;
32	dpavlin	99	use File::Slurp;
33	dpavlin	98	use Data::Dump qw/dump/;
34	dpavlin	103	use Getopt::Long;
35	dpavlin	98
36	dpavlin	105	my ( $path, $objectClass, $debug );
37	dpavlin	98
38	dpavlin	103	GetOptions(
39			'model\|objectClass=s', => \$objectClass,
40			'path=s', => \$path,
41	dpavlin	105	'debug+', => \$debug,
42	dpavlin	103	);
43	dpavlin	98
44	dpavlin	103	die "usage: $0 --model netOrgPerson [--path path/to/schema.ldif]\n" unless $objectClass;
45	dpavlin	98
46	dpavlin	103	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	dpavlin	99	die "$objectClass objectClass not found in $path\n" unless $schema->objectclass( $objectClass );
57
58			my $model = qq/package A3C::Model::$objectClass;
59			use strict;
60			use warnings;
61
62			use Jifty::DBI::Schema;
63
64			use A3C::Record schema {
65
66			/;
67
68			my $methods;
69	dpavlin	102	my $create;
70			my $columns;
71	dpavlin	99
72	dpavlin	98	sub entry {
73			my ( $e, $add ) = @_;
74	dpavlin	99	my $name = $_->{name} \|\| die "no name?";
75			$methods .= qq/sub $_ { \$_[0]->$name }\n/ foreach @{$_->{aliases}};
76			my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$_->{desc}')/;
77	dpavlin	98	$out .= qq/,\n\t\t# single-value/ if $_->{'single-value'};
78			$out .= qq/,\n\t\tmax_length is $_->{max_length}/ if $_->{'max_length'};
79			$out .= qq/,\n\t\t$add/ if $add;
80			$out .= qq/;\n\n/;
81	dpavlin	102	$columns->{$name}++;
82	dpavlin	98	return $out;
83			}
84
85	dpavlin	99	$model .= qq/\t# $objectClass super: / . join(' ', $schema->superclass($objectClass)). qq/\n\n/ if $schema->superclass($objectClass);
86	dpavlin	98
87			$model .= qq/\t# $objectClass must:\n\n/;
88
89	dpavlin	102
90	dpavlin	98	map {
91	dpavlin	105	warn "# $objectClass must: ",dump( $_ ) if $debug;
92	dpavlin	98	$model .= entry( $_, 'is mandatory' );
93	dpavlin	102	$create->{$_->{name}} = $_->{name};
94	dpavlin	98	} $schema->must( $objectClass );
95
96			$model .= qq/\t# $objectClass may:\n\n/;
97
98			map {
99	dpavlin	105	warn "# $objectClass may: ",dump( $_ ) if $debug;
100	dpavlin	98	$model .= entry( $_ );
101			} $schema->may( $objectClass );
102
103	dpavlin	102	$methods .= qq/sub name { \$_[0]->id }\n/ unless $columns->{name};
104
105	dpavlin	99	$model .= qq/
106
107			};
108
109			$methods
110
111			use A3C::DefaultACL;
112
113			1;
114			/;
115
116	dpavlin	105	if ( $debug ) {
117			print "##### ----- created model test\n$model\n";
118			} else {
119			my $model_path = "lib/A3C/Model/$objectClass.pm";
120			write_file( $model_path, $model );
121			print "Created $model_path\n";
122			}
123	dpavlin	102
124			my $test = <<'__END_OF_TEST__';
125			#!/usr/bin/env perl
126			use warnings;
127			use strict;
128
129			=head1 DESCRIPTION
130
131			A basic test harness for the _objectClass_ model.
132
133			=cut
134
135			use Jifty::Test tests => 11;
136
137			# Make sure we can load the model
138			use_ok('A3C::Model::_objectClass_');
139
140			# Grab a system user
141			my $system_user = A3C::CurrentUser->superuser;
142			ok($system_user, "Found a system user");
143
144			# Try testing a create
145			my $o = A3C::Model::_objectClass_->new(current_user => $system_user);
146			my ($id) = $o->create(
147			_create_1_);
148			ok($id, "_objectClass_ create returned success");
149			ok($o->id, "New _objectClass_ has valid id set");
150			is($o->id, $id, "Create returned the right id");
151
152			# And another
153			$o->create(
154			_create_2_);
155			ok($o->id, "_objectClass_ create returned another value");
156			isnt($o->id, $id, "And it is different from the previous one");
157
158			# Searches in general
159			my $collection = A3C::Model::_objectClass_Collection->new(current_user => $system_user);
160			$collection->unlimit;
161			is($collection->count, 2, "Finds two records");
162
163			# Searches in specific
164			$collection->limit(column => 'id', value => $o->id);
165			is($collection->count, 1, "Finds one record with specific id");
166
167			# Delete one of them
168			$o->delete;
169			$collection->redo_search;
170			is($collection->count, 0, "Deleted row is gone");
171
172			# And the other one is still there
173			$collection->unlimit;
174			is($collection->count, 1, "Still one left");
175			__END_OF_TEST__
176
177			$test =~ s/_objectClass_/$objectClass/gs;
178
179			foreach my $round ( 1 .. 2 ) {
180			my $data;
181			$data .= qq/\t\t'$_' => '$_ $round',\n/ foreach keys %$create;
182	dpavlin	105	warn "$round data = $data\n" if $debug;
183	dpavlin	102	$test =~ s/_create_${round}_/$data/gs;
184			}
185
186	dpavlin	105	if ( $debug ) {
187			print "##### ----- template test\n$test\n";
188			} else {
189			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			}