view release on metacpan or  search on metacpan

lib/Text/vCard.pm  view on Meta::CPAN

  }
  *Text::vCard::get_lookup = \&my_lookup;

This has not been tested yet.

=cut 

sub get_lookup {
    my $self = shift;
    return \%lookup;
}

=head2 get_of_type()

  my $list = $vcard->get_of_type( $node_type, \@types );

It is probably easier just to use the get() method, which inturn calls
this method.

=cut

# Used to get the right elements
sub get_of_type {
    my ( $self, $node_type, $types ) = @_;

    # Upper case the name
    $node_type = uc($node_type);

    # See if there is an alias for it
    $node_type = uc( $node_aliases{$node_type} )
        if defined $node_aliases{$node_type};

    return undef unless defined $self->{nodes}->{$node_type};

    if ($types) {

        # After specific types
        my @of_type;
        if ( ref($types) eq 'ARRAY' ) {
            @of_type = @{$types};
        } else {
            push( @of_type, $types );
        }
        my @to_return;
        foreach my $element ( @{ $self->{nodes}->{$node_type} } ) {
            my $check = 1;    # assum ok for now
            foreach my $type (@of_type) {

                # set it as bad if we don't match
                $check = 0 unless $element->is_type($type);
            }
            if ( $check == 1 ) {

                push( @to_return, $element );
            }
        }

        return undef unless scalar(@to_return);

        # Make prefered value first
        @to_return = sort { _sort_prefs($b) <=> _sort_prefs($a) } @to_return;

        return wantarray ? @to_return : \@to_return;

    } else {

        # Return them all
        return wantarray
            ? @{ $self->{nodes}->{$node_type} }
            : $self->{nodes}->{$node_type};
    }
}

=head2 as_string

Returns the vCard as a string.

=cut

sub as_string {
    my ( $self, $fields ) = @_;

    # derp
    my %e = map { lc $_ => 1 } @{ $fields || [] };

    my @k = qw(VERSION N FN);
    if ($fields) {
        push @k, sort map { uc $_ } @$fields;
    } else {
        push @k, grep { $_ !~ /^(VERSION|N|FN)$/ }
            sort map { uc $_ } keys %{ $self->{nodes} };
    }

    # 'perldoc perlport' says using \r\n is wrong and confusing for a few
    # reasons but mainly because the value of \n is different on different
    # operating systems.  It recommends \x0D\x0A instead.
    my $newline = "\x0D\x0A";
    my $begin   = 'BEGIN:VCARD';
    my $end     = 'END:VCARD';

    my @lines = ($begin);
    for my $k (@k) {
        my $nodes = $self->get($k);
        push @lines, map { $_->as_string() } @$nodes;
    }
    return join $newline, @lines, $end, '';
}

sub _sort_prefs {
    my $check = shift;
    if ( $check->is_type('pref') ) {
        return 1;
    } else {
        return 0;
    }
}

# Private method for adding nodes
sub _add_node {
    my ( $self, $conf ) = @_;

    my $value_fields = $self->get_lookup();

    my $node_type = uc( $conf->{node_type} );
    $node_type = $node_aliases{$node_type}
        if defined $node_aliases{$node_type};

    my $field_list;

    if ( defined $value_fields->{$node_type} ) {

        # We know what the field list is
        $field_list = $value_fields->{$node_type};
    } else {

        # No defined fields - use just the 'value' one
        $field_list = \@default_field;
    }
    unless ( defined $self->{nodes}->{$node_type} ) {

        # create space to hold list of node objects
        my @node_list_space;
        $self->{nodes}->{$node_type} = \@node_list_space;
    }
    my $last_node;
    foreach my $node_data ( @{ $conf->{data} } ) {
        my $node_obj = Text::vCard::Node->new(
            {   node_type    => $node_type,
                fields       => $field_list,
                data         => $node_data,
                group        => $conf->{group} || '',
                encoding_out => $self->{encoding_out},
            }
        );

        push( @{ $self->{nodes}->{$node_type} }, $node_obj );

        # store the last node so we can return it.
        $last_node = $node_obj;
    }
    return $last_node;
}

=head1 AUTHOR

Leo Lapworth, LLAP@cuckoo.org
Eric Johnson (kablamo), github ~!at!~ iijo dot org

=head1 Repository (git)