File Coverage

blib/lib/Email/ExactTarget/SubscriberOperations.pm
Criterion Covered Total %
statement 24 202 11.8
branch 0 112 0.0
condition 0 27 0.0
subroutine 8 19 42.1
pod 8 8 100.0
total 40 368 10.8


line stmt bran cond sub pod time code
1             =encoding utf8
2              
3             =cut
4              
5             package Email::ExactTarget::SubscriberOperations;
6              
7 2     2   3649 use warnings;
  2         6  
  2         78  
8 2     2   12 use strict;
  2         5  
  2         74  
9              
10 2     2   13 use Carp;
  2         4  
  2         144  
11 2     2   14 use Data::Dumper;
  2         4  
  2         96  
12 2     2   13 use Data::Validate::Type;
  2         12  
  2         80  
13 2     2   11 use URI::Escape;
  2         4  
  2         118  
14 2     2   961 use Text::Unaccent qw();
  2         862  
  2         60  
15              
16 2     2   13 use Email::ExactTarget::Subscriber;
  2         5  
  2         8025  
17              
18              
19             =head1 NAME
20              
21             Email::ExactTarget::SubscriberOperations - Collection of functions to manipulate arrayrefs of Subscriber objects.
22              
23              
24             =head1 VERSION
25              
26             Version 1.6.2
27              
28             =cut
29              
30             our $VERSION = '1.6.2';
31              
32              
33             =head1 SYNOPSIS
34              
35             # Create a new subscriber operations object
36             my $subscriber_operations = $exact_target->subscriber_operations();
37              
38             my $subscribers;
39             eval
40             {
41             $subscribers = $subscriber_operations->retrieve(
42             'email' => [ qw( test@test.invalid foo@bar.invalid ) ],
43             );
44             };
45             warn "Retrieving the subscribers failed: $@" if $@;
46              
47              
48             =head1 METHODS
49              
50             =head2 new()
51              
52             Creates a new SubscriberOperations object, requires an Email::ExactTarget
53             object to be passed as parameter.
54              
55             my $subscriber_operations = Email::ExactTarget::SubscriberOperations->new( $exact_target );
56              
57             Note that this is not the recommended way of creating a SubscriberOperations
58             object. If you are writing a script using this distribution, you should use
59             instead:
60              
61             my $subscriber_operations = $exact_target->subscriber_operations();
62              
63             =cut
64              
65             sub new
66             {
67 0     0 1   my ( $class, $exact_target, %args ) = @_;
68              
69             # Require an Email::ExactTarget object to be passed.
70 0 0 0       confess 'Pass an Email::ExactTarget object to create an Email::ExactTarget::SubscriberOperations object'
71             unless defined( $exact_target ) && $exact_target->isa( 'Email::ExactTarget' );
72              
73             # Create the object.
74 0           my $self = bless(
75             {
76             'exact_target' => $exact_target,
77             },
78             $class,
79             );
80              
81 0           return $self;
82             }
83              
84              
85             =head2 exact_target()
86              
87             Returns the main Exact Target object.
88              
89             my $exact_target = $subscriber_operations->exact_target();
90              
91             =cut
92              
93             sub exact_target
94             {
95 0     0 1   my ( $self ) = @_;
96              
97 0           return $self->{'exact_target'};
98             }
99              
100              
101             =head2 create()
102              
103             Creates a new subscriber in ExactTarget's database using the staged changes on
104             the subscriber objects passed as parameter.
105              
106             $subscriber_operations->create(
107             \@subscribers
108             );
109              
110             =cut
111              
112             sub create
113             {
114 0     0 1   my ( $self, $subscribers ) = @_;
115              
116 0           return $self->_update_create(
117             'subscribers' => $subscribers,
118             'soap_action' => 'Create',
119             'soap_method' => 'CreateRequest',
120             'options' => undef,
121             );
122             }
123              
124              
125             =head2 update_or_create()
126              
127             Creates a new subscriber in ExactTarget's database using the staged changes on
128             the subscriber objects passed as parameter. If the subscriber already exists in
129             the database, updates it.
130              
131             $subscriber_operations->update_or_create(
132             \@subscribers
133             );
134              
135             =cut
136              
137             sub update_or_create
138             {
139 0     0 1   my ( $self, $subscribers ) = @_;
140              
141 0           return $self->_update_create(
142             'subscribers' => $subscribers,
143             'soap_action' => 'Create',
144             'soap_method' => 'CreateRequest',
145             'options' => SOAP::Data->name(
146             'Options' => \SOAP::Data->value(
147             SOAP::Data->name(
148             'SaveOptions' => \SOAP::Data->value(
149             SOAP::Data->name(
150             'SaveOption' => \SOAP::Data->value(
151             SOAP::Data->name(
152             'PropertyName' => '*',
153             ),
154             SOAP::Data->name(
155             'SaveAction' => 'UpdateAdd',
156             ),
157             ),
158             ),
159             ),
160             ),
161             ),
162             ),
163             );
164             }
165              
166              
167             =head2 update()
168              
169             Applies to ExactTarget's database any staged changes on the subscriber objects
170             passed as parameter.
171              
172             $subscriber_operations->update(
173             \@subscribers
174             );
175              
176             =cut
177              
178             sub update
179             {
180 0     0 1   my ( $self, $subscribers ) = @_;
181              
182 0           return $self->_update_create(
183             'subscribers' => $subscribers,
184             'soap_action' => 'Update',
185             'soap_method' => 'UpdateRequest',
186             'options' => SOAP::Data->name(
187             'Options' => \SOAP::Data->value(),
188             ),
189             );
190             }
191              
192              
193             =head2 retrieve()
194              
195             Retrieves from ExactTarget's database the subscribers corresponding to the
196             unique identifiers passed as parameter.
197              
198             my $subscribers = $subscriber_operations->retrieve(
199             'email' => [ $email1, $email2 ],
200             );
201              
202             =cut
203              
204             sub retrieve
205             {
206 0     0 1   my ( $self, %args ) = @_;
207 0           my $email = delete( $args{'email'} );
208              
209             # Check parameters.
210 0 0         confess 'Emails identifying the subscribers to retrieve were not passed.'
211             if !defined( $email );
212              
213 0 0         confess "The 'email' parameter must be an arrayref"
214             if !Data::Validate::Type::is_arrayref( $email );
215              
216 0 0         confess 'Emails identifying the subscribers to retrieve were not passed.'
217             if scalar( @$email ) == 0;
218              
219             # The 'IN' operator in ExactTarget requires at least 2 emails.
220             # If only one email is passed, we're simply going to send it twice and get one
221             # result back.
222 0 0         $email = [ $email->[0], $email->[0] ]
223             if scalar( @$email ) == 1;
224              
225             # Shortcuts.
226 0   0       my $exact_target = $self->exact_target() || confess 'Email::ExactTarget object is not defined';
227 0           my $verbose = $exact_target->verbose();
228              
229             # Prepare SOAP content.
230 0           my $soap_args =
231             [
232             SOAP::Data->name(
233             RetrieveRequest => \SOAP::Data->value(
234             SOAP::Data->name(
235             ObjectType => 'Subscriber',
236             ),
237             SOAP::Data->name(
238             Properties => ( 'ID', 'EmailTypePreference', 'EmailAddress' ),
239             ),
240             SOAP::Data->name(
241             'Filter' => \SOAP::Data->value(
242             SOAP::Data->name(
243             Property => 'EmailAddress',
244             ),
245             SOAP::Data->name(
246             SimpleOperator => 'IN',
247             ),
248             SOAP::Data->name(
249             Value => @$email,
250             ),
251             ),
252             )->attr( { 'xsi:type' => 'SimpleFilterPart' } ),
253             ),
254             ),
255             ];
256              
257             # Get Exact Target's reply.
258 0           my $soap_response = $exact_target->soap_call(
259             'action' => 'Retrieve',
260             'method' => 'RetrieveRequestMsg',
261             'arguments' => $soap_args,
262             );
263 0           my ( $soap_success, $soap_request_id, @soap_object ) = $soap_response->paramsall();
264              
265             # Check for errors.
266 0 0         confess Dumper( $soap_response->fault() )
267             if defined( $soap_response->fault() );
268              
269 0 0 0       confess "The SOAP reply status is '$soap_success', not 'OK'"
270             unless defined( $soap_success ) && ( $soap_success eq 'OK' );
271              
272             # Turn the SOAP objects into known objects.
273 0           my @subscriber = ();
274 0           foreach my $soap_object ( @soap_object )
275             {
276             # Check for errors in the XML returned.
277 0 0         confess "No attributes found."
278             unless defined( $soap_object->{'Attributes'} );
279              
280 0 0         confess 'No subscriber ID found.'
281             unless defined( $soap_object->{'ID'} );
282              
283             # Create a Subscriber object and fill it.
284 0           my $subscriber = Email::ExactTarget::Subscriber->new();
285 0           $subscriber->id( $soap_object->{'ID'} );
286 0           $subscriber->set_properties(
287             {
288 0           map { $_ => $soap_object->{ $_ } }
289             qw( EmailTypePreference EmailAddress )
290             },
291             'is_live' => 1,
292             );
293 0           $subscriber->set_attributes(
294             {
295             map
296             {
297 0           $_->{'Name'} => $_->{'Value'}
298 0           } @{ $soap_object->{'Attributes'} }
299             },
300             'is_live' => 1,
301             );
302              
303 0           push( @subscriber, $subscriber );
304             }
305              
306 0           return \@subscriber;
307             }
308              
309              
310             =head2 pull_list_subscriptions()
311              
312             Pulls from ExactTarget's database the list subscriptions for the arrayref of
313             subscribers passed as parameter.
314              
315             # Pull list subscriptions.
316             $subscriber_operations->pull_list_subscriptions(
317             $subscribers
318             );
319              
320             # Pull list subscriptions only for the specified lists.
321             # This is helpful if you have a lot of legacy/historical lists you
322             # don't actually sync with, as it cuts down on the number of results
323             # and the time it takes to retrieve them.
324             $subscriber_operations->pull_list_subscriptions(
325             $subscribers,
326             list_ids => \@list_ids,
327             );
328              
329             =cut
330              
331             sub pull_list_subscriptions
332             {
333 0     0 1   my ( $self, $subscribers, %args ) = @_;
334 0           my $list_ids = delete( $args{'list_ids'} );
335 0 0         croak 'Unrecognized arguments: ' . join( ', ', keys %args )
336             if scalar( keys %args ) != 0;
337              
338             # Verify arguments.
339 0 0         confess 'An arrayref of subscribers to pull list subscriptions for is required.'
340             if !Data::Validate::Type::is_arrayref( $subscribers );
341 0 0         confess 'A non-empty arrayref of subscribers to pull list subscriptions for is required.'
342             if scalar( @$subscribers ) == 0;
343 0 0         if ( defined( $list_ids ) )
344             {
345 0 0         confess 'When defined, the argument "list_ids" must be an arrayref'
346             if !Data::Validate::Type::is_arrayref( $list_ids );
347 0 0         confess 'When defined, the argument "list_ids" must contain at least one list ID to restrict the query to'
348             if scalar( @$list_ids ) == 0;
349             }
350              
351             # Shortcuts.
352 0   0       my $exact_target = $self->exact_target() || confess 'Email::ExactTarget object is not defined';
353 0           my $verbose = $exact_target->verbose();
354              
355             # Prepare the filter on the subscribers' email.
356 0           my @emails = map { $_->get_attribute('Email Address') } @$subscribers;
  0            
357 0 0         my $email_filter = \SOAP::Data->value(
    0          
358             SOAP::Data->name(
359             Property => 'SubscriberKey',
360             ),
361             SOAP::Data->name(
362             SimpleOperator => scalar( @emails ) == 1
363             ? 'equals'
364             : 'IN',
365             ),
366             SOAP::Data->name(
367             Value => scalar( @emails ) == 1
368             ? $emails[0]
369             : @emails,
370             ),
371             );
372              
373             # Prepare the list ID filter, if needed.
374 0           my $list_id_filter;
375 0 0         if ( defined( $list_ids ) )
376             {
377 0 0         $list_id_filter = \SOAP::Data->value(
    0          
378             SOAP::Data->name(
379             Property => 'ListID',
380             ),
381             SOAP::Data->name(
382             SimpleOperator => scalar( @$list_ids ) == 1
383             ? 'equals'
384             : 'IN',
385             ),
386             SOAP::Data->name(
387             Value => scalar( @$list_ids ) == 1
388             ? $list_ids->[0]
389             : @$list_ids,
390             ),
391             );
392             }
393              
394             # Prepare the complete filter.
395 0           my $filter;
396 0 0         if ( defined( $list_id_filter ) )
397             {
398             # Since we're filtering on list ID and email, then we need to set up a complex
399             # filter to combine them.
400 0           $filter = SOAP::Data->name(
401             'Filter' => \SOAP::Data->value(
402             SOAP::Data->name(
403             'LeftOperand' => $email_filter,
404             )->attr( { 'xsi:type' => 'SimpleFilterPart' } ),
405             SOAP::Data->name(
406             LogicalOperator => 'AND',
407             ),
408             SOAP::Data->name(
409             'RightOperand' => $list_id_filter,
410             )->attr( { 'xsi:type' => 'SimpleFilterPart' } ),
411             ),
412             )->attr( { 'xsi:type' => 'ComplexFilterPart' } );
413             }
414             else
415             {
416             # Filter only on email with a simple filter.
417 0           $filter = SOAP::Data->name(
418             'Filter' => $email_filter,
419             )->attr( { 'xsi:type' => 'SimpleFilterPart' } );
420             }
421              
422             # Prepare SOAP content.
423 0           my $soap_args =
424             [
425             SOAP::Data->name(
426             RetrieveRequest => \SOAP::Data->value(
427             SOAP::Data->name(
428             ObjectType => 'ListSubscriber',
429             ),
430             SOAP::Data->name(
431             Properties => qw( ListID SubscriberKey Status ),
432             ),
433             $filter,
434             ),
435             ),
436             ];
437              
438             # Get Exact Target's reply.
439 0           my $soap_response = $exact_target->soap_call(
440             'action' => 'Retrieve',
441             'method' => 'RetrieveRequestMsg',
442             'arguments' => $soap_args,
443             );
444              
445 0           my ( $soap_success, $soap_request_id, @soap_params_out ) = $soap_response->paramsall();
446              
447             # Check for errors.
448 0 0         confess Dumper( $soap_response->fault() )
449             if defined( $soap_response->fault() );
450              
451 0 0 0       confess "The SOAP reply status is '$soap_success', not 'OK'"
452             unless defined( $soap_success ) && ( $soap_success eq 'OK' );
453              
454             # Check the detail of the response for each object, and update accordingly.
455 0           my $subscribers_by_email =
456             {
457             map
458 0           { $_->get_attribute('Email Address') => $_ }
459             @$subscribers
460             };
461              
462 0           foreach my $soap_param_out ( @soap_params_out )
463             {
464 0           $subscribers_by_email->{ $soap_param_out->{'SubscriberKey'} }->set_lists_status(
465             {
466             $soap_param_out->{'ListID'} => $soap_param_out->{'Status'},
467             },
468             'is_live' => 1,
469             );
470             }
471              
472 0           return 1;
473             }
474              
475              
476             =head2 delete_permanently()
477              
478             Deletes permanently the subscribers in the set passed as parameter from
479             ExactTarget's database.
480              
481             Note that this operation cannot be reversed. If you want to keep the subscribers
482             but make sure emails are never sent to them, look into adding them to the
483             "blacklist" list instead.
484              
485             my $all_subscribers_removed = $subscriber_operations->delete_permanently(
486             \@subscribers
487             );
488              
489             unless ( $all_subscribers_removed )
490             {
491             foreach my $subscriber ( @subscribers )
492             {
493             my $errors = $subscriber->errors();
494             if ( defined( $errors ) )
495             {
496             # We failed to delete the subscriber.
497             print 'Failed to update subscriber ', $subscriber->id(), ": ", Dumper( $errors );
498             }
499             else
500             {
501             # Success.
502             }
503             }
504             }
505              
506             =cut
507              
508             sub delete_permanently
509             {
510 0     0 1   my ( $self, $subscribers ) = @_;
511              
512             # Verify parameters.
513 0 0         confess 'The "subscribers" parameter need to be set.'
514             if !defined( $subscribers );
515 0 0         confess 'The "subscribers" parameter must be an arrayref'
516             if !Data::Validate::Type::is_arrayref( $subscribers );
517 0 0         confess 'The "subscribers" parameter must have at least one subscriber in the arrayref'
518             if scalar( @$subscribers ) == 0;
519              
520             # Shortcuts.
521 0   0       my $exact_target = $self->exact_target() || confess 'Email::ExactTarget object is not defined';
522 0           my $verbose = $exact_target->verbose();
523              
524             # Prepare SOAP content.
525 0           my @soap_data = ();
526              
527 0           foreach my $subscriber ( @$subscribers )
528             {
529             # Reuse the existing identifiers.
530 0           my @object =
531             (
532             SOAP::Data->name(
533             'EmailAddress' => $subscriber->get_attribute( 'Email Address', 'is_live' => 1 ),
534             ),
535             SOAP::Data->name(
536             'ID' => $subscriber->id(),
537             ),
538             );
539              
540             # Create the subscriber block in the SOAP message.
541 0           push(
542             @soap_data,
543             SOAP::Data->name(
544             'Objects' => \SOAP::Data->value(
545             @object
546             ),
547             )->attr( { 'xsi:type' => 'Subscriber' } ),
548             )
549             }
550              
551             # Get Exact Target's reply.
552 0           my $soap_response = $exact_target->soap_call(
553             'action' => 'Delete',
554             'method' => 'DeleteRequest',
555             'arguments' =>
556             [
557             SOAP::Data->value(
558             @soap_data
559             )
560             ],
561             );
562              
563 0           my @soap_params_out = $soap_response->paramsall();
564 0           my $soap_success = pop( @soap_params_out );
565 0           my $soap_request_id = pop( @soap_params_out );
566              
567             # Check for errors.
568 0 0         confess Dumper( $soap_response->fault() )
569             if defined( $soap_response->fault() );
570              
571 0 0 0       confess "The SOAP reply status is '$soap_success', not 'OK'"
572             unless defined( $soap_success ) && ( $soap_success eq 'OK' );
573              
574             # Parse the output.
575 0           my $deletion_results = {};
576 0           foreach my $param_out ( @soap_params_out )
577             {
578 0           $deletion_results->{ $param_out->{'OrdinalID'} } =
579             {
580             'StatusCode' => $param_out->{'StatusCode'},
581             'StatusMessage' => $param_out->{'StatusMessage'},
582             };
583             }
584              
585             # Check the detail of the response for each object, and update it accordingly.
586 0           my $errors_found = 0;
587 0           for ( my $count = 0; $count < scalar( @$subscribers ); $count++ )
588             {
589 0           my $subscriber = $subscribers->[ $count ];
590 0           my $deletion_result = $deletion_results->{ $count };
591              
592             # Check the individual status code to determine if the update for that
593             # subscriber was successful.
594 0 0         if ( $deletion_result->{'StatusCode'} ne 'OK' )
595             {
596 0           $errors_found = 1;
597 0           $subscriber->add_error( $deletion_result->{'StatusMessage'} );
598 0           next;
599             }
600              
601             # The subscriber has been deleted in ExactTarget's database, flag it locally
602             # as deleted to prevent any further operation on this object.
603 0 0         unless ( $subscriber->flag_as_deleted_permanently() )
604             {
605 0           $errors_found = 1;
606 0           $subscriber->add_error( "Deleted in ExactTarget's database, but failed to flag locally the object as deleted." );
607 0           next;
608             }
609             }
610              
611 0           return !$errors_found;
612             }
613              
614              
615             =head1 INTERNAL FUNCTIONS
616              
617             =head2 _update_create()
618              
619             Internal. Updates or create a set of subscribers.
620              
621             my $batch_success = $subscriber_operations->_update_create(
622             'subscribers' => \@subscriber,
623             'soap_action' => 'Update',
624             'soap_method' => 'UpdateRequest',
625             );
626              
627             my $batch_success = $subscriber_operations->_update_create(
628             'subscribers' => \@subscriber,
629             'soap_action' => 'Create',
630             'soap_method' => 'CreateRequest',
631             );
632              
633             Note $batch_success will be true only if all the elements have been updated
634             successfully. When it is false, you should loop through @subscriber and use the
635             C method on each object to find which one(s) failed.
636              
637             =cut
638              
639             sub _update_create
640             {
641 0     0     my ( $self, %args ) = @_;
642 0           my $subscribers = delete( $args{'subscribers'} );
643              
644             # Verify parameters.
645 0 0         confess 'The "subscribers" parameter need to be set.'
646             if !defined( $subscribers );
647 0 0         confess 'The "subscribers" parameter must be an arrayref'
648             if !Data::Validate::Type::is_arrayref( $subscribers );
649 0 0         confess 'The "subscribers" parameter must have at least one subscriber in the arrayref'
650             if scalar( @$subscribers ) == 0;
651              
652             # Shortcuts.
653 0   0       my $exact_target = $self->exact_target() || confess 'Email::ExactTarget object is not defined';
654 0           my $verbose = $exact_target->verbose();
655              
656             # Make sure that the subscribers haven't been flagged locally as deleted.
657 0           foreach my $subscriber ( @$subscribers )
658             {
659 0 0         next unless $subscriber->is_deleted_permanently();
660              
661 0 0         confess 'Cannot perform operations on an object flagged as permanently deleted'
662             . ( $verbose ? ': ' . Dumper( $subscriber) : '.' );
663             }
664              
665             # Prepare SOAP content.
666 0           my @soap_data = ();
667 0 0         if ( defined( $args{'options'} ) )
668             {
669 0           push( @soap_data, $args{'options'} );
670             }
671              
672 0           foreach my $subscriber ( @$subscribers )
673             {
674 0           my @object = ();
675              
676 0 0         if ( $args{'soap_action'} eq 'Create' )
677             {
678             # Use the new email address as unique identifier.
679 0           push(
680             @object,
681             SOAP::Data->name(
682             'EmailAddress' => $subscriber->get_attribute( 'Email Address', 'is_live' => 0 ),
683             ),
684             );
685             }
686             else
687             {
688             # Reuse the existing identifiers.
689 0           push(
690             @object,
691             SOAP::Data->name(
692             'EmailAddress' => $subscriber->get_attribute( 'Email Address', 'is_live' => 1 ),
693             ),
694             SOAP::Data->name(
695             'ID' => $subscriber->id(),
696             ),
697             );
698             }
699              
700             # Add the staged properties for this subscriber.
701 0           my $properties = $subscriber->get_properties( is_live => 0 );
702 0           foreach my $name ( keys %$properties )
703             {
704 0           push(
705             @object,
706             SOAP::Data->name(
707             $name => $properties->{ $name }
708             )
709             );
710             }
711              
712             # Add the new values for attributes and list subscriptions.
713             push(
714 0           @object,
715             $self->_soap_format_attributes( $subscriber->get_attributes( 'is_live' => 0 ) ),
716             $self->_soap_format_lists(
717             'current' => $subscriber->get_lists_status( 'is_live' => 1 ),
718             'staged' => $subscriber->get_lists_status( 'is_live' => 0 ),
719             ),
720             );
721              
722             # Create the new subscriber block in the SOAP message.
723 0           push(
724             @soap_data,
725             SOAP::Data->name(
726             'Objects' => \SOAP::Data->value(
727             @object
728             ),
729             )->attr( { 'xsi:type' => 'Subscriber' } ),
730             );
731             }
732              
733             # Get Exact Target's reply.
734 0           my $soap_response = $exact_target->soap_call(
735             'action' => $args{'soap_action'},
736             'method' => $args{'soap_method'},
737             'arguments' =>
738             [
739             SOAP::Data->value(
740             @soap_data
741             )
742             ],
743             );
744              
745 0           my @soap_params_out = $soap_response->paramsall();
746 0           my $soap_success = pop( @soap_params_out );
747 0           my $soap_request_id = pop( @soap_params_out );
748              
749             # Check for errors.
750 0 0         confess Dumper( $soap_response->fault() )
751             if defined( $soap_response->fault() );
752              
753 0 0 0       my $batch_success = defined( $soap_success ) && ( $soap_success eq 'OK' )
754             ? 1
755             : 0;
756              
757             # Check the detail of the response for each object, and update accordingly.
758 0           my %update_details = ();
759 0           foreach my $param_out ( @soap_params_out )
760             {
761 0           $update_details{ $param_out->{'Object'}->{'EmailAddress'} } = $param_out;
762             }
763 0           foreach my $subscriber ( @$subscribers )
764             {
765 0 0         my $email = $args{'soap_action'} eq 'Create'
766             ? $subscriber->get_attribute('Email Address', is_live => 0 )
767             : $subscriber->get_attribute('Email Address');
768              
769 0           my $update_details = $update_details{ $email };
770              
771             # Check the individual status code to determine if the update for that
772             # subscriber was successful.
773 0 0         if ( $update_details->{'StatusCode'} ne 'OK' )
774             {
775 0           $subscriber->add_error( $update_details->{'StatusMessage'} );
776 0           next;
777             }
778              
779             # Set the ExactTarget ID on the current object.
780 0 0         if ( defined( $update_details->{'Object'}->{'ID'} ) )
781             {
782 0 0         if ( defined( $subscriber->id() ) )
783             {
784 0 0         confess 'The subscriber object ID was ' . $subscriber->id() . ' locally, '
785             . 'but ExactTarget now claims it is ' . $update_details->{'Object'}->{'ID'}
786             if $subscriber->id() != $update_details->{'Object'}->{'ID'};
787             }
788             else
789             {
790 0           $subscriber->id( $update_details->{'Object'}->{'ID'} );
791             }
792             }
793              
794             # Apply the staged attributes that ExactTarget reports as updated.
795 0 0         if ( defined ( $update_details->{'Object'}->{'Attributes'} ) )
796             {
797 0 0         my $attributes = Data::Validate::Type::is_arrayref( $update_details->{'Object'}->{'Attributes'} )
798             ? $update_details->{'Object'}->{'Attributes'}
799             : [ $update_details->{'Object'}->{'Attributes'} ];
800              
801 0           $subscriber->apply_staged_attributes(
802 0           [ map { $_->{'Name'} } @$attributes ]
803             );
804             }
805              
806             # Apply the staged list status updates.
807 0 0         if ( defined ( $update_details->{'Object'}->{'Lists'} ) )
808             {
809 0 0         my $lists = Data::Validate::Type::is_arrayref( $update_details->{'Object'}->{'Lists'} )
810             ? $update_details->{'Object'}->{'Lists'}
811             : [ $update_details->{'Object'}->{'Lists'} ];
812              
813 0           $subscriber->apply_staged_lists_status(
814             {
815             map
816 0           { $_->{'ID'} => $_->{'Status'} }
817             @$lists
818             }
819             );
820             }
821              
822             # Make sure that all the staged updates have been performed by ExactTarget.
823 0           my $attributes_remaining = $subscriber->get_attributes( 'is_live' => 0 );
824 0 0         if ( scalar( keys %$attributes_remaining ) != 0 )
825             {
826 0           $subscriber->add_error('The following staged changes were not applied: ' . join(', ', keys %$attributes_remaining ) . '.' );
827             }
828 0           my $lists_remaining = $subscriber->get_lists_status( 'is_live' => 0 );
829 0 0         if ( scalar( keys %$lists_remaining ) != 0 )
830             {
831 0           $subscriber->add_error(
832             "The following staged lists status changes were not applied:\n"
833 0           . join( "\n", map { " $_ => $lists_remaining->{$_}" } keys %$lists_remaining )
834             );
835             }
836             }
837              
838 0           return $batch_success;
839             }
840              
841              
842             =head2 _soap_format_lists()
843              
844             Formats the lists subscription changes passed as a hashref for inclusion in the
845             SOAP messages.
846              
847             my $soap_lists = $self->_soap_format_lists( $lists );
848              
849             See http://wiki.memberlandingpages.com/API_References/Web_Service_Guide/_Technical_Articles/Managing_Subscribers_On_Lists.
850              
851             =cut
852              
853             sub _soap_format_lists
854             {
855 0     0     my ( $self, %args ) = @_;
856              
857 0           my $status_current = $args{'current'};
858 0           my $status_staged = $args{'staged'};
859              
860 0 0         confess 'Current lists status not defined'
861             unless defined( $status_current );
862              
863 0 0         confess 'Staged lists status not defined'
864             unless defined( $status_staged );
865              
866 0           my @lists = ();
867 0           foreach my $list_id ( keys %$status_staged )
868             {
869 0 0         push(
870             @lists,
871             SOAP::Data->name(
872             'Lists' => \SOAP::Data->value(
873             SOAP::Data->name(
874             'ID' => $list_id,
875             ),
876             SOAP::Data->name(
877             'Status' => $status_staged->{$list_id},
878             ),
879             SOAP::Data->name(
880             'Action' => defined( $status_current->{$list_id} )
881             ? 'update'
882             : 'create',
883             ),
884             ),
885             ),
886             );
887             }
888              
889 0           return @lists;
890             }
891              
892              
893             =head2 _soap_format_attributes()
894              
895             Formats the attributes passed as a hashref for inclusion in the SOAP messages.
896              
897             my $soap_attributes = $self->_soap_format_attributes( $attributes );
898              
899             =cut
900              
901             sub _soap_format_attributes
902             {
903 0     0     my ( $self, $attributes ) = @_;
904              
905 0 0         confess 'Attributes not defined'
906             unless defined( $attributes );
907              
908 0 0         if ( $self->exact_target()->unaccent() )
909             {
910 0           foreach my $attribute ( keys %$attributes )
911             {
912 0 0         next if !defined( $attributes->{ $attribute } );
913              
914 0           $attributes->{ $attribute } = Text::Unaccent::unac_string(
915             'latin1',
916             $attributes->{ $attribute },
917             );
918             }
919             }
920              
921 0           my @attribute = ();
922 0           foreach my $name ( keys %{ $attributes } )
  0            
923             {
924 0           push(
925             @attribute,
926             SOAP::Data->name(
927             'Attributes' => \SOAP::Data->value(
928             SOAP::Data->name(
929             'Name' => $name,
930             ),
931             SOAP::Data->name(
932             'Value' => $attributes->{$name},
933             ),
934             ),
935             ),
936             );
937             }
938              
939 0           return @attribute;
940             }
941              
942              
943             =head1 BUGS
944              
945             Please report any bugs or feature requests through the web interface at
946             L.
947             I will be notified, and then you'll automatically be notified of progress on
948             your bug as I make changes.
949              
950              
951             =head1 SUPPORT
952              
953             You can find documentation for this module with the perldoc command.
954              
955             perldoc Email::ExactTarget::SubscriberOperations
956              
957              
958             You can also look for information at:
959              
960             =over 4
961              
962             =item * GitHub's request tracker
963              
964             L
965              
966             =item * AnnoCPAN: Annotated CPAN documentation
967              
968             L
969              
970             =item * CPAN Ratings
971              
972             L
973              
974             =item * MetaCPAN
975              
976             L
977              
978             =back
979              
980              
981             =head1 AUTHOR
982              
983             L,
984             C<< >>.
985              
986              
987             =head1 COPYRIGHT & LICENSE
988              
989             Copyright 2009-2014 Guillaume Aubert.
990              
991             This program is free software: you can redistribute it and/or modify it under
992             the terms of the GNU General Public License version 3 as published by the Free
993             Software Foundation.
994              
995             This program is distributed in the hope that it will be useful, but WITHOUT ANY
996             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
997             PARTICULAR PURPOSE. See the GNU General Public License for more details.
998              
999             You should have received a copy of the GNU General Public License along with
1000             this program. If not, see http://www.gnu.org/licenses/
1001              
1002             =cut
1003              
1004             1;