view release on metacpan or  search on metacpan

lib/Data/SExpression.pm  view on Meta::CPAN

    #Assume $thing has already been list-folded

    if(ref($thing) eq "ARRAY") {
        if( for_all {consp $_ && scalarp $_->car && scalarp $_->cdr} @{$thing} ) {
            return {map {$_->car => $_ -> cdr} @{$thing}};
        } else {
            return [map {$self->_fold_alists($_)} @{$thing}];
        }
    } elsif(consp $thing) {
        return cons($self->_fold_alists($thing->car),
                    $self->_fold_alists($thing->cdr));
    } else {
        return $thing;
    }
}

=head1 LISP-LIKE CONVENIENCE FUNCTIONS

These are all generic methods to make operating on cons's easier in
perl. You can ask for any of these in the export list, e.g.

    use Data::SExpression qw(cons consp);

=head2 cons CAR CDR

Convenience method for Data::SExpression::Cons->new(CAR, CDR)

=cut

sub cons ($$) {
    my ($car, $cdr) = @_;
    return Data::SExpression::Cons->new($car, $cdr);
}

=head2 consp THING

Returns true iff C<THING> is a reference to a
C<Data::SExpression::Cons>

=cut

sub consp ($) {
    my $thing = shift;
    return ref($thing) && UNIVERSAL::isa($thing, 'Data::SExpression::Cons');
}

=head2 scalarp THING

Returns true iff C<THING> is a scalar -- i.e. a string, symbol, or
number

=cut

sub scalarp ($) {
    my $thing = shift;
    return !ref($thing) ||
            ref($thing) eq "GLOB" ||
            ref($thing) eq 'Data::SExpression::Symbol';;
}

=head1 Data::SExpression::Parser callbacks

These are for internal use only, and are used to generate the data
structures returned by L</read>. 

=head2 new_cons CAR CDR

Returns a new cons with the given CAR and CDR

=cut

sub new_cons {
    my ($self, $car, $cdr) = @_;
    return cons($car, $cdr);
}

=head2 new_symbol NAME

Returns a new symbol with the given name

=cut

sub new_symbol {
    my ($self, $name) = @_;
    if($self->get_symbol_case eq 'up') {
        $name = uc $name;
    } elsif($self->get_symbol_case eq 'down') {
        $name = lc $name;
    }

    if($self->get_fold_dashes) {
        $name =~ tr/-/_/;
    }

    if($self->get_use_symbol_class) {
        return Data::SExpression::Symbol->new($name);
    } else {
        return Symbol::qualify_to_ref($name, 'main');
    }
}

=head2 new_string CONTENT

Returns a new string with the given raw content

=cut

sub new_string {
    my ($self, $content) = @_;

    $content =~ s/\\"/"/g;

    return $content;
}

=head1 BUGS

None known, but there are probably a few. Please reports bugs via
rt.cpan.org by sending mail to:

L<bug-Data-SExpression@rt.cpan.org>