#!/usr/bin/perl

our $VERSION='1.20100527';	# Please use format: major_revision.YYYYMMDD[hh24mi]

######################################################################

=head1 NAME

general_imis_password_generator.pl - Generate and email passwords for users to log in to iMIS

=head1 SYNOPSIS

3 operation modes

A) Designed to run automatically each evening, and create new passwords for new users
B) Can be run adhoc on demand to reset a users password
C) To run one time in "batch" for creating/sending all users initial passwords.

=head1 USAGE

	$0 (auto|one|all) [id for one]

        eg: general_imis_password_generator auto

        simply run this program on the General's iMIS server
        - it will connect to iMIS and do its magic
        - it will generate the passwords
	- it will send the emails out

=head1 To recreate the .exe:

	del general_imis_password_generator.exe & "C:\Program Files (x86)\ActiveState Perl Dev Kit 8.1\bin\perlapp.exe" --norunlib --target windows-x86-32 --exe general_imis_password_generator.exe general_imis_password_generator.pl & copy /y general_imis_password_generator.* F:\

=head1 iMIS password notes

perl -e 'use MIME::Base64(); use Digest::SHA1 qw(sha1); $password="helloworld"; $salt=rand(); print MIME::Base64::encode($salt); $password=~s/(.)/$1\000/g; print MIME::Base64::encode(sha1($salt . $password));'

=head2 Change Log


=head1 SUBROUTINES

=cut

######################################################################

use strict;
use Win32::OLE;                 # For SQL
use MIME::Lite;			# To send emails
use MIME::Base64;		# Needed to log in for sending emails
use Authen::SASL;		# Needed to log in for sending emails
use Digest::SHA1 qw(sha1);	# To encrypt passwords
use Data::Dumper;

my $cnt=0;			# temp counter
my $debug=1;

@::monthname=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');

# while(1) { print &MakePass() . "\n"; };


&write_log("General iMIS password tool v$VERSION\n");

my($folder)=($0=~/(.*)[\\\/]/);
chdir($folder) if($folder);

&mydie("Usage: $0 (auto|one|all) [id] [mail]") unless($ARGV[0]=~/^(auto|one|all)$/);

# Specify how to originate the email (eg: our mail server)
if($ENV{'USERDOMAIN'} eq 'TEST-SERVER') { # test environment
  MIME::Lite->send('smtp','test.com' , Timeout=>60);
} else {
  MIME::Lite->send('smtp','127.0.0.1' , Timeout=>260, AuthUser=>'Senderaccount', AuthPass=>crypt("some","thing"));
}

my($RS,$Statement,$endr,$id,$cols,@col);

my $Conn = &General_Connect_DB();

my %ClubName=&LoadClubNames();
my %EndorsementCodes=&LoadEndorsementCodes();


