package  XML::RelaxNG::Compact::PXB;

use strict;
use warnings;
use English qw( -no_match_vars);
use version; our $VERSION = '0.10';


=head1 NAME

XML::RelaxNG::Compact::PXB  -   create perl XML (RelaxNG Compact) data binding API

=head1 VERSION

Version 0.10

=head1 DESCRIPTION


The instance of this class is capable of generating the API tree of the perl objects
based on  XML (RelaxNG compact) schema described  as perl data structures. If you have bunch
of XML schemes ( and able to convert them into RelaxNG Compact ) and hate to waste your time
by writing DOM tree walking code then this module may help you. Of course POD will be created automatically as well.
Also, it will build the tests suit automatically as well and provide perltidy and perlcritic 
config files for you to assure the absence of problems in your API. The L<Perl::Critic> test will
be performed as part of the tests suit.

See L<XML::RelaxNG::Compact::DataModel> for more details and examples.

=head1 SYNOPSIS

 
      ###
      use    XML::RelaxNG::Compact::PXB;
     
      # express your schema 
     
      my $subelement =  {  'attrs'  => {value => 'scalar', type => 'scalar', port => 'scalar',  xmlns => 'nsid2'},
                                                   elements => [],
                                                   text => 'unless:value',
                    };
      my $model = = {  'attrs'  => {id => 'scalar', type => 'scalar', xmlns => 'nsid'},
                  elements => [
                                [subelement => $subelement ]
                              ],
                 };
      # define Namespace registry for your schemes
      
      my $nsreg = { 'nsid' => 'http://nsid/URI',  'nsid2' => 'http://nsid2/URI'};
      
      # create API builder with your desired parameters 
      #
      my $api_builder =   XML::RelaxNG::Compact::PXB->new({ 
                                            top_dir =>   "/topdir/",
                                            nsregistry => $nsreg,
                                            datatypes_root =>   "Datatypes,
					    project_root => 'API,
                                            schema_version =>   "1.0",
                                            test_dir =>   "/topdir/t"});

      #### this call will build everything - API,tests, helper modules
      #### where  name parameter is the name of your root element  - "nsid:mymodel"
      #
      #   it will create versioned API under /topdir/API/Datatypes/v1_0/nsid/ for nsid namespace prefix
      #  and /topdir/API/Datatypes/v1_0/nsid2/ for nsid2 namespace prefix
      #
      
      $api_builder->buildAPI('mymodel', $model);
      
     
      #### this call will build only test suit
      ####
      $api_builder->buildTests('mymodel', $model);

      ####

      #### this call will build only Helper modules under /topdir/API/Datatypes/v1_0/ -  namespace prefix mapping, basic element operations
      ####
      
      $api_builder->buildHelpers();

      ####

=head1 METHODS

=cut

use IO::File;
use File::Path;
use Data::Dumper;
use FindBin;
use Carp;
use POD::Credentials;
use Class::Accessor::Fast;
use Class::Fields;
use base qw(Class::Accessor::Fast Class::Fields);
use fields qw(debug top_dir datatypes_root project_root schema_version test_dir footer nsregistry _schema_version_dir  _TESTS  _fh _fhtest  _path  _root _known_class _existed DEBUG);
XML::RelaxNG::Compact::PXB->mk_accessors(XML::RelaxNG::Compact::PXB->show_fields('Public'),'_fh', '_fhtest', '_TESTS');

=head2 new({})

creates new object, accepts reference to hash as parameters container  
where keys are:

=over

=item

B<DEBUG> - set it to something defined to provide extra logging

=item

B<top_dir> - full pathname to the api root dir, for example test files will be placed as top_dir/test_dir
B<Default:> C<current directory>

=item 

B<nsregistry> - reference to the hash with {ns_prefix => ns_URI} pairs, it will be built into the Element class
B<Default:> just XSD and XSI namespaces

=item

B<datatypes_root> - name of the generated datatypes directory
B<Default:> I<XMLTypes>

=item

B<project_root> - name of the API project directory, all packages will have naming beginning with this one
B<Default:> I<API>, with B<datatypes_root> default value every package will have API::XMLTYpes:: pre-fix


=item

B<schema_version> - version identifier for your XML schema
B<Default:> I<1.0>

=item

B<test_dir> - name for the test suit files ( relative to the <top_dir>)
B<Default:>  I<t>

=item

B<footer> - container of  the object - L<POD::Credentials>, used for printing POD footer with  SEE ALSO, AUTHOR, COPYRIGHT, LICENSE 


=back


Possible ways to call B<new()>:

  ### with defaults
  $api_builder =   XML::RelaxNG::Compact::PXB->new();

  ## passes hashref with explicit   parameters, for the next example:
  ## api will be created at /root/XMLTypes/v1_0/
  ## and tests files under - /root/t
  
  $api_builder =   XML::RelaxNG::Compact::PXB->new({
                                            top_dir =>   "/root/",
                                            datatypes_root =>   "XMLTypes",
                                            nsregistry => { 'nsid' => 'nsURI'},
					    project_root => 'API,
                                            schema_version =>   "1.0",
                                            test_dir =>   "t",
                                            footer => POD::Credentials->new({author=> 'Joe Doe'}),
                                            });


=cut

#  XSD/XSI namespaces

our $XSD_NS = {'xsd'=>"http://www.w3.org/2001/XMLSchema",
                'xsi' => "http://www.w3.org/2001/XMLSchema-instance",
              };

sub new {
    my ( $that, $param ) = @_;
    my $class = ref($that) || $that;
    my $self = fields::new($class);
    # setting defaults
    
    $self->top_dir("$FindBin::Bin");
    $self->datatypes_root("XMLTypes");
    $self->project_root("API");
    $self->schema_version("1.0");
    $self->footer(POD::Credentials->new());
    $self->DEBUG(-1);
    $self->test_dir("/t");
    ### private fields initialization
    $self->{_known_class} ={}; ## namespace/element specific lookup table for already created classes
    $self->{_existed}={};   ## general lookup table for already created classes
    $self->{_path} = []; ## container for current directory path
    if ($param  && ref($param) ne 'HASH') {
        croak("ONLY hash ref accepted as param and not: " . Dumper $param );
    }
    map {$self->{$_} = $param->{$_} if $self->can($_) && $param->{$_} } keys %{$param};   ###
    (my $version = $self->schema_version) =~ s/v//i;
    $self->schema_version(qv("$version"));
    $version =~ s/\./_/g;
    $self->{_schema_version_dir} = "v$version"; 
    ##$self->test_dir($self->top_dir . "/" . $self->test_dir);
    if($self->nsregistry && ref($self->nsregistry) eq 'HASH') {
        $self->nsregistry({%{$self->nsregistry}, %{$XSD_NS}});
    } else {
        $self->nsregistry($XSD_NS);
    }
    $self->footer->end_module(1);
    $self->footer->see_also(' Automatically generated by L<XML::RelaxNG::Compact::PXB> ');
    return $self;
}


#                       private function
#
#  for new classname, path, root and ns will check if this package already exists and
#  then update path and root with appended classname a
#  where root is the API modules tree path and path is the directory pathname
#  without top dir name
#

sub  _makeAPIPath {
    my ($self, $classname,  $ns) = @_;
    my $classnameUP = ucfirst($classname);
    print "MakePath:  ::$ns  packagepath=" . $self->_packagePath . "  classnameUP=$classnameUP\n" if $self->DEBUG > 1;
    push @{$self->{_path}}, $classnameUP;
    unless ( $self->{_existed}->{$self->project_root . "::" . $self->datatypes_root . "::" . $self->{_schema_version_dir} . "::$ns". $self->_packagePath  }) {
     
        $self->{_existed}->{$self->project_root . "::" . $self->datatypes_root . "::" .  $self->{_schema_version_dir} . "::$ns" . $self->_packagePath} =  $classname;
        $self->{_known_class}->{$classname}{$ns} =  $self->project_root . "::" . $self->datatypes_root . "::" .$self->{_schema_version_dir}  . "::$ns" . $self->_packagePath ;       
    }
    return $self;
}


#
#     private function
#
#  return package path for the current _path array

sub  _packagePath {
    my ($self) = @_;
    my $path = '::';
    if(@{$self->{_path}}) {
        $path .= join '::', @{$self->{_path}};
    } else {
        $path = '';
    }
    return $path; 
}

