sync.pl
—
text/x-perl,
2 KB (2222 bytes)
File contents
#!/usr/bin/perl # # Small script to synchronise Sympa list with local list of addresses. # Demonstrates API defined at https://lists.cam.ac.uk/sympasoap/wsdl # # REVIEW : get list of emails on list # ADD : Add subscriber to list # DEL : Remove subscriber from list use strict; use warnings; use SOAP::Lite; # libsoap-lite-perl use HTTP::Cookies; # libhttp-cookies-perl use Term::ReadPassword; # libterm-readpassword-perl my $quiet = "true"; my $listname_regexp = '^[\w\-]+$'; my $email_regexp = '^\s*(\S+\@\S+\.\S+[^.\s])\s*$'; (@ARGV == 3) or die "$0: listname owner data-file\n"; my $soap_url = "https://lists.cam.ac.uk/sympasoap/wsdl"; my $listname = $ARGV[0]; my $owner = $ARGV[1]; my $datafile = $ARGV[2]; ($listname =~ m&$listname_regexp&) or die "Invalid listname: $listname\n"; ($owner =~ m&${email_regexp}&o) or die "Invalid owner: $owner\n"; open my $fh, "<", $datafile or die "Failed to open $datafile: $!\n"; my %required = (); while (<$fh>) { next if (m&^#& or m&^\s*$&); m&${email_regexp}&o or die "Invalid email address in $datafile: $_\n"; $required{$1} = 1; } close($fh); my $password = read_password("$owner Password: "); my $cookie_jar = HTTP::Cookies->new(); my $soap = SOAP::Lite->proxy($soap_url, cookie_jar => $cookie_jar ); $soap->default_ns('urn:sympasoap'); my $obj = $soap->login($owner, $password); ($obj->fault) and die "Login failed: " . $obj->faultstring . "\n"; $obj = $soap->review( $listname ); ($obj->fault) and die "REVIEW failed: " . $obj->faultstring . "\n"; my %existing = (); foreach my $email (@{$obj->result}) { next if ($email eq "no_subscribers"); # Unhelpful quirk of REVIEW $existing{$email} = 1; } foreach my $email (sort keys %existing) { next if $required{$email}; print "Removing: $email\n"; $obj = $soap->del($listname, $email, $quiet); ($obj->fault) and die "Error removing $email: " . $obj->faultstring; } foreach my $email (sort keys %required) { next if $existing{$email}; print "Adding: $email\n"; my $obj = $soap->add($listname, $email, '', $quiet ); ($obj->fault) and die "Error adding $email: " . $obj->faultstring; }