#!/usr/bin/perl

@people_fields = ("lastname", "firstname", "email", "title", "company", "addr", "addr2", "city", "state", "country", "postal", "phone", "fax", "type", "source", "interests", "newsletter");
@democd_fields = ("email", "fullfilled", "fullfilldate");
@questionaire_fields = ("email", "industry", "budget", "mediatype", "howusing", "timeline", "current", "deploying", "augment");

use DBI;

$database="maillist";
$hostname="localhost";
$user="guest";
$password="guest";
$options="";

$tab = "\t";

if($query = $ENV{QUERY_STRING}) {

  $driver = "mysql";
  $dsn = "DBI:$driver:database=$database;$options";
  $dbh = DBI->connect($dsn, $user, $password) || die "Can't connect";

  @form = &parseform($ENV{QUERY_STRING});
  @showfields=();
  $show_democd=0;
  $show_questionaire=0;
  @filters=();
  @orderfields=();
  $csv=0;
  $tsv=0;
  while(@form) {
    my $key = shift @form;
    my $value = shift @form;
    if($key eq "show") {
      @showfields=(@showfields, $value) if $value;
    } elsif($key eq "democd") {
      $show_democd=1;
    } elsif($key eq "questionaire") {
      $show_questionaire=1;
    } elsif($key eq "order") {
      @orderfields=(@orderfields, $value) if $value;
    } elsif($key eq "format") {
      $csv=1 if ($value eq "CSV");
      $tsv=1 if ($value eq "TSV");
    } elsif($key eq "filter") {
      if($value) {
        $field=$value;
        shift @form;
        my $type = shift @form;
        shift @form;
        my $value = shift @form;
        if($type !~ m|NULL|) {
          $value = "\"$value\"" unless $value =~ m|^\".*\"$|;
          @filters = (@filters, "$field $type $value");
        } else {
          @filters = (@filters, "$field $type");
        }
      } else {
        shift @form; shift @form; shift @form; shift @form;
      }
    }
  }

  $sql = "SELECT " . join(",",@showfields) . " FROM people" . (@filters ? (" WHERE " . join(" AND ", @filters)) : "") . (@orderfields ? (" ORDER BY " . join(",", @orderfields)) : "") . ";";
  $lensql = "SELECT MAX(CHAR_LENGTH(" . join(")),MAX(CHAR_LENGTH(",@showfields) . ")) FROM people" . (@filters ? (" WHERE " . join(" AND ", @filters)) : "") . ";";

  print "Content-type: text/plain\n\n";

  $people = $dbh->prepare($sql);
  $people->execute;
  if(!$csv && !$tsv) {
    my($lens,$len);
    $lens = $dbh->prepare($lensql);
    $lens->execute;
    @lens = $lens->fetchrow_array();
    $lens->finish;

    if($show_democd) {
      @lens = (@lens, 7, 10, 12);
    }

    if($show_questionaire) {
      for($i=0; $i<@questionaire_fields; $i++) {
        @lens=(@lens, 24);
      }
    }

  }
  $numRows = $people->rows;
  my $names = $people->{'NAME'};
  my $numFields = $people->{'NUM_OF_FIELDS'};
  @fields=();
  for (my $i = 0;  $i < $numFields;  $i++) {
    @fields = (@fields, $$names[$i]);
    $lens[$i] = length($fields[$i]) if(length($fields[$i]) > $lens[$i]);
  }
  @allfields=@fields;
  if($show_democd) {
    @allfields = (@allfields, "ordered", @democd_fields[1..$#democd_fields]);
  }
  if($show_questionaire) {
    @allfields = (@allfields, @questionaire_fields[1..$#questionaire_fields]);
  }
  $numFields = @allfields;
  if($csv) {
    print "\"", join('","', @allfields), "\"\n";
  } elsif($tsv) {
    print "\"", join("\"$tab\"", @allfields), "\"\n";
  } else {
    my($line)="";
    for($i=0; $i<$numFields; $i++) {
      $line .= " | " if $line;
      $line .= sprintf("%-".$lens[$i].".".$lens[$i]."s", "".$allfields[$i]);
    }
    print "$line\n";
  }
  $num=0;
  $democd=$dbh->prepare("SELECT ".join(",",@democd_fields[1..$#democd_fields])." FROM democd WHERE email=?;");
  $questionaire=$dbh->prepare("SELECT ".join(",",@questionaire_fields[1..$#questionaire_fields])." FROM questionaire WHERE email=?;");
  $QNA=$dbh->prepare("SELECT answer from QandA WHERE question=? AND answernum=?;");
  while($ref=$people->fetchrow_hashref()) {
    $num++;
    my(%h) = %$ref;
    my(@v) = &mapfield($ref, @fields);
    if($show_democd) {
      $democd->execute($h{email});
      if($democd->rows>0) {
        my(@vv) = $democd->fetchrow_array();
        @v = (@v, "yes",@vv);
      } else {
        @v = (@v, "no");
        for($i=1; $i<@democd_fields; $i++) {
          @v = (@v, "");
        }
      }
    }
    if($show_questionaire) {
      $questionaire->execute($h{email});
      if($questionaire->rows>0) {
        my(@vv) = $questionaire->fetchrow_array();
        for($i=1; $i<@questionaire_fields; $i++) {
          $QNA->execute($questionaire_fields[$i], @vv[$i-1]);
          my(@vvv) = $QNA->fetchrow_array();
          @v = (@v, @vvv[0]);
        }
      } else {
        for($i=1; $i<@questionaire_fields; $i++) {
          @v = (@v, "");
        }
      }
    }

    if($csv) {
      print "\"", join('","', @v), "\"\n";
    } elsif($tsv) {
      print "\"", join("\"$tab\"", @v), "\"\n";
    } else {
      my($line)="";
      for($i=0; $i<$numFields; $i++) {
        $line .= " | " if $line;
        $line .= sprintf("%-".$lens[$i].".".$lens[$i]."s", "".$v[$i]);
      }
      print "$line\n";
    }
  }
  $people->finish;
} else {
  print "Content-type: text/html\n\n";
  print << "EOF";
<HTML>
  <HEAD><TITLE>Marketing Department Leads File</TITLE></HEAD>
  <BODY BGCOLOR=#FFFFFF TEXT=#000000 LINK=#0000FF VLINK=#0000FF>
    <CENTER>
    <FORM ACTION="$ENV{REQUEST_URI}" METHOD=GET>
      <TABLE BORDER=1>
        <TR><TD COLSPAN=3 ALIGN=CENTER>Include These Fields:</TD></TR>
EOF
  $i=0;
  foreach $field (@people_fields) {
    print "        <TR>" unless $i%3;
    print "<TD><INPUT TYPE=CHECKBOX NAME=show VALUE=\"$field\" CHECKED>$field</TD>";
    $i++;
    print "</TR>\n" unless $i%3;
  }
  print "</TR>\n" if $i;
  print << "EOF";
      <TR HEIGHT=10><TD COLSPAN=3></TD></TR>
      <TR><TD COLSPAN=3><INPUT TYPE=CHECKBOX NAME=democd>Include DemoCD Order Info</TD></TR>
      <TR><TD COLSPAN=3><INPUT TYPE=CHECKBOX NAME=questionaire>Include DemoCD Questionaire Answers</TD></TR>
      </TABLE>
      <BR>
      <TABLE BORDER=1>
        <TR><TD COLSPAN=3 ALIGN=CENTER>Filters:</TD><TD WIDTH=20></TD><TD ALIGN=CENTER>Sort by:</TD><TD WIDTH=20></TD><TD ALIGN=CENTER>Format:</TD></TR>
EOF
  $fields = "<OPTION><OPTION>" . join("<OPTION>", @people_fields);
  for($i=0; $i<5; $i++) {
    print "        <TR><TD><SELECT NAME=\"filter\">$fields</SELECT></TD><TD><SELECT NAME=\"filter_type\"><OPTION><OPTION>=<OPTION>&lt;&gt;<OPTION>LIKE<OPTION>NOT LIKE<OPTION>IS NULL<OPTION>IS NOT NULL<OPTION>REGEXP</SELECT></TD><TD><INPUT TYPE=TEXT NAME=\"filter_value\" SIZE=10></TD><TD WIDTH=20></TD><TD><SELECT NAME=\"order\">$fields</SELECT></TD><TD WIDTH=20></TD><TD>";
    print "<INPUT TYPE=RADIO NAME=\"format\" VALUE=\"CSV\" CHECKED> CSV" if $i==0;
    print "<INPUT TYPE=RADIO NAME=\"format\" VALUE=\"TSV\" CHECKED> TSV" if $i==0;
    print "<INPUT TYPE=RADIO NAME=\"format\" VALUE=\"TEXT\"> Text" if $i==1;
    print "</TD></TR>\n";
  }
  print << "EOF";
      </TABLE>
    </TD></TR>
    <INPUT TYPE=SUBMIT VALUE="Submit">
    </CENTER>
  </BODY>
</HTML>
EOF

}

sub parseform {
  my($qs) = @_;

  if(!$qs) {
    read(STDIN, $qs, $ENV{CONTENT_LENGTH}, 0);
  }

  $qs = &untaint($qs);

  my(@kvs) = split /&/, $qs;
  my(@kvp) = ();

  foreach $kv (@kvs) {
    my($key, $value) = split /=/, $kv;
    $key = &unescape($key);
    $value = &unwordify(&unescape($value));
    @kvp=(@kvp,$key,$value);
  }
  return @kvp;
}

sub mapfield {
  my($ref, @fields) = @_;
  my(@v) = ();
  for $field (@fields) {
    @v=(@v, $$ref{$field});
  }
  return @v;
}

sub untaint {
  # WARNING: This untaints any string value. Don't use unless you're really stupid!
  my($v) = @_;
  $v =~ m|^(.*)$|;
  $nv = $1;
  return $nv;
}

# unescape URL-encoded data
sub unescape {
    my($todecode) = @_;
    $todecode =~ tr/+/ /;       # pluses become spaces
    $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
    return $todecode;
}

# URL-encode data
sub escape {
    my($toencode) = @_;
    $toencode=~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
    return $toencode;
}

# Translate stupid word characters
sub unwordify {
    my($todecode) = @_;
    $todecode =~ s/\xAE/\&reg\;/g;    
    $todecode =~ s/\xA9/\&copy\;/g;    
    $todecode =~ s/\x99/\&\#153\;/g;     
    $todecode =~ s/\x91/'/g;     
    $todecode =~ s/\x92/'/g;     
    $todecode =~ s/\xB4/'/g;     
    $todecode =~ s/\x93/"/g;     
    $todecode =~ s/\x94/"/g;     
    $todecode =~ s/\&quot\;/"/g;     
    $todecode =~ s/\xBA/\&deg\;/g;    
    $todecode =~ s/\x82/,/g;     
    $todecode =~ s/\x85/.../g;     
    $todecode =~ s/\x84/,,/g;     
    $todecode =~ s/\x96/--/g;     
    $todecode =~ s/\x97/---/g;     
    return $todecode;
}

sub in {
  local($val, @list) = @_;
  for($i=0; $i<=$#list; $i++) {
    return $i if uc($list[$i]) eq uc($val);
  }
  return -1;
}