if($ARGV[0] eq 'one') {
  my $msg=&DoOne($ARGV[1]);
  &mydie($msg) unless($msg eq '');
} elsif($ARGV[0] eq 'auto') {
  my @toworkon;

  $Statement = "select id from name where email like '%@%' and id not in (select UserName from aspnet_users )"; # -- Who do we need to create logins for? (WARNING: need to ignore some!!)
  print STDERR "Executing $Statement\n" if($debug);
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  while (! $RS->EOF) {
    push @toworkon,$RS->Fields(0)->value if($RS->Fields(0)->value=~/^\d\d+$/);
    $RS->MoveNext;
  }
  $RS->Close;
  print STDERR "Updating " . (1+$#toworkon) . " members...\n" if($debug);
  foreach my $id (@toworkon) {
    my $msg=&DoOne($id);
    print STDERR "$msg\n" unless($msg eq '');
  }

} elsif($ARGV[0] eq 'all') {

  my @toworkon;

  $Statement = "select id from name";
  print STDERR "Executing $Statement\n" if($debug);
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  while (! $RS->EOF) {
    push @toworkon,$RS->Fields(0)->value if($RS->Fields(0)->value=~/^\d\d+$/);
    $RS->MoveNext;
  }
  $RS->Close;
  print STDERR "Updating " . (1+$#toworkon) . " members...\n" if($debug);
  foreach my $id (@toworkon) {
    my $msg=&DoOne($id);
    print STDERR "$msg\n" unless($msg eq '');
  }
}





$Conn->Close;

print STDERR "Complete success.\n";
#print STDERR "Wrote $recs member records to $outfn\n" if($outfn);
print STDERR "  Pausing 10 seconds before exit...\n" unless($::db eq 'generaldb');
sleep(10) unless($::db eq 'generaldb');

exit(0);



sub generalemail {
  my($member,$passwordplain)=@_;

  # $member  =  'n.LAST_NAME' => 'Drake',
  #             'n.FIRST_NAME' => 'Christopher',
  #             'n.PAID_THRU' => '30 Jun 2010',
  #             'n.EMAIL' => 'christopher@pobox.com',
  #             'n.id' => '16680',

### Start with a simple text message:
my  $msg = MIME::Lite->new(
        From    =>'General Office Automation <office@general.asn.au>',
        To      =>$member->{'n.EMAIL'},
#        Cc      =>'office@general.asn.au',	# Temp for first run
        Subject =>"Welcome to General-Online.  Here is your logon username and password.",
        Type    =>'TEXT',
	Encoding=>'quoted-printable',
        Data    => "Dear $member->{'n.FIRST_NAME'} $member->{'n.LAST_NAME'},

Welcome to the General's online membership system, called iMIS.

A new account has just been created for you.

   Your Logon ID = $member->{'n.id'}
   Your Password = $passwordplain
   The Logon URL = https://ssl.general.asn.au/

Your online account can be used to check and update your details
(address, email, phone, etc), and pay your membership renewals.
Note that our iMIS system is not the same as our forums - your forum
ID and password have not been changed.

Kind Regards,
Chris Drake
General I.T. & 2010-2012 Board.
",
    );

eval('$msg->send;');	# eval - To stop it ending if it hits a dud email addy

&write_log("Emailled to $member->{'n.EMAIL'}");

} # generalemail



sub mydie {
  my($msg)=@_;
  print STDERR "\n\n$msg\n";
  print STDERR "\n  Pausing 10 seconds before exit...\n";
  sleep(10);
  exit(1);
} # mydie







#######################################################################

=head2 Create/update a user login/password

=cut
#######################################################################

sub DoOne {
  my($id)=@_;

  # Check member exists
  my $member=&LoadMember($id);							warn Data::Dumper->Dump([\$member],['$member']) if($debug);
  # $member  =	'n.LAST_NAME' => 'Drake',
  #		'n.FIRST_NAME' => 'Christopher',
  #		'n.PAID_THRU' => '30 Jun 2010',
  #		'n.EMAIL' => 'christopher@pobox.com',
  #		'n.id' => '16680',
  #		etc...

  return "Member '$id' not found!" unless($id eq $member->{'n.id'});
  return "Cannot give login to members without email addresses - please add an email to member '$id' and try again!" unless($member->{'n.EMAIL'}=~/\@/);

  my $memberlogin=&LoadMemberLogin($id);						warn Data::Dumper->Dump([\$memberlogin],['$memberlogin'])  if($debug);

  return "Member '$id' login record missing!" unless($id eq $memberlogin->{'iMISMemberID'});

  my $name_security=&CheckOrAdd_name_security($id,$memberlogin);			warn Data::Dumper->Dump([\$name_security],['$name_security']) if($debug);

  my $grp=&CheckOrAdd_name_security_groups($id); 					warn "grp=$grp" if($debug);

  my $aspnet_users=&CheckOrAdd_aspnet_users($id);					warn Data::Dumper->Dump([\$aspnet_users],['$aspnet_users']) if($debug); 

  my $password=&MakePass(); 
  my $salt=rand();
  my $passwordplain=$password;
  $password=~s/(.)/$1\000/g; 
  $password=MIME::Base64::encode(sha1($salt . $password)); chomp($password);
  $salt=MIME::Base64::encode($salt); chomp($salt);

  print STDERR "salt=$salt\n" if($debug);
  print STDERR "password=$password ($passwordplain)\n" if($debug);

  my $aspnet_Membership=&CheckOrAdd_aspnet_Membership(1,$id,$aspnet_users,$member,$salt,$password,$passwordplain);	warn Data::Dumper->Dump([\$aspnet_Membership],['$aspnet_Membership']) if($debug); 
  my $usermain=&CheckOrAdd_usermain($id,$aspnet_users,$member);						warn Data::Dumper->Dump([\$usermain],['$usermain']) if($debug); 

  print "$id\t$$member{'n.EMAIL'}\t$$member{'n.FIRST_NAME'}\t$$member{'n.LAST_NAME'}\t$passwordplain\n";

  &generalemail($member,$passwordplain);

  return '';
} # one



#######################################################################

=head2 Put the password into the notes

=cut
#######################################################################

sub NotePassword {
  my($id,$password)=@_;
  my $Statement = "select note from name_note where id='$id' and purpose='General'";
  print STDERR "Executing $Statement\nfor " . join(',',@col) . "\n" if($debug);

  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  if($RS->EOF) {        # none found.
    $RS->Close;
    my $Statement2="select max(note_num)+1 from name_note";
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    my $newid=$RS->Fields(0)->value;
    $RS->Close;
    $Statement2=qq[insert into name_note(ID,NOTE_NUM,PURPOSE,NOTE,DATE_ADDED,LAST_UPDATED,UPDATED_BY) values('$id',$newid,'General','iMIS_Web_Autopassword="$password";',getdate(),getdate(),'SCRIPT')]; 
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    $RS->Close;
    return; # Done.
  }
  my $note=$RS->Fields(0)->value;
  if($note=~/(.*iMIS_Web_Autopassword=")([^"]+)(";.*)/ism) {
    $note=$1 . $password . $3;
  } else {
    $note=qq(iMIS_Web_Autopassword="$password";\r\n$note);
  }

  $RS->Close;

  $note=~s/'/''/g;

  $Statement = "update name_note set note='$note' where id='$id'";
  print STDERR "Executing $Statement\nfor " . join(',',@col) . "\n" if($debug);

  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }

  $RS->Close;
} # NotePassword








#######################################################################

=head2 Find, or populate, the usermain table

=cut
#######################################################################

sub CheckOrAdd_usermain {
  my($id,$aspnet_users,$member)=@_;
  my $p;

  $Statement = "select UserKey,ContactMaster,UserId,IsDisabled,EffectiveDate,ExpirationDate,UpdatedByUserKey,UpdatedOn,CreatedByUserKey,CreatedOn,MarkedForDeleteOn,DefaultDepartmentGroupKey,DefaultPerspectiveKey,ProviderKey from usermain where UserKey in (select ContactKey from dbo.ContactMain where id='$id')";
  ($cols)=($Statement=~/select\s+(.*?)\s+from\b/ism); $cols=~s/case\s+when.*?end\s+as\s+([^,]+)/$1/ismg; $cols=~s/[\s+\n]//g; $cols=~s/CONVERT\(.*?,([^,]+).*?\)/$1/ig; $cols=~s/CAST\(.*?\(([a-zA-Z0-9\.\_]+)\).*?\],/$1,/ig; @col=split(/,/,$cols);
  print STDERR "Executing $Statement\nfor " . join(',',@col) . "\n" if($debug);
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }


#  $Statement = "select UserKey,ContactMaster,UserId,IsDisabled,EffectiveDate,ExpirationDate,UpdatedByUserKey,UpdatedOn,CreatedByUserKey,CreatedOn,MarkedForDeleteOn,DefaultDepartmentGroupKey,DefaultPerspectiveKey,ProviderKey from usermain where UserId='$id'";
#  ($cols)=($Statement=~/select\s+(.*?)\s+from\b/ism); $cols=~s/case\s+when.*?end\s+as\s+([^,]+)/$1/ismg; $cols=~s/[\s+\n]//g; $cols=~s/CONVERT\(.*?,([^,]+).*?\)/$1/ig; $cols=~s/CAST\(.*?\(([a-zA-Z0-9\.\_]+)\).*?\],/$1,/ig; @col=split(/,/,$cols);
#  print STDERR "Executing $Statement\nfor " . join(',',@col) . "\n" if($debug);
# if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }




  if($RS->EOF) {        # none found.
    $RS->Close;
    my $pc=lc($$aspnet_users{'UserId'}); $pc=~s/[\{\}]//g;
    # my $Statement2 = "insert into usermain(UserKey,ContactMaster,UserId,IsDisabled,EffectiveDate,ExpirationDate,UpdatedByUserKey,UpdatedOn,CreatedByUserKey,CreatedOn,MarkedForDeleteOn,DefaultDepartmentGroupKey,DefaultPerspectiveKey,ProviderKey) (select ContactKey,ID,ID,0,getdate(),null,UpdatedByUserKey,getdate(),CreatedByUserKey,CreatedOn,MarkedForDeleteOn,'7B56AF82-CC15-41DB-A204-C342AB251A3D','3391C497-FAA5-4944-B60F-9AD04C0B5B70','$$aspnet_users{'UserId'}' from dbo.ContactMain where id='$id')"; # Works - but different...
    my $Statement2 = "insert into usermain(UserKey,ContactMaster,UserId,IsDisabled,EffectiveDate,ExpirationDate,UpdatedByUserKey,UpdatedOn,CreatedByUserKey,CreatedOn,MarkedForDeleteOn,DefaultDepartmentGroupKey,DefaultPerspectiveKey,ProviderKey) (select ContactKey,ID,ID,0,getdate(),null,UpdatedByUserKey,getdate(),CreatedByUserKey,CreatedOn,MarkedForDeleteOn,'7B56AF82-CC15-41DB-A204-C342AB251A3D','3391C497-FAA5-4944-B60F-9AD04C0B5B70','$pc' from dbo.ContactMain where id='$id')";

    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    $RS->Close;
    if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; } # Re-run the lookup
  }
  
  &mydie("Problem adding $id to table usermain") if($RS->EOF);
  
  for(my $i=0;$i<=$#col;$i++) {$p->{$col[$i]}=$RS->Fields($i)->value;}    # eg: $p->{n.EMAIL}='bill@moyes.com.au';
  
  $RS->Close;
  return $p;
} # CheckOrAdd_usermain