#
#     private function
#
#  return dirnames path for the current _path array

sub  _dirPath {
    my ($self) = @_;
    my $path = '/';
    if(@{$self->{_path}}) {
        $path .= join '/', @{$self->{_path}};
    } else {
        $path = '';
    }
    return $path;
}

=head2 buildAPI()

builds XML binding API recursively
accepts    parameters:

=over

=item

name of the root element - undef by default

=item

reference to the hash representing the RelaxNG Compact schema, empty hash ref by default

=item

parent - is C<undef> for the root element

=back

returns $self

=cut

sub buildAPI {
    my ($self, $param) = @_;
    my $name = $param->{name};
    my $element =  $param->{element};
    my $parent  =  $param->{parent};
    $self->_printHelpers unless $parent;
    
    my $ns = $element->{attrs}->{xmlns};
    croak(" Malformed definition: something is  missing name=$name  ns=$ns  element=" .  Dumper $element  ) unless $name && $ns && $element;  
    $self->_makeAPIPath($name,  $ns);
    if($element && ref($element) eq 'HASH' &&  $element->{attrs})  {
        if(ref($element->{elements}) eq 'ARRAY') {
            mkpath([ $self->top_dir . "/" . $self->project_root . "/". $self->datatypes_root .  "/"  .$self->{_schema_version_dir} . "/$ns". $self->_dirPath], 1, 0755) unless $self->_TESTS;
        }
        ###  
        foreach my $el (@{$element->{elements}}) {
            if(ref($el) eq 'ARRAY') {
                if(ref($el->[1]) eq 'HASH' && $el->[1]->{attrs}) {
                    $self->buildAPI({name => $el->[0],  element => $el->[1], parent => $element}); 
                } elsif(ref($el->[1]) eq 'ARRAY') {
                    foreach my $sub_el (@{$el->[1]}) { ### if right part is arrayref - means choice between elements
                        next unless $sub_el;
			if(ref($sub_el) eq 'HASH' && $sub_el->{attrs}) { # choice between single elements
                            $self->buildAPI({name => $el->[0],  element => $sub_el, parent => $element});
                        } elsif(ref($sub_el) eq 'ARRAY' && scalar @{$sub_el} == 1) {  # choice between multiple
                            $self->buildAPI({name => $el->[0],  element => $sub_el->[0], parent => $element});
                        } else {
                            croak(" Malformed definition: name=" . $el->[0] ." sub_el Dump=" . Dumper($sub_el) . " el Dump=" .  Dumper  $el );
                        }
                    }
                }
            }
        }
 
       $self->buildClass($name, $element, $parent) if defined $self->_dirPath && defined $self->_packagePath;
       # if empty directory was created, then remove it
       my $child_dir =  $self->top_dir ."/". $self->project_root . "/". $self->datatypes_root . "/" . $self->{_schema_version_dir} . "/$ns". $self->_dirPath;
       rmdir $child_dir  if( -d   $child_dir); 
       pop @{$self->{_path}} if  defined $self->_dirPath && defined $self->_packagePath;   
    } else {
        croak("Malformed definition: ended up in non element");
    }
   
    return $self;
}

=head2 buildHelpers

  shortcut to build Helper classes only, no arguments
  returns $self

=cut

sub buildHelpers {
     my ($self) = @_;
     $self->_printHelpers();
     return $self;
}


=head2 buildAM

 prints accessors and mutators for the passed reference to array of names
 returns $self

=cut


