home *** CD-ROM | disk | FTP | other *** search
/ linuxmafia.com 2016 / linuxmafia.com.tar / linuxmafia.com / pub / linux / utilities-general / mailmandelete.script < prev    next >
Text File  |  2005-01-21  |  2KB  |  51 lines
  1. #!/usr/bin/perl
  2. # Created by Jimmy O'Regan
  3.  
  4. ## This script was intended by its author to be called "admreqrm-2.pl",
  5. ## but for some reason Apache httpd refuses to offer the public access
  6. ## to any file of that name.
  7. ##
  8. ## Script to automate the deletion of spam from Mailman's admin queue,
  9. ## via screen-scraping and filling in of the required fields on the 
  10. ## administrative Web forms.  Requires a reasonable Perl installation 
  11. ## and the WWW::Mechanize module from CPAN.  WARNING:  This script will
  12. ## delete ALL of a specified Mailman mailing list's current held mail,
  13. ## so you'll want to clear any exceptions manually before running it.
  14. ##
  15. ## Discussion that produced this script can be read here:
  16. ## http://linuxgazette.net/110/tag/8.html
  17.  
  18. use warnings;
  19. use strict;
  20. use WWW::Mechanize;
  21.  
  22. ##### User-configurable variables #######################
  23. my $password = 'PASSWORD';
  24. my $url = 'URL';
  25.  
  26. # Set to non-zero to generate a troubleshooting log
  27. my $debug = 0;
  28. ##### Past this point, There Be Dragons... ##############
  29.  
  30. my ( $mech, $content, %name ) = WWW::Mechanize -> new();
  31. $mech -> get( $url );
  32. $mech -> submit_form( fields => { adminpw => $password } );
  33. $content = $mech -> content();
  34.  
  35. die "\u$&.\n" if $content =~ /no pending requests/;
  36.  
  37. for ( grep /^senderaction-/, split /[ \n"']/, $content ){
  38.     unless ( exists $name{ $_ } ){
  39.         print "Deleting $_\n";
  40.         $name{ $_ } = 3;
  41.     }
  42. }
  43.  
  44. $mech -> submit_form( fields => \%name );
  45.  
  46. if ( $debug ){
  47.     use Data::Dumper;
  48.     open Fh, ">admreqrm.log" or die "Can't open log  $!\n";
  49.     print Fh Dumper( %{ $mech->response() } );
  50. }
  51.