#######################################################################

=head2 Find, or populate, the aspnet_Membership table

=cut
#######################################################################

sub CheckOrAdd_aspnet_Membership {
  my($changepass,$id,$aspnet_users,$member,$salt,$password,$passwordplain)=@_;
  my $p;
  $Statement = "select ApplicationId,UserId,Password,PasswordFormat,PasswordSalt,MobilePIN,Email,LoweredEmail,PasswordQuestion,PasswordAnswer,IsApproved,IsLockedOut,CreateDate,LastLoginDate,LastPasswordChangedDate,LastLockoutDate,FailedPasswordAttemptCount,FailedPasswordAttemptWindowStart,FailedPasswordAnswerAttemptCount,FailedPasswordAnswerAttemptWindowStart,Comment from aspnet_Membership where UserId='$$aspnet_users{'UserId'}'";
  ($cols)=($Statement=~/select\s+(.*?)\s+from\b/ism); $cols=~s/case\s+when.*?end\s+as\s+([^,]+)/$1/ismg; $cols=~s/[\s+\n]//g; $cols=~s/CONVERT\(.*?,([^,]+).*?\)/$1/ig; $cols=~s/CAST\(.*?\(([a-zA-Z0-9\.\_]+)\).*?\],/$1,/ig; @col=split(/,/,$cols);
  print STDERR "Executing $Statement\nfor " . join(',',@col) . "\n" if($debug);
  
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  if($RS->EOF) {        # none found.
    $RS->Close;
   
    $$member{'n.EMAIL'}=~s/'/''/g;
 
    my $Statement2 = "insert into aspnet_Membership(ApplicationId,UserId,Password,PasswordFormat,PasswordSalt,Email,LoweredEmail,PasswordQuestion,PasswordAnswer,IsApproved,IsLockedOut,CreateDate,LastLoginDate,LastPasswordChangedDate,LastLockoutDate,FailedPasswordAttemptCount,FailedPasswordAttemptWindowStart,FailedPasswordAnswerAttemptCount,FailedPasswordAnswerAttemptWindowStart) values ('$$aspnet_users{'ApplicationId'}','$$aspnet_users{'UserId'}','$password',1,'$salt','$$member{'n.EMAIL'}','". lc($$member{'n.EMAIL'}) ."','Check your renewal notice or email for your password','$password',1,0,getdate(),getdate(),getdate(),getdate(),0,getdate(),0,getdate())";
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    $RS->Close;

    $changepass=0;	# No need to update - we just created it...
    &NotePassword($id,$passwordplain);

    # Re-run the lookup
    if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  }
  if($changepass) {
    $RS->Close;
    
    my $Statement2 = "update aspnet_Membership set Password='$password',PasswordSalt='$salt',LastPasswordChangedDate=getdate() where UserId='$$aspnet_users{'UserId'}'";
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    $RS->Close;
    &NotePassword($id,$passwordplain);
    
    # Re-run the lookup
    if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  }

  &mydie("Problem adding $id to table aspnet_Membership") if($RS->EOF);
  
  for(my $i=0;$i<=$#col;$i++) {$p->{$col[$i]}=$RS->Fields($i)->value;}    # eg: $p->{n.EMAIL}='bill@moyes.com.au';
  
  $RS->Close;
  return $p;
} # CheckOrAdd_aspnet_Membership







#######################################################################

=head2 Find, or populate, the aspnet_users table

=cut
#######################################################################

sub CheckOrAdd_aspnet_users {
  my($id)=@_;
  my $p;
  $Statement = "select ApplicationId,UserId,UserName,LoweredUserName,MobileAlias,IsAnonymous,LastActivityDate from aspnet_users where username='$id'";
  ($cols)=($Statement=~/select\s+(.*?)\s+from\b/ism); $cols=~s/case\s+when.*?end\s+as\s+([^,]+)/$1/ismg; $cols=~s/[\s+\n]//g; $cols=~s/CONVERT\(.*?,([^,]+).*?\)/$1/ig; $cols=~s/CAST\(.*?\(([a-zA-Z0-9\.\_]+)\).*?\],/$1,/ig; @col=split(/,/,$cols);
  print STDERR "Executing $Statement\nfor " . join(',',@col) . "\n" if($debug);

  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  if($RS->EOF) {        # none found.
    $RS->Close;
    my $Statement2 = "select ApplicationId,count(*) from aspnet_users group by ApplicationId";
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    my $aid=$RS->Fields(0)->value;
    $RS->Close;
    &mydie("Problem getting ApplicationId") unless($aid=~/-/);	# AEC54F5A-2073-4AE5-8A23-2DC1D5CD52D9

    $Statement2 = "insert into aspnet_users(ApplicationId,UserName,LoweredUserName,LastActivityDate) values ('$aid','$id','$id',getdate())";	# Creates a UserId for us.
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    $RS->Close;

    # Re-run the lookup
    if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  }
  &mydie("Problem adding $id to table aspnet_users") if($RS->EOF);

  for(my $i=0;$i<=$#col;$i++) {$p->{$col[$i]}=$RS->Fields($i)->value;}    # eg: $p->{n.EMAIL}='bill@moyes.com.au';

  $RS->Close;
  return $p;
} # CheckOrAdd_aspnet_users







#######################################################################

=head2 Find, or populate, the legacy name_security table

=cut
#######################################################################

sub CheckOrAdd_name_security {
  my($id,$memberlogin)=@_;
  my $p;
  $Statement = "select ID,LOGIN_DISABLED,WEB_LOGIN,PASSWORD,EXPIRATION_DATE,LAST_LOGIN,PREVIOUS_LOGIN,ContactID,TIME_STAMP,UPDATED_BY from name_security where id='$id'";
  ($cols)=($Statement=~/select\s+(.*?)\s+from\b/ism); $cols=~s/case\s+when.*?end\s+as\s+([^,]+)/$1/ismg; $cols=~s/[\s+\n]//g; $cols=~s/CONVERT\(.*?,([^,]+).*?\)/$1/ig; $cols=~s/CAST\(.*?\(([a-zA-Z0-9\.\_]+)\).*?\],/$1,/ig; @col=split(/,/,$cols);
  print STDERR "Executing $Statement\nfor " . join(',',@col) . "\n" if($debug);

  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  if($RS->EOF) {        # none found.
    $RS->Close;
    my $Statement2 = "insert into name_security(ID,LOGIN_DISABLED,WEB_LOGIN,PASSWORD,ContactID,UPDATED_BY) values('$id',0,'$id','','" . $memberlogin->{'ContactID'} . "','SCRIPT')";
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    $RS->Close;

    # Re-run the lookup
    if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  }
  &mydie("Problem adding $id to table name_security") if($RS->EOF);

  for(my $i=0;$i<=$#col;$i++) {$p->{$col[$i]}=$RS->Fields($i)->value;}    # eg: $p->{n.EMAIL}='bill@moyes.com.au';

  # &mydie("Sorry - existing id $$p{'WEB_LOGIN'} doesnt match member id '$id' - giving up") unless($id eq $$p{'WEB_LOGIN'});

  $RS->Close;

  # Fix or allocate them a WEB_LOGIN ID (same as their ID (General#))
  if($id ne $$p{'WEB_LOGIN'}) {
    my $Statement2 = "update name_security set WEB_LOGIN='$id',LOGIN_DISABLED=0,UPDATED_BY='SCRIPT' where ID='$id'";
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    $RS->Close;

    # Re-run the lookup
    if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
    for(my $i=0;$i<=$#col;$i++) {$p->{$col[$i]}=$RS->Fields($i)->value;}    # eg: $p->{n.EMAIL}='bill@moyes.com.au';
    $RS->Close;
  }

  &mydie("Sorry - existing id $$p{'WEB_LOGIN'} doesnt match member id '$id' - giving up") unless($id eq $$p{'WEB_LOGIN'});

  return $p;
} # CheckOrAdd_name_security








#######################################################################

=head2 Find, or populate, the legacy name_securityi_groups table

=cut
#######################################################################

sub CheckOrAdd_name_security_groups {
  my($id)=@_;
  $Statement = "select security_group from name_security_groups where id='$id'";
  print STDERR "Executing $Statement\n" if($debug);
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  if($RS->EOF) {	# none found.
    $RS->Close;
    my $Statement2 = "insert into name_security_groups(id,security_group) values('$id','Anonymous')";
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    $RS->Close;

    # Re-run the lookup
    if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  }
  &mydie("Problem adding $id to group 'Anonymous'") if($RS->EOF);

  my $grp=$RS->Fields(0)->value;
  $RS->Close;

  if($grp eq '') {
    my $Statement2 = "update name_security_groups set security_group='Anonymous' where id='$id'";
    print STDERR "Executing $Statement2\n" if($debug);
    if(! ($RS = $Conn->Execute($Statement2))) { print STDERR Win32::OLE->LastError() ; exit; }
    $RS->Close;

    # Re-run the lookup
    if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
    $grp=$RS->Fields(0)->value;
    $RS->Close;
  }

  &mydie("Sorry - we cannot adjust users in group '$grp' just now") unless($grp eq 'Anonymous');

  return $grp;
} # CheckOrAdd_name_security_groups







#######################################################################

=head2 Load the member himself

see also general_member_cardprint.pl / general_imis_password_generator.pl

=cut
#######################################################################

sub LoadMember {
  my($id)=@_;
  &mydie("Wrong member id: '$id'") unless($id =~/^\d+$/);
  my $wheren="and n.id='$id'";
  my($pEndorsement,$pEndorsementLong)=&LoadEndorsement($id);

  my %Member;

      $Statement = "SELECT n.co_id,title,n.company, n.id,
  	   case when n.paid_thru>=getdate() then 1 else 0 end as isfinancial,
  	   case when n.paid_thru>=(getdate()-90) then 1 else 0 end as lapsedqtr,
  	   case when n.paid_thru>=(getdate()-730) then 1 else 0 end as lapsedbiyr,
         n.PREFIX,n.FIRST_NAME,n.LAST_NAME,n.DESIGNATION,a.ADDRESS_1,a.ADDRESS_2,a.CITY,a.STATE_PROVINCE,a.ZIP,a.COUNTRY,n.CATEGORY,
         n.EMAIL,CONVERT(VARCHAR(11), n.PAID_THRU, 106),
         x.CLUB_LIST, x.HG_MEMBER, x.PG_MEMBER, x.WM_MEMBER, x.HG_HOURS, x.HG_HOURS_TOTAL, x.PG_HOURS, x.PG_HOURS_TOTAL, x.WM_HOURS, x.WM_HOURS_TOTAL, x.INST_HG, x.INST_PG, x.INST_WM, x.PPG_MEMBER, x.PPG_HOURS, x.PPG_HOURS_TOTAL,
         CONVERT(VARCHAR(11), w.effective_date, 106),
         work_phone,home_phone,n.toll_free,website,n.CHAPTER,n.MEMBER_TYPE, CAST(DAY(N.PAID_THRU) AS VARCHAR(2))+' '+DATENAME(MM,N.PAID_THRU)+' '+CAST(YEAR(N.PAID_THRU) AS VARCHAR(4)) AS [DD Month YYYY],0 
   from name_Address a, Name_Extra x, (Name n left join Activity w on n.id=w.id and w.ACTIVITY_TYPE='WAIVER')
  where n.id=x.id
    and n.id=a.id
    and a.preferred_bill=1
    $wheren
  order by n.LAST_NAME,n.FIRST_NAME";

  ($cols)=($Statement=~/select\s+(.*?)\s+from\b/ism); $cols=~s/case\s+when.*?end\s+as\s+([^,]+)/$1/ismg; $cols=~s/[\s+\n]//g; $cols=~s/CONVERT\(.*?,([^,]+).*?\)/$1/ig; $cols=~s/CAST\(.*?\(([a-zA-Z0-9\.\_]+)\).*?\],/$1,/ig; @col=split(/,/,$cols);
  print STDERR "Executing $Statement\n"; print STDERR "for " . join(',',@col) . "\n" if($debug);
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }; $cnt=0;

#      while (! $RS->EOF) {
        my %role; my $p=\%role;
  if(! $RS->EOF) {
        for(my $i=0;$i<=$#col;$i++) {$p->{$col[$i]}=$RS->Fields($i)->value;}	# eg: $p->{n.EMAIL}='bill@moyes.com.au';

        my %dc=();my @cl=split(/,/,$p->{'x.CLUB_LIST'});			# Expand club codes into club names
        foreach my $c (@cl) {my $desc=$ClubName{$c}; $desc=$c unless($desc); if(not defined $dc{$desc}) {$dc{$desc}++; $p->{'x.club_list_full'}.="$desc, ";}} $p->{'x.club_list_full'}=~s/, $//;
        $p->{'QUALS'}=$pEndorsement->{$p->{'n.id'}};
        $p->{'QUALSLONG'}=$pEndorsementLong->{$p->{'n.id'}};

  } # Club members

  $RS->Close;

  return $p;

} # LoadMember








#######################################################################

=head2 Load the member login record

=cut
#######################################################################

sub LoadMemberLogin {
  my($id)=@_;

  $Statement = "select ContactID,FirstName,LastName,EmailAddress,CompanyName,Title,UserName,PASSWORD,PasswordHint,BEMemberID,iMISMemberID,DisabledFlag,NumLogin,LastUpdateDateTime from login where iMISMemberID='$id'";
  ($cols)=($Statement=~/select\s+(.*?)\s+from\b/ism); $cols=~s/case\s+when.*?end\s+as\s+([^,]+)/$1/ismg; $cols=~s/[\s+\n]//g; $cols=~s/CONVERT\(.*?,([^,]+).*?\)/$1/ig; $cols=~s/CAST\(.*?\(([a-zA-Z0-9\.\_]+)\).*?\],/$1,/ig; @col=split(/,/,$cols);
  print STDERR "Executing $Statement\n"; print STDERR "for " . join(',',@col) . "\n" if($debug);
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }; $cnt=0;
  my %role; my $p=\%role;
  if(! $RS->EOF) {
    for(my $i=0;$i<=$#col;$i++) {$p->{$col[$i]}=$RS->Fields($i)->value;}    # eg: $p->{n.EMAIL}='bill@moyes.com.au';
  }

  $RS->Close;

  return $p;

} # LoadMemberLogin





#######################################################################

=head2 Club names.

Accumulate all Club names into %ClubName

=cut
#######################################################################
sub LoadClubNames {
  my(%ClubName,$clubc);
  $Statement = "select upper_code,description from gen_tables where table_name='CLUBLIST'";
  # Alternative way = (select club_list from name_extra a,name b where a.id=b.id and b.member_type='CLUB')
  print STDERR "Executing $Statement\n" if($debug);
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  while (! $RS->EOF) {
    $id=$RS->Fields(0)->value;
    $ClubName{$id}=$RS->Fields(1)->value;
    $RS->MoveNext;
    $clubc++;
  }
  $RS->Close;
  print STDERR "Loaded $clubc Clubs\n" if($debug);
  return %ClubName;
} # LoadClubNames








#######################################################################

=head2 Endorsements

Accumulates All the Endorsements THIS member owns into 2 hashes

=cut
#######################################################################
sub LoadEndorsement {
  my($id)=@_;
  my $where=" and id='$id' ";

  my(%Endorsement);
  my(%EndorsementLong,%dc2);
  my @meme;
  $Statement = "select id,product_code, CONVERT(VARCHAR(11), thru_date, 106) AS [DD MON YYYY],thru_date,0 from Activity where Activity.ACTIVITY_TYPE='QUALS' and (Activity.thru_date is null or Activity.thru_date>=getdate()) $where order by 1,2";
  print STDERR "Executing $Statement\n" if($debug);
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  $endr=0;
  while (! $RS->EOF) {
    $id=$RS->Fields(0)->value;	# General#
    my $desc=$EndorsementCodes{$RS->Fields(1)->value}; $desc=$RS->Fields(1)->value if($desc eq '');

    $desc .= '  (exp. ' . $RS->Fields(2)->value . ')' if($RS->Fields(3)->value ne '');	# Include expiry date
    push @meme,$desc;

    # Short codes
    $Endorsement{$id}.=', ' if($Endorsement{$id});        # Separate multiples with commas
    $Endorsement{$id}.=$RS->Fields(1)->value;

    # Long descriptions
    if(not defined $dc2{"$id.$desc"}) {
      $dc2{"$id.$desc"}++;
      $EndorsementLong{$id}.=', ' if($EndorsementLong{$id});        # Separate multiples with commas
      $EndorsementLong{$id}.=$desc;
    }

    $RS->MoveNext;
    $endr++;
  }
  $RS->Close;

  print STDERR "Loaded $endr Endorsements\n" if($debug);

  return(\%Endorsement,\%EndorsementLong);
} # LoadEndorsement














#######################################################################

=head2 Endorsement descriptions

Build a conversion hash for endorsement codes to their descriptions.

eg: PG-RSTRCT => Restricted (PG)	(or whatever)

####### See also general_billing.pl, and general_club_list_mailer.pl  #######

=cut
#######################################################################
sub LoadEndorsementCodes {

  my(%EndorsementCodes,$endorc);
  $Statement = "select upper_code,description from gen_tables where table_name in('GROUP_CODE','QUALS/QUALIFICATION') order by table_name"; # The order makes 'QUALS/QUALIFICATION' overwrite any 'GROUP_CODE' dupes
  print STDERR "Executing $Statement\n" if($debug);
  if(! ($RS = $Conn->Execute($Statement))) { print STDERR Win32::OLE->LastError() ; exit; }
  while (! $RS->EOF) {
    $id=$RS->Fields(0)->value;
    $EndorsementCodes{$id}=$RS->Fields(1)->value;
    $RS->MoveNext;
    $endorc++;
  }
  $EndorsementCodes{'None!'}='Member has no flying qualifications';
  $RS->Close;

  print STDERR "Loaded $endorc Endorsement codes\n"  if($debug);
  return %EndorsementCodes;
} # LoadEndorsementCodes












=for General_Connect_DB

Connects to the General database.

=cut

sub General_Connect_DB {
  
  print STDERR "Connecting to SQL...\n";
  
  
  # Provider=SQLOLEDB.1 or Provider=SQLNCLI.1
  my $db='imis';
  my $pw='my_password';
  my $srv='SERVER'; # 'TEST-SERVER'
  
  if($ENV{'USERDOMAIN'} eq 'TEST-SERVER') { # test environment
    $db='generaldb';
    $pw='';
    $srv='TEST-SERVER';
  }
  if($pw eq '') { print STDERR "pw?\n";$pw=<STDIN>; chomp($pw); }
  
  my $ConnStr;
  
  # Works always on local box:
  $ConnStr="Provider=SQLOLEDB;Integrated Security=SSPI;Persist Security Info=False;Data Source=(local);Initial Catalog=$db;us" . "e Procedure for Prepare=0;Connect Timeout=4;Trusted_Connection=Yes";
  
  # For remote boxen, use this instead:-
  $ConnStr="Provider=SQLOLEDB;Persist Security Info=False;Data Source=$srv;Initial Catalog=$db;us" . "e Procedure for Prepare=0;Connect Timeout=4;User ID=sa;Password=$pw" if($pw ne '');	# Works!

  # See also: C:\Program Files\ASI\iMIS15\bin\Asi.Workflow.Services.exe.config
  #   <add name="DataSource.iMIS.Connection" connectionString="server=TEST-SERVER;database=generaldb;uid=sa;pwd=mypwd;" />
  
  
  my $Conn = Win32::OLE-> new('ADODB.Connection');
  $Conn-> Open($ConnStr);
  my $err = Win32::OLE::LastError();
  if (not $err eq "0") { print STDERR "FATAL: no connection, OLE error 0x%08x: $err\n"; sleep(10);exit; } else { print STDERR "Connected OK\n\n"; }
  
  return $Conn;
  $::db=$db;
} # General_Connect_DB




##############################################################################

=head2 write_log

	Output a timestamped message with some detail

=cut
##############################################################################
sub write_log {
  my($message)=@_;
  my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  my($date)=sprintf("%02d/%02d %02d:%02d.%02d",$mon+1,$mday,$hour,$min,$sec);
  print STDERR "$date $$ $0 $message\n";  # stderr may be redirected to logfile
}

##############################################################################





sub MakePass {
  my @digit=qw(2 3 4 5 6 7 8 9);
  my @FourLetterWords=&FourLetterWords();
  my @SwearWords=&SwearWords();
  my($rude)=1; my $pass;
  while($rude) {
    $pass=$FourLetterWords[int(rand()*(1+$#FourLetterWords))] . $FourLetterWords[int(rand()*(1+$#FourLetterWords))] . $digit[int(rand()*(1+$#digit))];
    $rude=0;
    $pass=lc($pass);
    foreach my $swearword (@SwearWords) {
      $rude++ if($pass =~/$swearword/i);
    }
  }
  return $pass;
}



sub FourLetterWords {
return qw( aaas abbe abed abel abet able abut ache acid acme acre acts adam aden afar afro agee ague ahem ahoy aida aide aile ainu airy ajar ajax akin alai alan alba alec alex alga alia ally alma
	aloe alps also alto alum alva amen ames amid ammo amok amos amra andy anew anna anne ansi ante anti anus apex apse aqua arab arch area ares argo arid army arpa arty arum aryl ashy asia
	astm atom atop at&t aunt aura auto aver avid avis aviv avon avow away awry axes axis axle axon babe baby bach back bade bail bait bake baku bald bale bali balk ball balm band bane bang
	bank barb bard bare bark barn barr bart base bash bask bass bate bath batt baud bawd bawl bead beak beam bean bear beat beau beck beef been beep beer beet bela bell belt bema bend bent
	benz berg bern bert bess best beta beth bevy bhoy bias bibb bide bien bike bile bilk bill bind bing bini bird bite bitt blab blat bled blew blip blob bloc blot blow blue blum blur blvd
	boar boat boca bock bode body bogy bohr boil bois bold bole bolo bolt bomb bona bond bone bong bonn bony book boom boon boor boot bore borg born bose boss both bout bowl boxy boyd brad
	brae brag bran bray bred brew brig brim brow bryn bstj buck budd buff bulb bulk bull bump bunk bunt buoy burg burl burn burp burr burt bury bush buss bust busy butt buzz byrd byte cacm
	cady cafe cage cain cake calf call calm came camp cane cant cape capo card care carl carp carr cart case cash cask cast catv cave ccny cede ceil cell cent cern chad chao chap char chat
	chaw chef chen chew chic chin chip chit chop chou chow chub chug chum cite city clad clam clan clap claw clay clio clip clod clog clot cloy club clue cluj coal coat coax cobb coca cock
	coco coda code cody coed cohn coil coin coke cola cold cole colt coma comb come cone conn cony cook cool coon coop coot cope copy cord core cork corn corp cosh cost cosy coup cove cowl
	cozy crab crag cram crap craw crew crib crop crow crud crux cruz cuba cube cuff cull cult cuny curb curd cure curl curt cusp cute cyst czar dada dade dahl dais dale daly dame damn damp
	dana dane dang dank dare dark darn dart dash data date daub dave davy dawn daze dead deaf deal dean dear debt deck deed deem deep deer deft defy deja dell demo dent deny desk deus dewy
	dial dice dick dido died diem diet dill dime dine ding dint dire dirt disc dish disk diva dive dock dodd dodo doff doge dole doll dolt dome done doom door dope dora dose dote doug dour
	dove down doze drab drag dram draw dreg drew drib drip drop drub drug drum dual duck duct duel duet duff duke dull duly duma dumb dump dune dung dunk dunn dupe dusk dust duty dyad dyer
	dyke dyne each earl earn ease east easy eave eben echo eddy eden edge edgy edit edna eeoc egan eire elan elba ella else emil emit emma enid enol enos envy epic erda eric erie erik
	eros etch even evil exam exit eyed ezra face fact fade fail fain fair fake fall fame fang fare farm faro fast fate faun fawn faze fear feat feed feel feet fell felt fend fern fest fete
	feud fiat fide fief fife fifo file fill film find fine fink finn fire firm fish fisk fist five flag flak flam flap flat flaw flax flea fled flee flew flex flip flit floc floe flog flop
	flow flub flue flux foal foam foci fogy foil fold folk fond font food fool foot ford fore fork form fort foss foul four fowl foxy fran frau fray fred free fret frey frog from frye fuel
	fuji full fume fund funk furl fury fuse fuss fuzz gaff gage gail gain gait gala gale gall galt game gang gape garb gary gash gasp gate gaul gaur gave gawk gaze gear geld gene gent germ
	gibe gift gila gild gill gilt gina ginn gino gird girl gist give glad glee glen glib glob glom glow glue glum glut gnat gnaw goad goal goat goer goes goff gogh gogo gold golf gone gong
	good goof gore gory gosh gout gown grab grad gray greg grew grey grid grim grin grip grit grow grub guam gulf gull gulp gunk guru gush gust gwen gwyn gyro haag haas hack hahn hail hair
	hale half hall halo halt hand hang hank hans hard hare hark harm harp hart hash hasp hast hate hath haul have hawk hays haze hazy head heal heap hear heat hebe heck heed heel heft
	heir held hell helm help hemp hera herb herd here hero herr hess hewn hick hide high hike hill hilt hind hint hire hiss hive hoar hobo hock hoff hold hole holm holt home homo hone hong
	honk hood hoof hook hoop hoot hope horn hose host hour hove howe howl hoyt huck hued huff huge hugh hugo hulk hull hump hung hunk hunt hurd hurl hurt hush hyde hymn ibex ibid ibis icky
	icon idea idle idol ieee iffy ifni igor inca inch indy info into iota iowa ipso iran iraq iris irma iron isis isle itch item it&t ivan jack jacm jade jail jake jane java
	jazz jean jeep jeff jerk jess jest jibe jill jilt jinx jive joan jock joel joey john join joke jolt jose joss jove jowl juan judd jude judo judy juju juke july jump june junk juno jura
	jure jury just jute kahn kale kane kant karl karp kate katz kava kayo keel keen keep kelp kemp keno kent kept kern kerr keys khan kick kiev kill kilo kind king kink kirk kiss kite kiva
	kivu kiwi klan klux knee knew knit knob knot know knox koch kola kong kudo kuhn kurd kurt kyle lace lack lacy lady laid lain lair lake lamb lame lamp lana land lane lang lank laos lard
	lark lars lase lash lass last late lath laud laue lava lawn laze lazy lead leaf leak lean leap lear leek leer left lena lend lens lent leon less lest levi levy lewd liar lice lick lied
	lien lieu life lifo lift like lila lilt lily lima limb lime limp lind line link lint lion lisa lise lisp list live load loaf loam loan lobe lobo loci lock loeb loft loge logo loin lois
	loki lola loll lomb lome lone long look loom loon loop loot lope lord lore lose loss lost loud love lowe luck lucy luge luis luke lull lulu lump lund lung lura lure lurk lush lust lute
	lutz luxe lyle lynn lynx lyon lyra mace mach mack made magi maid mail maim main make male mali mall malt mana mane mann mans many marc mare mark mars mart marx mary mash mask mass mast
	mate math maul mawr maya mayo maze mead meal mean meat meek meet meld melt memo mend menu mere mesa mesh mess mete mica mice mien miff mike mila mild mile milk mill milt mimi mind mine
	mini mink mint mira mire miss mist mite mitt moan moat mock mode moen mohr mold mole moll molt mona monk mont mood moon moor moot more morn mort moss most moth move much muck mudd muff
	muir mule mull mung muon murk muse mush musk must mute mutt muzo myel myra myth nagy nail nair name nape nary nasa nash nate nato nave navy nazi ncaa ncar neal neap near neat neck need
	neff neil nell neon nero ness nest neva neve newt next nibs nice nick nigh nile nimh nina nine noaa noah node noel noll nolo none nook noon nora norm nose note noun nova novo ntis nude
	null numb oath obey oboe odin ogle ogre ohio oily oint okay olaf olav oldy olga olin oman omen omit once only onto onus onyx ooze opal opec opel open opus oral orgy orin osha oslo
	otis otto ouch oust ouzo oval oven over ovid ovum owly oxen pace pack pact page paid pail pain pair pale pall palm palo pane pang pant papa pare park parr part paso pass past pate path
	paul pave pawn peak peal pear peat peck peed peek peel peep peer pelt pend penh penn pent perk pert peru pest pete ph.d phil phon pica pick pier pike pile pill pimp pine ping pink pint
	pion pipe piss pith pitt pity pius pixy plan plat play plea plod plop plot plow plug plum plus poem poet pogo poke pole polk poll polo pomp pond pong pont pony pooh pool poop poor pope
	pore pork port pose posh post posy pour pout pram pray prep prey prig prim prod prof prom prop prow puck puff pugh puke pull pulp puma pump punk punt puny pure purl purr push putt pyle
	pyre quad quay quid quip quit quiz quod race rack racy raft rage raid rail rain rake ramo ramp rand rang rank rant rape rapt rare rasa rash rasp rata rate raul rave raze read real ream
	reap rear reck reed reef reek reel reid rein rena rend rene rent rest reub rhea rica rice rich rick rico ride rift riga rill rime rimy ring rink riot ripe rise risk rite ritz road roam
	roar robe rock rode roil role roll rome romp rood roof rook room root rope rosa rose ross rosy rotc rote roth rout rove rowe rsvp rube ruby rude rudy ruff ruin rule rump rune rung runt
	ruse rush rusk russ rust ruth ryan sack safe saga sage sago said sail sake sale salk salt same sana sand sane sang sank sans sara sari sash saud saul save scab scam scan scar scat scot
	scud scum seal seam sean sear seat sect seed seek seem seen seep self sell semi send sent sept sera serf seth sewn sexy shad shag shah sham shaw shay shea shed shim shin ship shiv shod
	shoe shoo shop shot show shun shut sial siam sian sick side sift sigh sign silk sill silo silt sima sims sine sing sinh sink sire site situ siva size skat skew skid skim skin skip skit
	skye slab slag slam slap slat slav slay sled slew slid slim slip slit slob sloe slog slop slot slow slug slum slur slut smog smug smut snag snap snip snob snow snub snug soak soap soar
	sock soda sofa soft soil sold sole solo soma some song sony soon soot sora sorb sore sort soul soup sour sown soya span spar spat spay spec sped spew spin spit spot spud spun spur stab
	stag stan star stay stem step stew stir stop stow stub stud stun styx such suck suds suey suez suit sulk sung sunk suny sure surf swab swag swam swan swap swat sway swig swim swum tabu
	tack tact taft tail take talc tale talk tall tame tamp tang tanh tank taos tapa tape tara tart task tass tate taut taxi teal team tear teat tech teem teen teet tell tend tent term tern
	tess test tete text thai than that thaw thea thee them then they thin this thor thou thud thug thus tick tide tidy tied tier tift tile till tilt time tina tine tint tiny tire toad toby
	todd tofu togo togs toil told toll tomb tome tone tong toni tonk tony took tool toot tore tori torn torr tort tory toss tote tour tout town trag tram trap tray tree trek trig trim trio
	trip trod trot troy true tsar tuba tube tuck tuff tuft tuna tune tung turf turk turn tusk tutu twig twin twit type typo ucla ugly ulan unit unix upon urea urge uris ursa usaf usda usgs
	usia usps ussr utah vade vail vain vale vamp vane vary vase vast veal veda veer vega veil vein vend vent vera verb very vest veto vial vice vida vide viet view viii vile vine visa vise
	vita vito viva vivo void volt voss vote wack waco wade wadi wage wahl wail wait wake wale walk wall walt wand wane wang want ward ware warm warn warp wart wary wash wasp wast watt wave
	wavy waxy weak weal wean wear webb weco weed week weep wehr weir weld well welt went wept were wert west wham what whee when whet whig whim whip whir whit whiz whoa whom whop whup wick
	wide wier wife wild wile will wilt wily wind wine wing wink wino winy wipe wire wiry wise wish wisp with witt wive woke wold wolf womb wong wont wood wool word wore work worm worn wove
	wrap writ wynn yale yang yank yard yarn yawl yawn yeah year yell yelp ymca yoga yogi yoke yolk yond yore york yost your yuck yuki yule yves ywca zeal zero zest zeta zeus zinc zing zion
	zone zoom zorn
);
} # FourLetterWords

sub SwearWords {
  return qw( ass asshat asshole badass ballsack bastard bitch bitched bitches bitching bitchy blowjob cock cocksucker cunt dammit damn damnit dick dickhead
	dinglebetty dirty douche dumbass faggot fuck fucked fucken fucker fucking god goddamn jackass jackoff jerkoff jizz lameass lmao lmfao motherfucker
	muff nigga niggaz nigger pihb porn pussy queef rtfa rtfm sex shit smartass stfu sucker tit tits twat wanker wtf 
);
} # SwearWords





=head1 AUTHOR

Chris Drake <christopher@pobox.com>

=head1 BUGS

=over 3

=item *

Hardcoded some info

=back

=head1 SEE ALSO

B<CPAN> for the description of the modules used herin:-

http://search.cpan.org/dist/MIME-Lite/lib/MIME/Lite.pm

=head1 COPYRIGHT

        Copyright (C) 2010 Chris Drake.  All Rights Reserved.

=cut