package LATMOS::Accounts::Bases::OCHelper; # $Id: OCHelper.pm 2932 2010-08-10 17:19:21Z nanardon $ use strict; use warnings; =head1 NAME LATMOS::Accounts::Bases::OCHelper - Object creation helper =head1 DESCRIPTION This module is designed to be subclassed. =head1 FUNCTIONS =cut =head2 new($base, $otype) =cut sub new { my ($class, $base, $otype) = @_; bless { _base => $base, _otype => $otype, }, $class; } =head2 $ochelper->base Return base object =cut sub base { $_[0]->{_base} } =head2 $ochelper->otype Return object type for this OChelper. =cut sub otype { $_[0]->{_otype} } =head2 $ochelper->step($info) Process next step by submitting C<$info> and return the status and new information to continue process. C<$info> must look like: info = { step => 0, name => { # name of object ask => 0/1, content => ... }, ask => [ list ], contents => { name => ... } } STATUS will be one of 'NEEDINFO', 'CREATED', 'ERROR', undef. =cut sub step { my ($self, $info) = @_; my $otype = $self->otype; $info ||= {}; $info->{step} ||= 0; $info->{ask} = []; push(@{ $info->{ask} }, 'template') unless ( $otype eq 'templates' ); $info->{name}{ask} = 0; foreach (keys %{ $self->base->{defattr} || {} }) { /^$otype\.(.*)/ or next; my $attr = $1; my $oattr = $self->base->attribute($otype, $attr) or next; $oattr->ro and next; $info->{contents}{$attr} = $self->base->{defattr}{$_} unless exists($info->{contents}{$attr}); } return($self->_step($info), $info); } # just return status, $info is reference sub _step { my ($self, $info) = @_; if ($info->{step} == 0) { $info->{name}{ask} = 1; foreach ($self->base->list_canonical_fields($self->otype, 'w')) { /^oalias$/ and next; /^template$/ and next; push(@{$info->{ask}}, $_); } $info->{step} = 1; return 'NEEDINFO'; } elsif ($info->{step} == 1) { if ($self->base->create_c_object($self->otype, $info->{name}{content}, %{$info->{contents} || {}}, )) { return 'CREATED'; } else { return 'ERROR'; } } else { return undef; } } =head2 $ochelper->Automate($info) Try to create object from C<$info> w/o interacting with user. If given infomation does not allow to create object, it failed. Return 1 on success. =cut sub Automate { my ($self, $info) = @_; for (my $count = 0; $count < 3; $count++) { my $status; ($status, $info) = $self->step($info); if ($status eq 'CREATED') { return $info->{name}{content}; } elsif ($status eq 'ERROR') { return; } } } 1; __END__ =head1 SEE ALSO L, L =head1 AUTHOR Olivier Thauvin, Eolivier.thauvin@latmos.ipsl.frE =head1 COPYRIGHT AND LICENSE Copyright (C) 2012 CNRS SA/CETP/LATMOS This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.0 or, at your option, any later version of Perl 5 you may have available. =cut