sub buildAM {
    my ($self, $arr_names) = @_;
    croak " Only array ref parameter accepted" . Dumper $arr_names  unless ref($arr_names) eq 'ARRAY';
    foreach my $name (@{$arr_names}) {
        $self->sayIt(qq"

\=head2 get_$name

 accessor  for $name, assumes hash based class

\=cut

sub get_$name {
    my(\$self) = \@_;
    return \$self->{$name};
}

\=head2 set_$name

mutator for $name, assumes hash based class

\=cut

sub set_$name {
    my(\$self,\$value) = \@_;
    if(\$value) {
        \$self->{$name} = \$value;
    }
    return   \$self->{$name};
}
");
    }
    return $self;
}

=head2 buildTests

 shortcut to build test files  only, no arguments
 returns $self


=cut

sub buildTests {
     my  $self  = shift;
     $self->_TESTS(1);
     $self->buildAPI(@_);
     return $self;

}

=head2 buildClass

builds  single class on the filesystem and corresponded test file
accepts parameters:

=over

=item

name of the   element

=item

hashref with the element definition

=item

hashref with parent definition if its not the root element

=back

returns $self

=cut

 sub  buildClass {
    my ($self, $name, $element, $parent) = @_;
    # current path
    my $ns = $element->{attrs}->{xmlns};
    my $path = $self->top_dir ."/".  $self->project_root . "/". $self->datatypes_root . "/" . $self->{_schema_version_dir} . "/$ns" .  $self->_dirPath;
    # current classname
    my $root =  $self->project_root . "::". $self->datatypes_root . "::" . $self->{_schema_version_dir}  . "::$ns".  $self->_packagePath;
    my $className =   $root;

#--------------------------- some preparatory work here, lists of element names, attributes, text elements -----------
    my @elements =     grep(ref($_) eq 'ARRAY' && $_->[0] && $_->[1], @{$element->{elements}});
    my @elementnodes = grep(ref($_->[1]), @elements);
    my @textnodes =    grep($_->[1] eq 'text'  && !ref($_->[1]), @elements);
    my $elements_names = @elementnodes?join (" " ,  map { $_->[0] } @elementnodes):'';
    my $texts_names =  @textnodes?join (" " , map { $_->[0] } @textnodes):'';
    my @attributes =  grep(!/xmlns/, keys %{$element->{attrs}});
    my $attributes_names = @attributes?join " " , @attributes:'';
#--------------------------------------------------------------------------------
    my %parent_sql = ();
    # parsing SQL mapping config for parent  element if it exists to allow propagation of the conditions from the previous layer
    if($parent &&  ref($parent) eq 'HASH' && $parent->{sql}) {
        foreach my $table (keys %{$parent->{sql}}) {
            foreach my $field (keys %{$parent->{sql}->{$table}}) {
                my $value =  $parent->{sql}->{$table}->{$field}->{value};
                $value = [$value]  if ref($value) ne 'ARRAY';
                foreach my   $possible (@{$value}) {
                    $parent_sql{$table}{$field}{$possible}++;
                }
            }
        }
    }
    my %sql_pass =(); ### hash with pass through, means this is not  the last element in the tree
    my %sql_here =(); ### hash with sql to map here - tree leaf
    # preprocessing sql config if   it exists for this element
    if($element->{sql}) {
        foreach my $table (keys %{$element->{sql}}) {
            foreach my $field (keys %{$element->{sql}->{$table}}) {
                my $value =  $element->{sql}->{$table}->{$field}->{value};
                unless($value) {
                    croak(" SQL config malformed for element=$name table=$table field=$field, but value is missied");
                }
                my $condition = $element->{sql}->{$table}->{$field}->{if};
                my ($attr_name, $set) = $condition?$condition  =~ m/^(\w+):?(\w+)?$/:('','');
                my $cond_string = $condition && $set?" (\$self->get_$attr_name eq '$set') ":$condition?" (\$self->get_$attr_name)":'';

                $value = [$value]  if ref($value) ne 'ARRAY';

                foreach my   $possible (@{$value}) {
                    next if %parent_sql && $parent_sql{$table}{$field} && !$parent_sql{$table}{$field}{$name};
                    if($elements_names =~ /\b$possible\b/) {  #### if name of the $possible element is among the members of this object then pass  it there
                        $sql_pass{$possible}{$table}{$field} = $cond_string;
                    } else {                                     ######  otherwise set it with some value here ( text or attribute )
                        $sql_here{$possible}{$table}{$field} = $cond_string;
                    }
                }
            }
        }
    }
    #-------------------------------------------- build tests
    $self->buildTest(\@elementnodes,  \@attributes, $className, $name, $element);
    # return if TESTS is set - only test files should be built
    if($self->_TESTS) {
        return;
    }

    $self->_fh(IO::File->new($path . ".pm","w+"));
    croak(" Failed to open file :" . $path . ".pm")  unless $self->_fh;

    print("\n Classname: $path ...  Attributes: $attributes_names \n Elements: $elements_names\n") if $self->DEBUG > 0;
    print(" Config:" . Dumper $element) if $self->DEBUG>2;
#----------------------------------------------
    my $version = $self->schema_version;
#--------------------------------------------
#
#    the actual package generator starts here
#
    $self->sayIt(qq/package  $className;

use strict;
use warnings;
use utf8;
use English qw(-no_match_vars);
use version; our \$VERSION = '$version';

\=head1 NAME

$className  -  this is data binding class for  '$name'  element from the XML schema namespace $ns

\=head1 DESCRIPTION

Object representation of the $name element of the $ns XML namespace.
Object fields are:

/);

#------------------------------------------------------------------------------
#  printing attributes
    map { $self->sayIt("    Scalar:     $_,")  }   @attributes ;
#
#   printing elements
#
    map { $self->sayIt("    Object reference:   " . $_->[0]  . " => type " . ref($_->[1]) . ",") }  @elements ;


    $self->sayIt(qq/

The constructor accepts only single parameter, it could be a hashref with keyd  parameters hash  or DOM of the  '$name' element
Alternative way to create this object is to pass hashref to this hash: { xml => <xml string> }
Please remember that namespace prefix is used as namespace id for mapping which not how it was intended by XML standard. The consequence of that
is if you serve some XML on one end of the webservices pipeline then the same namespace prefixes MUST be used on the one for the same namespace URNs.
This constraint can be fixed in the future releases.

Note: this class utilizes L<Log::Log4perl> module, see corresponded docs on CPAN.

\=head1 SYNOPSIS

          use $className;
          use Log::Log4perl qw(:easy);

          Log::Log4perl->easy_init();

          my \$el =  $className->new(\$DOM_Obj);

          my \$xml_string = \$el->asString();

          my \$el2 = $className->new({xml => \$xml_string});


          see more available methods below


\=head1   METHODS

\=cut


use XML::LibXML;
use Scalar::Util qw(blessed);
use Log::Log4perl qw(get_logger);
use Readonly;
    /);

####printing  namespace specific helper classes
    my $localized_path =  $self->project_root . "::" . $self->datatypes_root . "::" . $self->{_schema_version_dir};
    $self->sayIt("use $localized_path\::Element qw(getElement);");
    $self->sayIt("use $localized_path\::NSMap;");

    foreach my $el (@elementnodes) {
        foreach my $ns (keys %{$self->{_known_class}->{$el->[0]}}) {
              $self->sayIt("use " . $self->{_known_class}->{$el->[0]}{$ns} . ";")  if $self->{_known_class}->{$el->[0]}{$ns};
        }
    }

    $self->saying("use fields qw(nsmap idmap LOGGER $attributes_names $elements_names $texts_names");
    $self->saying(" text ") if $element->{text};
    $self->sayIt(");");
    $self->sayIt(qq/

\=head2 new({})

 creates   object, accepts DOM with element's tree or hashref to the list of
 keyd parameters:
/);

    map { $self->sayIt("         $_   => undef,")  }  @attributes ;
    map { $self->sayIt("         " . $_->[0]  . " => " . ref($_->[1]) . ",")   }  @elementnodes;

    $self->sayIt(" text => 'text'") if $element->{text};

    $self->sayIt(qq/
returns: \$self

\=cut

Readonly::Scalar our \$COLUMN_SEPARATOR => ':';
Readonly::Scalar our \$CLASSPATH =>  '$className';
Readonly::Scalar our \$LOCALNAME => '$name';

sub new {
    my (\$that, \$param) = \@_;
    my \$class = ref(\$that) || \$that;
    my \$self =  fields::new(\$class );
    \$self->set_LOGGER(get_logger( \$CLASSPATH ));
    \$self->set_nsmap($localized_path\::NSMap->new());
    \$self->get_nsmap->mapname(\$LOCALNAME, '$ns');
/);

#### printing the rest of constructor
    $self->sayIt(qq"
    if(\$param) {
        if(blessed \$param && \$param->can('getName')  && (\$param->getName =~ m/\$LOCALNAME\$/xm) ) {
            return  \$self->fromDOM(\$param);
        } elsif(ref(\$param) ne 'HASH')   {
            \$self->get_LOGGER->logdie(\"ONLY hash ref accepted as param \" . \$param );
            return;
        }
        if(\$param->{xml}) {
            my \$parser = XML::LibXML->new();
            my \$dom;
            eval {
                my \$doc = \$parser->parse_string(\$param->{xml});
                \$dom = \$doc->getDocumentElement;
            };
            if(\$EVAL_ERROR) {
                \$self->get_LOGGER->logdie(\" Failed to parse XML :\" . \$param->{xml} . \" \\n ERROR: \\n\" . \$EVAL_ERROR);
                return;
            }
            return  \$self->fromDOM(\$dom);
        }
        \$self->get_LOGGER->debug(\"Parsing parameters: \" . (join ' : ', keys \%{\$param}));


        foreach my \$param_key (keys \%{\$param}) {
            \$self->{\$param_key} = \$param->{\$param_key} if \$self->can(\"get_\$param_key\");
        }
        \$self->get_LOGGER->debug(\"Done\");
    }
    return \$self;
}

\=head2   getDOM (\$parent)

 accepts parent DOM  serializes current object into the DOM, attaches it to the parent DOM tree and
 returns $name object DOM

\=cut

sub getDOM {
    my (\$self, \$parent) = \@_;
    my \$$name;
    eval { 
        my \@nss;    
        unless(\$parent) {
            my \$nsses = \$self->registerNamespaces(); 
            \@nss = map {\$_  if(\$_ && \$_  ne  \$self->get_nsmap->mapname( \$LOCALNAME ))}  keys \%{\$nsses};
            push(\@nss,  \$self->get_nsmap->mapname( \$LOCALNAME ));
        } 
        push  \@nss, \$self->get_nsmap->mapname( \$LOCALNAME ) unless  \@nss;
        \$$name = getElement({name =>   \$LOCALNAME, 
	                      parent => \$parent,
			      ns  =>    \\\@nss,
                              attributes => [
");

#------------------------------- generate serialization for each attribute

    foreach my $attr (@attributes) {
        print("_printConditional:: $attr = " . $element->{attrs}->{$attr})  if $self->DEBUG> 2;
        $self->sayIt($self->_printConditional($attr, $element->{attrs}->{$attr}, 'get'));
    }
    $self->sayIt("                                               ],"); # end for attributes
    $self->sayIt($self->_printConditional('text', $element->{text} , 'get')) if ($element->{text});

    $self->sayIt("                               });");
    $self->sayIt("        };");
    $self->sayIt("    if(\$EVAL_ERROR) {");
    $self->sayIt("         \$self->get_LOGGER->logdie(\" Failed at creating DOM: \$EVAL_ERROR\");");
    $self->sayIt("    }");

### deal with subelements
###
###   each sub-element can be defined as some complex type where:
###                    [ name => obj ]           -   just object
###              or    [name => [obj]]           -   arrayref of objects
###              or    [name => [obj1,obj2]]     -   choice between two obj
###              or    [name => [[obj1],[obj2]]] -   choice between two obj arrayref
###

    foreach my $els (@elementnodes) {
        croak(" Malformed elements declaration: name=$name  and this thingy: els=$els must be an ARRAY ref ") unless ref($els) eq 'ARRAY';

        my  $condition =  _conditionParser($els->[2]);
        my $subname =  $els->[0];
        $condition->{logic} .= " && " if  $condition->{logic};
        if(ref($els->[1])  eq  'ARRAY') {
            if(scalar @{$els->[1]} >  1 ) {
                if(ref( $els->[1]->[0]) ne 'ARRAY') {
                    $self->_printGetDOM($subname, $name,  $condition->{logic});
                } else {
                    $self->_printGetArrayDom($subname, $name,  $condition->{logic});
                }
            } else {
                $self->_printGetArrayDom($subname, $name,  $condition->{logic});
            }
        } elsif(ref($els->[1]) eq  'HASH') {
            $self->_printGetDOM($subname, $name,  $condition->{logic});
        }
    }
    if($texts_names) {
        $self->sayIt(qq!

    foreach my \$textnode (qw/$texts_names/) {
        if(\$self->{\$textnode}) {
            my  \$domtext  =  getElement({name => \$textnode,
                                          parent => \$$name,
                                          ns => [\$self->get_nsmap->mapname(\$LOCALNAME)],
                                         text => \$self->{\$textnode},
                              });
           \$domtext?\$$name->appendChild(\$domtext):\$self->get_LOGGER->logdie("Failed to append new text element \$textnode  to  $name");
        }
    }
        !);
    }
    $self->sayIt("      return \$$name;\n}");


### print accessors/mutators for all element nodes and attributes ( careless about the type of the element )

    $self->buildAM(['LOGGER', 'nsmap', 'idmap', 'text',   @attributes, map { $_->[0] } @elementnodes, @textnodes]);

###  next building various element related methods

    foreach my  $el (@elementnodes) {
        my $subname = $el->[0];
        if(ref($el->[1]) eq 'ARRAY') {
            $self->sayIt(qq/


\=head2  add\u${subname}()

 if any of subelements can be an array then this method will provide
 facility to add another element to the  array and will return ref to such array
 or just set the element to a new one, if element has and 'id' attribute then it will
 create idmap  
 
 Accepts:  obj
 Returns: arrayref of objects

\=cut

sub add\u${subname} {
    my (\$self,\$new) = \@_;

    \$self->get_$subname && ref(\$self->get_$subname) eq 'ARRAY'?push \@{\$self->get_$subname}, \$new:\$self->set_$subname([\$new]);
    \$self->get_LOGGER->debug("Added new to $subname");
    \$self->buildIdMap; ## rebuild index map
    return \$self->get_$subname;
}

\=head2  remove\u${subname}ById()

 removes specific element from the array of ${subname} elements by id ( if id is supported by this element )
 Accepts:  single param - id - which is id attribute of the element
 
 if there is no array then it will return undef and warning
 if it removed some id then \$id will be returned

\=cut

sub remove\u${subname}ById {
    my (\$self, \$id) = \@_;
    if(ref(\$self->get_$subname) eq 'ARRAY' && \$self->get_idmap->{$subname} &&  exists \$self->get_idmap->{$subname}{\$id}) {
        undef \$self->get_$subname->\[\$self->get_idmap->{$subname}{\$id}\];
        my \@tmp =  grep { defined \$_ } \@{\$self->$subname};
        \$self->set_$subname([\@tmp]);
        \$self->buildIdMap; ## rebuild index map
        return \$id;
    } elsif(!ref(\$self->get_$subname)  || ref(\$self->get_$subname) ne 'ARRAY')  {
        \$self->get_LOGGER->warn("Failed to remove  element because ${subname} not an array for non-existent id:\$id");
    } else {
        \$self->get_LOGGER->warn("Failed to remove element for non-existent id:\$id");
    }
    return;
}

\=head2  get\u${subname}ById()

 get specific element from the array of ${subname} elements by id ( if id is supported by this element )
 Accepts single param - id
 
 if there is no array then it will return just an object

\=cut

sub get\u${subname}ById {
    my (\$self, \$id) = \@_;

    if(ref(\$self->get_$subname) eq 'ARRAY' && \$self->get_idmap->{$subname} && exists \$self->get_idmap->{$subname}{\$id} ) {
        return \$self->get_$subname->\[\$self->get_idmap->{$subname}{\$id}\];
    } elsif(!ref(\$self->get_$subname) || ref(\$self->get_$subname) ne 'ARRAY')  {
        return \$self->get_$subname;
    }
    \$self->get_LOGGER->warn("Requested element for non-existent id:\$id");
    return;
}
            /);

        }

    }

    $self->sayIt(qq/

\=head2  querySQL ()

 depending on SQL mapping declaration it will return some hash ref  to the  declared fields
 for example querySQL ()
 
 Accepts one optional parameter - query hashref, it will fill this hashref
 
 will return:
    
    { <table_name1> =>  {<field name1> => <value>, ...},...}

\=cut

sub  querySQL {
    my (\$self, \$query) = \@_;
/);
#
#   print hash with mapped fields for this class
#
    if($element->{sql}) {
        $self->saying("     my \%defined_table = (");
        foreach my $table (keys %{$element->{sql}}) {
            $self->saying(" '$table' => [");
            foreach my $field (keys %{$element->{sql}->{$table}}) {
                $self->saying("   '$field', ");
            }
            $self->saying(" ], ");
        }
        $self->sayIt(" );");
    }
#  add current class into the declarative path of the sql field mapped down the tree
    foreach my  $subname (keys %sql_pass) {
        foreach my $table (keys %{$sql_pass{$subname}}) {
            foreach my $entry (keys %{$sql_pass{$subname}{$table}}) {
                $self->saying("     \$query->{$table}{$entry}= [");
                foreach my $nss (keys %{ $self->{_known_class}->{$subname}}) {
                    $self->saying("     '". $self->{_known_class}->{$subname}{$nss} . "',");
               }
               $self->sayIt("     ];");
            }
        }
    }
  #  set sql for fields  which mapped here
    foreach my  $subname (keys %sql_here) {
        foreach my $table (keys %{$sql_here{$subname}}) {
            foreach my $entry (keys %{$sql_here{$subname}{$table}}) {
                $self->sayIt("     \$query->{$table}{$entry}= [ '$className' ] if!(defined \$query->{$table}{$entry}) || ref(\$query->{$table}{$entry});");
            }
        }
    }
    if($elements_names)  {
         $self->sayIt(qq!
    foreach my \$subname (qw/$elements_names/) {
        if(\$self->{\$subname} && (ref(\$self->{\$subname}) eq 'ARRAY' ||  blessed \$self->{\$subname})) {
            my \@array = ref(\$self->{\$subname}) eq 'ARRAY'?\@{\$self->{\$subname}}:(\$self->{\$subname});
            foreach my \$el (\@array) {
                if(blessed \$el && \$el->can('querySQL'))  {
                    \$el->querySQL(\$query);
                    \$self->get_LOGGER->debug("Querying $name  for subclass \$subname");
                } else {
                    \$self->get_LOGGER->logdie("Failed for $name Unblessed member or querySQL is not implemented by subclass \$subname");
                }
           }
        }
    }
         !);
    }
    if(%sql_here)  {
        $self->sayIt(qq/
    eval {
        foreach my \$table  ( keys \%defined_table) {
            foreach my \$entry (\@{\$defined_table{\$table}}) {
                if(ref(\$query->{\$table}{\$entry}) eq 'ARRAY') {
                    foreach my \$classes (\@{\$query->{\$table}{\$entry}}) {
                         if(\$classes && \$classes eq '$className') {
        /);

        my $if_sub_cond = ' if    ';
        foreach my  $subname  (@attributes, 'text') {
            if($sql_here{$subname})  {
               $self->sayIt(_getSQLSub($sql_here{$subname}, $subname, $if_sub_cond));
               $if_sub_cond =  ' elsif ';
            }
        }
        $self->sayIt(qq/
                         }
                     }
                 }
             }
        }
    };
    if(\$EVAL_ERROR) {
            \$self->get_LOGGER->logdie("SQL query building is failed  here " . \$EVAL_ERROR);
    }

        /);
    }
    $self->sayIt("    return \$query;");
    $self->sayIt("}");

    $self->sayIt(qq/


\=head2  buildIdMap()

 if any of subelements has id then get a map of it in form of
 hashref to { element}{id} = index in array and store in the idmap field

\=cut

sub  buildIdMap {
    my \$self = shift;
    my \%map = ();
    /);

    if( @elementnodes ) {
        $self->sayIt(qq"
    foreach my \$field (qw/$elements_names/) {
        my \@array = ref(\$self->{\$field}) eq 'ARRAY'?\@{\$self->{\$field}}:(\$self->{\$field});
        my \$i = 0;
        foreach my \$el (\@array)  {
            if(\$el && blessed \$el && \$el->can('get_id') &&  \$el->get_id)  {
                \$map{\$field}{\$el->get_id} = \$i;
            }
            \$i++;
        }
    }
    return \$self->set_idmap(\\\%map);
        ");

     } else {
        $self->sayIt("    return;");
    }
    $self->sayIt("}");
  
    $self->sayIt(qq/
\=head2  asString()

 shortcut to get DOM and convert into the XML string
 returns nicely formatted XML string  representation of the  $name object

\=cut

sub asString {
    my \$self = shift;
    my \$dom = \$self->getDOM();
    return \$dom->toString('1');
}

\=head2 registerNamespaces ()

 will parse all subelements
 returns reference to hash with namespace prefixes
 
 most parsers are expecting to see namespace registration info in the document root element declaration

\=cut

sub registerNamespaces {
    my (\$self, \$nsids) = \@_;

    my \$local_nss = {reverse \%{\$self->get_nsmap->mapname}};
    unless(\$nsids) {
        \$nsids = \$local_nss;
    }  else {
        \%{\$nsids} = (\%{\$local_nss}, \%{\$nsids});
    }
/);

    if( @elementnodes ) {
        $self->sayIt(qq"
    foreach my \$field (qw/$elements_names/) {
        my \@array = ref(\$self->{\$field}) eq 'ARRAY'?\@{\$self->{\$field}}:(\$self->{\$field});
        foreach my \$el (\@array) {
            if(blessed \$el &&  \$el->can('registerNamespaces') ) {
                my \$fromNSmap = \$el->registerNamespaces(\$nsids);
                my \%ns_idmap = \%{\$fromNSmap};
                foreach my \$ns (keys \%ns_idmap)  {
                    \$nsids->{\$ns}++;
                }
            }
        }
    }
");
    }
    $self->sayIt("    return \$nsids;");
    $self->sayIt("}");
    $self->sayIt(qq/

\=head2  fromDOM (\$)

 accepts parent XML DOM  element  tree as parameter
 returns $name  object

\=cut

sub fromDOM {
    my (\$self, \$dom) = \@_;
/);
    print("  fromDOM for: name=$name ") if $self->DEBUG>2;
    foreach my $attr (@attributes) {
        print("  fromDOM for:  "  . Dumper $element->{attrs}) if $self->DEBUG>2;
        $self->sayIt($self->_printConditional($attr, $element->{attrs}->{$attr}, 'set'));
        $self->sayIt("    \$self->get_LOGGER->debug(\" Attribute $attr= \". \$self->get_$attr) if \$self->get_$attr;");
    }
    $self->sayIt($self->_printConditional('text', $element->{text}, 'set')) if ($element->{text});
    if(@elements) {
        $self->sayIt(qq/    foreach my \$childnode (\$dom->childNodes) {
        my  \$getname  = \$childnode->getName;
        my (\$nsid, \$tagname) = split \$COLUMN_SEPARATOR, \$getname;
        next unless(\$nsid && \$tagname);
	my \$element;
	/);
        my $conditon_head =  '     if';
        foreach my $els (@elementnodes) {
            croak(" Element must be an array ref here: name=$name els=$els ") unless ref($els) eq 'ARRAY';
	    print " fromDOM subelement: " . Dumper $els if $self->DEBUG > 3;
            my $subname =  $els->[0];
            my  $condition  =  _conditionParser($els->[2]);
            $condition->{logic} .= " && " if  $condition->{logic};
	    print " fromDOM choice sub_subelement: " . Dumper  $els->[1]  if $self->DEBUG > 3;
            if(ref($els->[1]) eq  'ARRAY') {
                if(scalar @{$els->[1]} >  1)  {
                    foreach my $choice (@{$els->[1]}) {
		   
                        if(ref($choice) ne  'ARRAY') {
                            $self->_printFromDOM($subname, $choice, 'CHOICE', $conditon_head, $condition->{logic});
                            $conditon_head = '     elsif';
                        } elsif(scalar @{$choice} ==  1 ) {
                            $self->_printFromDOM($subname, $choice->[0], 'ARRAY', $conditon_head, $condition->{logic});
                            $conditon_head = '     elsif';
                        } else {
                            croak(" Malformed element definition: name=$name subelement=$subname");
                        }
                    }
                } else {
		    my $sub_el =  ref $els->[1]->[0] eq 'ARRAY'?$els->[1]->[0]->[0]:$els->[1]->[0];
		    
		    print " fromDOM 0 from sub_subelement: " . Dumper  $els->[1]->[0]  if $self->DEBUG > 3;
                    $self->_printFromDOM($subname,  $sub_el, 'ARRAY',$conditon_head, $condition->{logic});
                }
            } elsif (ref($els->[1])  eq  'HASH') {
                $self->_printFromDOM($subname,$els->[1], 'HASH',$conditon_head, $condition->{logic});
            }
            $conditon_head = '     elsif';
        }
        if(@textnodes) {
            $self->sayIt(" $conditon_head (\$childnode->textContent && \$self->can(\"get_\$tagname\")) {");
            $self->sayIt("            \$self->{\$tagname} =  \$childnode->textContent; ## text node");
            $self->sayIt("        }");
        }
#        if(@elementnodes || @textnodes) {
#            $self->sayIt("       \$dom->removeChild(\$childnode); ##remove processed element from the current DOM so subclass can deal with remaining elements\n";
#        }
        $self->sayIt("    }");
        $self->sayIt("    \$self->buildIdMap;\n    \$self->registerNamespaces;");
    }
    $self->sayIt("    return \$self;\n}");
    $self->sayIt($self->footer->asString());
    $self->_fh->close;
    return;
}

#
#
#   internal call to create perlcritic and perltidy configs
#
sub _placeCritidy {
    my ($self) = @_;
    my $basename =  $self->top_dir . '/' . $self->test_dir . '/conf';
    unless( -e  "$basename/perltidyrc") {
        $self->_fh(IO::File->new( "$basename/perltidyrc",'w+'));
        $self->sayIt(qq{# PBP .perltidyrc file

-i=4	# Indent level is 4 cols
-ci=4	# Continuation indent is 4 cols
-st	# Output to STDOUT
-b	# backup original to .bak and modify file in-place
-se	# Errors to STDERR
-vt=0	# Maximal vertical tightness
-cti=0  # No extra indentation for closing brackets
-pt=1	# Medium parenthesis tightness
-lp	# line up parentheses, brackets, and non-BLOCK braces
-bt=1	# Medium brace tightness
-ce	# cuddled else; use this style: '\} else \{'
-bar	# opening brace always on right, even for long clauses
-sbt=1  # Medium square bracket tightness
-bbt=1  # Medium block brace tightness  
-nolq	# dont outdent long quoted strings (default) 
-nsfs	# No space before semicolons
-nolq	# Don't outdent long quoted strings
-wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= && += -= /= |= >>= ||= .= %= ^= x="
            # Break before all operators
        });
    }
    unless( -e  "$basename/perlcritic") {
      $self->_fh(IO::File->new("$basename/perlcritic",'w+')); 
    
       $self->sayIt(qq{
    severity = 2
    only = 1
    theme = (pbp + core + bugs + readability)
    ## layout according to the supplied perltidy
    [CodeLayout::RequireTidyCode]
    perltidyrc =  $basename/perltidyrc
    #--------------------------------------------------------------
    # I think these are really important, so always load them

    [TestingAndDebugging::RequireUseStrict]
    severity = 5

    [TestingAndDebugging::RequireUseWarnings]
    severity = 5
    
    [Variables::ProhibitLocalVars]
    severity = 5
    #--------------------------------------------------------------
    # I think these are less important, so only load when asked

    [Variables::ProhibitPackageVars]
    severity = 1

    [ControlStructures::ProhibitPostfixControls]
    allow = if unless
    severity = 2

    
    #--------------------------------------------------------------
    # I do not agree with these at all or their 
    # presence may create more worse than good
    # or they depend on the personal taste and not reason

    [-NamingConventions::ProhibitMixedCaseVars]
    [-NamingConventions::ProhibitMixedCaseSubs]
    [-ControlStructures::ProhibitUnlessBlocks]
    [-Documentation::RequirePodSections]
    [-Documentation::RequirePodAtEnd]
    [-TestingAndDebugging::ProhibitNoStrict]
    [-Subroutines::ProhibitExcessComplexity]
    [-Miscellanea::RequireRcsKeywords]
    [-ValuesAndExpressions::ProhibitNoisyQuotes]
    [-ValuesAndExpressions::ProhibitInterpolationOfLiterals]
    [-CodeLayout::ProhibitParensWithBuiltins]
    [-CodeLayout::ProhibitTrailingWhitespace] 
    #--------------------------------------------------------------
       });
    }
    return;
}




=head2  buildTest

 auxiliary method
 it builds test file for current class
 accepts:

       reference to array with elements,
       reference to array with attributes,
       class name
       name of the package
       element name

 returns: nothing

=cut

sub buildTest {
    my ($self, $elementnodes, $attributes, $className, $name, $element) = @_;
    
    my $relative_path = $self->top_dir . '/'.  $self->test_dir;
    mkpath   ([  $relative_path  ], 1, 0755);
    mkpath   ([  "$relative_path/conf"], 1, 0755);
    print " Creating perlcritic and perltidyrc config files ... " if $self->DEBUG > 0;
    $self->_placeCritidy();
    print " Creating simple test.pl file " if $self->DEBUG > 0;
    unless(-e  $self->top_dir . "/test.pl") {
        $self->_fh(IO::File->new( $self->top_dir . "/test.pl" ,"w+"));
        $self->sayIt(qq{use strict;
use warnings;

use Test::Harness;
 
use FindBin qw(\$Bin);   
BEGIN \{
   unshift \@INC, "\$Bin" ; 
   unshift \@INC, "\$Bin/../";  
\};
 

if (\$ARGV[0] && \$ARGV[0] eq '-v') \{
  \$Test::Harness::Verbose = 1;
  shift \@ARGV;
\}

Test::Harness::runtests(<\$Bin/t/*.t>);
}); 
    }
    print " Creating test suit... " if $self->DEBUG > 0;
    $self->_fh(IO::File->new("$relative_path/$className.t" ,"w+"));
    croak(" Failed to open test suite file: $! $relative_path/$className.t")  unless $self->_fh;
    my $test_number = 2;
    
    my $ns = $element->{attrs}->{xmlns};
    $self->sayIt(qq/

use warnings;
use strict;
use Test::More;
use Data::Dumper;  
use FindBin qw(\$Bin); 
use Log::Log4perl qw(:easy :levels); 
use English qw( -no_match_vars);
/);
    $self->sayIt('use Test::Perl::Critic (-severity => 3, -verbose => 4,  -profile => "$Bin/conf/perlcritic");');
    $self->sayIt(qq/

## see BEGIN block at the bottom for the number of tests and use_ok package check

Log::Log4perl->easy_init(\$ERROR);   
/);

    my @element_names = map {$_->[0]}  @{$elementnodes};
    foreach my $el (@element_names) {
        foreach my $ns (keys %{$self->{_known_class}->{$el}}) {
	    if($self->{_known_class}->{$el}{$ns}) {
                $self->sayIt("use_ok '" . $self->{_known_class}->{$el}{$ns} . "';");
		$self->sayIt("#", $test_number++);
            }
        }
    }
    $self->sayIt("#", $test_number++);
   
    $self->sayIt('critic_ok("$Bin/../' .  $self->project_root . "/" . $self->datatypes_root . "/" . 
                                  $self->{_schema_version_dir} . "/$ns" .  
				  $self->_dirPath . '.pm", "perl critic have not found any problems") 
	            or diag(" perl critic found problems ");');
  
    
    my $accessors =   'get_nsmap get_idmap ' . join(' ',  map{"get_$_"}  @{$attributes}, @element_names);
     
    $self->sayIt("#", $test_number++);
    $self->sayIt("can_ok($className->new(), qw/$accessors/);");
     
    $self->sayIt(qq/

my \$obj1 = undef;

#$test_number
eval {
    \$obj1 = $className->new({
    /);

    map {$self->saying("  '$_' =>  'value_$_',")} @{$attributes};
    $self->sayIt("    })\n};\nok(\$obj1 && !\$EVAL_ERROR, \"Create object $className...\") or diag(\$EVAL_ERROR);\n undef \$EVAL_ERROR;");
    $self->sayIt('#', ++$test_number);
    $self->sayIt("my \$ns  =  \$obj1->get_nsmap->mapname('$name');");
    $self->sayIt("ok(\$ns eq '". $element->{attrs}->{xmlns} . "', \"  mapname('$name')...  \");");

    foreach my $att (@{$attributes}) {
        $self->sayIt('#', ++$test_number);
        $self->sayIt("my \$$att  =  \$obj1->get_$att;");
        $self->sayIt("ok(\$$att eq 'value_$att', \"Checking accessor  obj1->get_$att ...  \") or diag(' Accessor test failed ');");
    }
    foreach my $subel (@{$elementnodes}) {
        my $subel1 = (ref($subel->[1]) eq 'ARRAY')?
                      ((ref($subel->[1]->[0]) eq 'ARRAY')?$subel->[1]->[0]->[0]:$subel->[1]->[0]):
                                      ((ref($subel->[1]) eq 'HASH')?$subel->[1]:undef);
        next unless $subel1;
        $self->sayIt('#', ++$test_number);
        my $subel_name = $subel->[0];
        $self->sayIt("my \$obj_$subel_name;");
        $self->sayIt('eval {');
        $self->saying("    \$obj_$subel_name = " . $self->{_known_class}->{$subel_name}{$subel1->{attrs}->{xmlns}} ."->new({");
        map { $self->saying("  '$_' =>  'value$_',") if $_ ne 'xmlns' &&   $subel1->{attrs}->{$_}}  keys %{$subel1->{attrs}};
        $self->sayIt('    });');
        (ref($subel->[1]) eq 'ARRAY' && $#{$subel->[1]} == 0)?$self->sayIt("    \$obj1->add\u$subel_name(\$obj_$subel_name);"):
                                                                  $self->sayIt("    \$obj1->set_$subel_name(\$obj_$subel_name);");
        $self->sayIt('};');
        $self->sayIt("ok(\$obj_$subel_name && \!\$EVAL_ERROR, \"Create subelement object $subel_name and set it\") or diag(\$EVAL_ERROR);");
        $self->sayIt('undef $EVAL_ERROR;');
    }
    $self->sayIt('#', ++$test_number);
    $self->sayIt('my $string;');
    $self->sayIt('eval {');
    $self->sayIt('    $string = $obj1->asString');
    $self->sayIt('};');
    $self->sayIt('ok($string && !$EVAL_ERROR, "Converting to XML string: $string") or diag($EVAL_ERROR);');
    $self->sayIt('undef $EVAL_ERROR;');
    $self->sayIt('#', ++$test_number);

    $self->sayIt('my $obj22;');
    $self->sayIt('eval {');
    $self->sayIt("    \$obj22 = $className->new({xml => \$string});");
    $self->sayIt('};');
    $self->sayIt('ok($obj22 && !$EVAL_ERROR, "Re-create object from XML string: ") or diag($EVAL_ERROR);');
    $self->sayIt('undef $EVAL_ERROR;');
    $self->sayIt('#', ++$test_number);
    $self->sayIt('my $dom1 = $obj1->getDOM();');
    $self->sayIt('my $obj2;');
    $self->sayIt('eval {');
    $self->sayIt("     \$obj2 = $className->new(\$dom1);");
    $self->sayIt('};');
    $self->sayIt('ok($obj2 && !$EVAL_ERROR, "Re-create object from DOM XML: ") or diag($EVAL_ERROR);');
    $self->sayIt('undef $EVAL_ERROR;');
    $self->sayIt(qq!

BEGIN {

   plan tests =>  $test_number;
   use_ok  '$className';
  
}

1;
    !);
    $self->_fh->close;
}
#
#   auxiliary private function ( extracted from the build_class )
#   printing  getDom  part for arrayref members ( when its more than  a single instance of the sub-element )
#
#    accepts: $fh - filehandle where it prints to
#             $subname - current sub-element name
#             $name - name of the current element - will be used as parent DOM object identifier for recursive call
#             $logic - conditional logic parsed by _conditionParser
#
#
sub _printGetArrayDom {
    my ($self, $subname, $name, $logic) = @_;
    $self->sayIt(qq/
    if($logic\$self->get_$subname && ref(\$self->get_$subname) eq 'ARRAY') {
        foreach my \$subel (\@{\$self->get_$subname}) {
            if(blessed \$subel && \$subel->can("getDOM")) {
                my \$subDOM = \$subel->getDOM(\$$name);
                \$subDOM?\$$name->appendChild(\$subDOM):\$self->get_LOGGER->logdie("Failed to append  $subname element  with value:" .  \$subDOM->toString);
            }
        }
    }
/);
}
#
#   auxiliary private function ( extracted from the build_class )
#   printing  getDom  part for singular  object members
#
#    accepts:
#             $subname - current sub-element name
#             $name - name of the current element - will be used as parent DOM object identifier for recursive call
#             $cond_string - conditional logic parsed by _conditionParser reference to the sql_fields hash with mapped sql fields
#
sub _printGetDOM {
    my ($self, $subname, $name, $cond_string) = @_;
    $self->sayIt(qq/
    if($cond_string\$self->get_$subname && blessed \$self->get_$subname && \$self->get_$subname->can("getDOM")) {
        my \$${subname}DOM = \$self->get_$subname->getDOM(\$$name);
        \$${subname}DOM?\$$name->appendChild(\$${subname}DOM):\$self->get_LOGGER->logdie("Failed to append  $subname element with value:" .  \$${subname}DOM->toString);
    }
/);
}
#
#    auxiliary private function
#    will parse conditional string and return  regexp and  logical condition
#    accepted parameter: $value is a  string to parse where EBNF declaration is:
#       value =  ('scalar'| 'enum'|'set'|'if'|'unless'|'exclude') ':' (string ( ','  string)*)
#    will return hashref with  the resulted hash with keys:
#       {condition  => <left part of the ':'>,
#        logic => <if statement conditional expression>,
#        regexp => <matching regexp for the  enumerated list on the right part of ':'> }
#

sub _conditionParser {
    my $value = shift;
    my $result = { condition => '', logic => '', regexp => ''};
    return $result  unless $value;
    $value  =~ s/^(scalar|enum|set|if|unless|exclude)\:?//;
    $result->{condition} = $1;
    my @list  = split ",", $value  unless $result->{condition} eq 'scalar';
    if(@list) {
        $result->{logic}  =  "(\$self->get_" . (join " && \$self->get_", @list) . ")";
        $result->{regexp} = " =~ m/(" . (join "|", @list) . ")\$/";
        if($result->{condition}  eq 'unless') {
            $result->{logic}  = "!".  $result->{logic};
        } elsif($result->{condition}  eq 'exclude') {
            $result->{regexp} =~ s/\=\~/\!\~/;
        }
    }
    return  $result;
}
#
#   auxiliary private function ( extracted from the build_class )
#   analyze condition and return conditional string to be used in getDOM|fromDOM printing calls
#   accepted parameters: $key - [<attribute name> | 'text'],
#                        $value - condition to parse by _conditionParser,
#                        $what -  ['get' | 'from'] - to distinguish fromDom and getDOM
#
#
#
sub  _printConditional {
    my ($self, $key, $value,$what) = @_;
    my $string;

    my $arrayref_signleft = ($key ne 'text')?"[":'';
    my $arrayref_signright = ($key ne 'text')?"]":'';

    my $fromDomArg = ($key ne 'text')?"\$dom->getAttribute('$key')":"\$dom->textContent";

    my  $condition  = _conditionParser($value);
    print("$value Enum List:: " . ( join ":", map { " $_= " . $condition->{$_}} keys  %{$condition})) if $self->DEBUG > 0 && !$condition->{condition}  eq 'scalar';

    if($condition->{condition}   eq 'scalar') {
        $string =   $what eq 'get'?"                                                     $arrayref_signleft'$key' =>  \$self->$what\_$key$arrayref_signright,\n":
                                 "    \$self->$what\_$key($fromDomArg) if($fromDomArg);\n";
    } elsif($condition->{condition}  =~ /^if|unless$/ &&  $condition->{logic}) {
        $string =  $what eq 'get'?"                                           $arrayref_signleft '$key' => (".$condition->{logic}."?\$self->$what\_$key:undef)$arrayref_signright,\n":
                                 "    \$self->$what\_$key($fromDomArg) if(" . $condition->{logic}. " && $fromDomArg);\n";
    }elsif($condition->{condition} =~ /enum|set|exclude/ &&  $condition->{regexp}) {

    my $regexp  =  $what eq 'get'?"(\$self->$what\_$key   " . $condition->{regexp} . ")":"($fromDomArg  " . $condition->{regexp}  .")";

    $string =   $what eq 'get'?"                                           $arrayref_signleft'$key' =>  ($regexp?\$self->$what\_$key:undef)$arrayref_signright,\n":
                                 "    \$self->$what\_$key($fromDomArg) if($fromDomArg && $regexp);\n";

    } else {
        croak("Malformed , unknown condition=" . $condition->{condition} );
    }

    return $string;
}

#
#   auxiliary private function ( extracted from the build_class )
#   returns string with value setting statements for mapped sql fields
#
#    accepts: reference to the sql_fields hash with mapped sql fields
#             name of the sub-element
#             string with 'if' or 'elsif' statement depending on the function call order
#
sub _getSQLSub {
    my ($sql_fields, $subname, $if_cond) = @_;
    my $head_string = "                           $if_cond(\$self->get_$subname && (";
    my $add = ' ';
    foreach my $table (keys %{$sql_fields}) {
        $head_string .= "$add( ";
        my @cond_string = ();
        foreach my $field (keys %{$sql_fields->{$table}}) {
            my $cond = $sql_fields->{$table}{$field};
            $cond .= ' && ' if $cond;
            push @cond_string, " ($cond\$entry eq '$field')";
        }
        $head_string .=  (join " or ", @cond_string) . ")";
        $add = ' || ';
    }
    $head_string .=  " )) {\n";
    $head_string .=   "                                \$query->{\$table}{\$entry} =  \$self->get_$subname;\n";
    $head_string .=   "                                \$self->get_LOGGER->debug(\" Got value for SQL query \$table.\$entry: \" . \$self->get_$subname);\n";
    $head_string .=   "                                last;  \n";
    $head_string .=   "                            }\n";
    return $head_string;
}
#
#   auxiliary private function ( extracted from the build_class )
#   prints fromDOM part
#
#   accepts: $fh - filehandle where it prints to
#            $subname - found sub-element name
#            $el - reference to hash with found sb-element declaration
#            $type - enumeration of 'HASH' 'ARRAY' 'CHOICE' - where ARRAY is treated differently
#            $condition_head - 'if' or 'elsif'
#            $cond_string - parsed by _conditionParser conditional logic
#
sub _printFromDOM {
    my ($self, $subname, $el, $type, $conditon_head, $cond_string) = @_;
    my  $subnameUP =  ucfirst($subname);
    my $ns = $el->{'attrs'}{'xmlns'};
    print "Building fromDOM: type=$type subname=$subname   head=$conditon_head  string=$cond_string ns=$ns  class=" . $self->{_known_class}->{$subname}{ $ns } ."\n" if $self->DEBUG > 2;
    $self->sayIt("   $conditon_head ($cond_string\$tagname eq  '$subname' && \$nsid eq '".  $el->{'attrs'}{'xmlns'}  ."' && \$self->can(\"get_\$tagname\")) {");
    $self->sayIt("                eval {");
    $self->sayIt("                    \$element = " . $self->{_known_class}->{$subname}{$el->{'attrs'}{'xmlns'}} . "->new(\$childnode)");
    $self->sayIt("                };");
    $self->sayIt("                if(\$EVAL_ERROR || !(\$element  && blessed \$element)) {");
    $self->sayIt("                    \$self->get_LOGGER->logdie(\" Failed to load and add  $subnameUP : \" . \$dom->toString . \" error: \" . \$EVAL_ERROR);");
    $self->sayIt("                     return;");
    $self->sayIt("                }");
    $self->sayIt((($type eq 'ARRAY')?"               (\$self->get_$subname && ref(\$self->get_$subname) eq 'ARRAY')?push \@{\$self->get_$subname}, \$element:
                                                                                                        \$self->set_$subname([\$element]);":
                       "              \$self->set_$subname(\$element)") . "; ### add another $subname  ");
    $self->sayIt("            } ");
}

=head2 saying

 prints string into the  file handler without new line

=cut

sub saying {
    my($self, @string) = @_;
    croak("Filehandle must be set") unless $self->_fh && $self->_fh->isa('IO::File');
    $self->_fh->print(join '', @string);
}

=head2 sayIt

 prints string into the   file handler with new line added

=cut

sub sayIt {
    my($self, @string) = @_;
    $self->saying(@string);
    $self->_fh->print("\n");
}


#
# _printHelpers - prints  <datatypes_root>::Element - basic marshalling into DOM from perl obj
#                         <datatypes_root>::NSMap - mapping element names on the namespace prefixes
#                          <datatypes_root>::NamespaceRegistry - registry for namespace prefix => namespace
#
#  these modules are helpers utilized by the XML API
#

sub _printHelpers {
    my ($self) = @_;
    my $root_package =  $self->project_root . '::' .  $self->datatypes_root . '::' . $self->{_schema_version_dir};
    mkpath   ([ $self->top_dir . '/' . $self->project_root . '/' . $self->datatypes_root . '/' .  $self->{_schema_version_dir} ], 1, 0755);
    $self->_fh(IO::File->new( $self->top_dir .  "/" . $self->project_root . '/' . $self->datatypes_root . "/" .  $self->{_schema_version_dir} ."/Element.pm" ,"w+"));
    croak("Failed to open Element.pm file")  unless  $self->_fh;
    my $registry_string;   
    foreach my $prefix (keys %{$self->nsregistry}) {
        $registry_string .= " '$prefix' => '" . $self->nsregistry->{$prefix} . "',\n";
    }
    # define packages
    my $element_package = "$root_package\:\:Element";
 
    my $nsmap_package = "$root_package\:\:NSMap";

    my $version = $self->schema_version; 

##########   printing Element.pm

    $self->sayIt(qq/package $element_package;
use strict;
use warnings;
use version;our \$VERSION = qw("$version");
use base 'Exporter';

\=head1 NAME

$element_package -  static class for basic element manipulations

\=head1 DESCRIPTION

it exports only single call - getElement which allows to create XML DOM out of perl object
This module was automatically build by L<XML::RelaxNG::Compact::PXB>.

\=cut

our \@EXPORT_OK   = qw(\&getElement);

use Readonly;
use Scalar::Util qw(blessed);
use XML::LibXML;
use Log::Log4perl qw(get_logger);
 
use Data::Dumper;
Readonly::Scalar our \$CLASSPATH =>  '$element_package';
Readonly::Hash   our %NSREGISTRY => ($registry_string);

our \$LOGGER = get_logger(\$CLASSPATH);

\=head1 METHODS


\=head2    getElement ()

 create   element from some data struct and return it as DOM
 accepts 1 parameter - hashref to hash of keyd parameters

 where:
 
  'name' =>  name of the element
 
  'ns' => [ namespace id1, namespace id2 ...] array ref
 
  'parent' => parent DOM if provided ( element will be created in context of the parent),
 
  'attributes' =>  arrayref to the array of attributes pairs,
                   where to get i-th attribute one has to  \$attr->[i]->[0] for  name  and  \$attr->[i]->[1]  for value
 
  'text' => <CDATA>

 creates  new   element, returns this element

\=back

\=cut

sub  getElement {
    my \$param = shift;
    my \$data;
    unless(\$param && ref(\$param) eq 'HASH' &&  \$param->{name}) {
       \$LOGGER->logdie(" Need single hashref parameter as { name => '',  parent => DOM_obj, attributes => [], text => ''} with at least name key defined");
    }
    my \$name =   \$param->{name};
    my \$attrs =  \$param->{attributes};
    my \$text =   \$param->{text};
    my \$nss =    \$param->{ns}; ## reference to array ref with ns prefixes for this element
   
    if(\$param->{parent} && blessed(\$param->{parent}) && \$param->{parent}->isa('XML::LibXML::Document')) {
            \$data =  \$param->{parent}->createElement(\$name);
    } else {
            \$data =  XML::LibXML::Element->new(\$name);
    }
    ## validation of the namespace prefixes  registered
    if(\$nss)  {
            foreach my \$ns (\@{\$nss}) {
                next unless \$ns;
                unless(\$NSREGISTRY{\$ns}) {
		    \$LOGGER->error("Attempted to create element with un-supported namespace prefix"); 
		}
                \$data->setNamespace(\$NSREGISTRY{\$ns}, \$ns, 1);
            }
    } else {
            \$LOGGER->error("Attempted to create element without namespace");
    }
    if ((\$attrs && ref(\$attrs) eq 'ARRAY') || \$text) {
            if(\$attrs && ref(\$attrs) eq 'ARRAY') {
                foreach my \$attr (\@{\$attrs}) {
                    if(\$attr->[0] && \$attr->[1]) {
                        unless(ref(\$attr->[1]))   {
                            \$data->setAttribute(\$attr->[0], \$attr->[1]);
                        } else {
                            \$LOGGER->warn("Attempted to create ".\$attr->[0]." with this: ".\$attr->[1]." dump:" . sub { Dumper(\$attr->[1])});
                        }
                    }
                }
            }
            if(\$text)  {
                unless(ref(\$text)) {
                    my \$text_el = XML::LibXML::Text->new(\$text);
                    \$data->appendChild(\$text_el);
                }  else {
                    \$LOGGER->warn(" Attempted to create text with non scalar: \$text dump:" . sub {Dumper(\$text)});
                }
            }
    } else {
        \$LOGGER->warn(" Attempted to create empty element with name \$name, failed to do so, will return undef ");
    }
    return \$data;
}
/);

    $self->sayIt($self->footer->asString());
 
    $self->_fh(IO::File->new( $self->top_dir .  "/" . $self->project_root .  "/" . $self->datatypes_root  . "/" .  $self->{_schema_version_dir} . "/NSMap.pm" ,"w+"));
    croak(" Failed to open NSMap.pm file")  unless  $self->_fh;

    $self->sayIt(qq/package   $nsmap_package;

use strict;
use warnings;
use version;our \$VERSION = qv("$version");

\=head1 NAME

$nsmap_package - element names to namespace prefix mapper

\=head1 DESCRIPTION

this class designed to map element localname to registered namespace, the object of this
class is supposed to be member of the each PXB binded object in order to allow propagation of the
registered namespaces throughout the API

\=head1 SYNOPSIS

        use $nsmap_package;
	
	my \$nsmap =  $nsmap_package->new();
	\$nsmap->mapname(\$ELEMENT_LOCALNAME, 'ns_prefix');

\=head1 METHODS

\=head2 new({})

 new  - constructor, accepts single parameter - hashref with the hash of:
 
 <element_name> =>  <URI>,..., <element_name> =>  <URI>  #  mapped element on ns hashref
 
 the namespace registry track relation between namespace URI and used prefix

\=cut

use Data::Dumper;
use Readonly;
use Log::Log4perl qw(get_logger);
use fields qw(nsmap);

Readonly::Scalar our \$CLASSPATH => '$nsmap_package';
our \$LOGGER =  get_logger(\$CLASSPATH);

sub new {
    my (\$class, \$param) = \@_;
    \$class = ref(\$class) || \$class;
    my \$self = fields::new(\$class);
    if (\$param) {
        unless( ref(\$param) eq 'HASH') {
            \$LOGGER->logdie("ONLY hash ref accepted as param and not: " . Dumper \$param );
        }  
        foreach my \$key (keys \%{\$param}) {
            \$self->mapname(\$key => \$param->{\$key});
        }
    } else {
        \$self->{nsmap} = {}; 
    }
    return \$self;
}


\=head2 mapname()

    maps localname on the prefix
    accepts:
        with single parameter ( element name ) it will return
       namespace prefix  and with two parameters it will map  namespace prefix
    to specific element name
    and without parameters it will return the whole namespaces hashref

\=cut


sub mapname {
    my (\$self, \$element, \$nsid) = \@_;
    if (\$element && \$nsid) {
        \$self->{nsmap}->{\$element}  =  \$nsid;
    return \$self;
    } elsif(\$element && \$self->{nsmap}->{\$element} && !\$nsid) {
        return \$self->{nsmap}->{\$element};
    } elsif(!\$nsid && !\$element) {
        return \$self->{nsmap};
    }
    return;
}

/);

 $self->buildAM([qw/nsmap/]);
 $self->sayIt($self->footer->asString());

}

=head1 AUTHOR

Maxim Grigoriev (FNAL), maxim_at_fnal_dot_gov

=head1 LICENSE

You should have received a copy of the Fermitools license
with this software.  If not, see <http://fermitools.fnal.gov/about/terms.html>

=head1  COPYRIGHT

Copyright(c) 2007-2008, Fermi Research Alliance (FRA)

=cut
 

1;