—
—
—
—
—
—
—
—
—

              
package Lim::RPC::Value::Collection;
use common::sense;
use Carp;
use Lim ();
HideShow 22 lines of Pod
=encoding utf8
=head1 NAME
...
=head1 VERSION
See L<Lim> for version.
=over 4
=item OPT_REQUIRED
=item OPT_SWALLOW
=item OPT_SINGLE
=back
=cut
our $VERSION = $Lim::VERSION;
sub OPT_REQUIRED (){ 0x00000001 }
sub OPT_SWALLOW (){ 0x00000002 }
sub OPT_SINGLE (){ 0x00000004 }
our %OPTIONS = (
    'required' => OPT_REQUIRED,
    'swallow' => OPT_SWALLOW,
    'single' => OPT_SINGLE
);
HideShow 10 lines of Pod
=head1 SYNOPSIS
...
=head1 SUBROUTINES/METHODS
=head2 new
=cut
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my %args = scalar @_ > 1 ? ( @_ ) : ( textual => $_[0] );
    my $self = {
        options => 0
    };
    if (exists $args{textual}) {
        foreach (split(/\s+/o, lc($args{textual}))) {
            if (exists $OPTIONS{$_}) {
                $self->{options} |= $OPTIONS{$_};
            }
            else {
                confess __PACKAGE__, ': unknown RPC value collection setting "'.$_.'"';
            }
        }
    }
    else {
        unless (defined $args{children} and ref($args{children}) eq 'HASH') {
            confess __PACKAGE__, ': No children specified or invalid';
        }
        $self->{children} = $args{children};
        if (defined $args{options}) {
            unless (ref($args{options}) eq 'ARRAY') {
                confess __PACKAGE__, ': Invalid options specified';
            }
            foreach (@{$args{options}}) {
                if (exists $OPTIONS{$_}) {
                    $self->{options} |= $OPTIONS{$_};
                }
                else {
                    confess __PACKAGE__, ': Unknown RPC value collection option "'.$_.'"';
                }
            }
        }
    }
    bless $self, $class;
}
sub DESTROY {
    my ($self) = @_;
}
HideShow 4 lines of Pod
=head2 children
=cut
sub children {
    $_[0]->{children};
}
HideShow 4 lines of Pod
=head2 set_children
=cut
sub set_children {
    if (defined $_[1] and ref($_[1]) eq 'HASH') {
        $_[0]->{children} = $_[1];
    }
    $_[0];
}
HideShow 4 lines of Pod
=head2 required
=cut
sub required {
    $_[0]->{options} & OPT_REQUIRED ? 1 : 0;
}
HideShow 4 lines of Pod
=head2 swallow
=cut
sub swallow {
    $_[0]->{options} & OPT_SWALLOW ? 1 : 0;
}
HideShow 4 lines of Pod
=head2 single
=cut
sub single {
    $_[0]->{options} & OPT_SINGLE ? 1 : 0;
}
HideShow 4 lines of Pod
=head2 comform
=cut
sub comform {
    unless (defined $_[1]) {
        return 0;
    }
    if ($_[0]->single) {
        unless (ref($_[1]) eq 'HASH') {
            return 0;
        }
    }
    unless (ref($_[1]) eq 'HASH' or ref($_[1]) eq 'ARRAY') {
        return 0;
    }
    return 1;
}
HideShow 39 lines of Pod
=head1 AUTHOR
Jerry Lundström, C<< <lundstrom.jerry at gmail.com> >>
=head1 BUGS
Please report any bugs or feature requests to L<https://github.com/jelu/lim/issues>.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Lim
You can also look for information at:
=over 4
=item * Lim issue tracker (report bugs here)
L<https://github.com/jelu/lim/issues>
=back
=head1 ACKNOWLEDGEMENTS
=head1 LICENSE AND COPYRIGHT
Copyright 2012-2013 Jerry Lundström.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1; # End of Lim::RPC::Value::Collection