view release on metacpan or  search on metacpan

lib/Net/iContact.pm  view on Meta::CPAN

sub login {
    my $self = shift;
    my $call = 'auth/login/' . $self->username . '/' . $self->password;
    my $root = $self->get($call, {'api_key' => $self->api_key });
    return unless $root;

    $self->{'token'} = $root->{response}->{auth}->{token}->{value};
    $self->{'seq'}   = $root->{response}->{auth}->{seq}->{value};
    return 1;
}

### Most of this code is shared with all of the GET calls.
### _getcall takes a string (the RHS of `my $call =') and a coderef
### (callback for processing the tree XML::Bare returns).
###
### It returns a subroutine that preforms the requested call.
sub _getcall {
    my ($cstr, $munge) = @_;

    my $ret = q|sub {
        my $self = shift;my $call = CALL;my %args = @_;
        my $root = $self->get($call, { $self->_stdargs, %args });
        unless ($root) {
            warn 'Got error: ' . $self->error->{code} . ': ' . $self->error->{message} . "\n";
            return;
        }
        return $munge->($root);
    }|;
    $ret =~ s/CALL/$cstr/;
    return eval $ret;
}

### Build the GET functions with _getcall.
*contacts = _getcall q("contacts"), 
                    sub { _to_arrayref(shift->{response}->{contact}) };
*contact  = _getcall q("contact/" . shift),
                    sub { _to_hashref (shift->{response}->{contact}) };
*subscriptions = _getcall q{"contact/" . shift() . "/subscriptions"},
                    sub { _to_subs(shift->{response}->{contact}->{subscription})};
*campaigns = _getcall q("campaigns"),
                    sub { _to_arrayref(shift->{response}->{campaigns}->{campaign})};
*campaign  = _getcall q("campaign/" . shift),
                    sub { _to_hashref (shift->{response}->{campaign})};
*lists = _getcall q("lists"),
                    sub { _to_arrayref(shift->{response}->{lists}->{list})};
*list  = _getcall q("list/" . shift),
                    sub { _to_hashref (shift->{response}->{list})};
*custom_fields = _getcall q{"contact/" . shift() . "/custom_fields"},
                    sub { _to_cfields (shift->{response}->{contact}->{custom_fields}->{custom_field})};
*stats = _getcall q{"message/" . shift() . "/stats"},
                    sub { _to_stats   (shift->{response}->{message}->{stats})};


sub putmessage {
    my ($self, $subject, $campaign, $text, $html) = @_;
    my $call = 'message';

    my $X = new XML::Generator ':pretty';
    my $xml = $X->xml($X->message(
                  $X->subject($X->xmlcdata($subject)),
                  $X->campaign($campaign),
                  $X->text_body($X->xmlcdata($text)),
                  $X->html_body($X->xmlcdata($html)),
              ))->stringify;

    my $root = $self->put($call, { $self->_stdargs }, $xml);
    return unless $root;

    return $root->{response}->{result}->{message}->{id}->{value};
}

sub putcontact {
    my ($self, $contact, $id) = @_;
    my $call = 'contact' . ($id ? "/$id" : '');

    my $X = new XML::Generator ':pretty';
    my $xml = $X->xml($X->contact(($id ? { 'id' => $id } : { }),
                                   map {$X->$_($contact->{$_})} keys %$contact,
                     ))->stringify;

    my $root = $self->put($call, { $self->_stdargs }, $xml);
    return unless $root;

    return $root->{response}->{result}->{contact}->{id}->{value};
}

sub putsubscription {
    my ($self, $contactid, $listid, $status) = @_;
    my $call = "contact/$contactid/subscription/$listid";

    my $X = new XML::Generator ':pretty';
    my $xml = $X->xml($X->subscription({'id' => $listid},
                                       $X->status($status),
                     ))->stringify;

    my $root = $self->put($call, { $self->_stdargs }, $xml);
    ## False on failure, 1 on success.
    return unless $root;
    return 1;
}

sub gen_sig {
    my ($self,$call,$args) = @_;
    my $sig = $self->secret;
    $sig .= $call;
    for my $key (sort (keys(%$args))) {
        $sig .= $key . $args->{$key};
    }
    return md5_hex($sig);
}

sub gen_url {
    my ($self,$call,$args) = @_;
    my $url = API_BASE . $call;
    my $sig = $self->gen_sig($call, $args);

    $url .= "/?api_sig=$sig";

    while (my ($key,$val) = each(%$args)) {
        $url .= "&$key=$val";
    }
    return $url;
}