maps/bin/exportlist.cgi

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         $RCSfile: exportlist.cgi,v $
   5 # Revision:  $Revision: 1.1 $
   6 # Description:  Export an address list
   7 # Author:       Andrew@DeFaria.com
   8 # Created:      Mon Jan 16 20:25:32 PST 2006
   9 # Modified:     $Date: 2013/06/12 14:05:47 $
  10 # Language:     perl
  11 #
  12 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
  13 #
  14 ################################################################################
  15 use strict;
  16
  17 use FindBin;
  18 local $0 = $FindBin::Script;
  19
  20 use lib "$FindBin::Bin/../lib";
  21 use lib "$FindBin::Bin/../../lib";
  22
  23 use MAPS;
  24 use MAPSWeb;
  25
  26 use CGI qw/:standard *table/;
  27 use CGI::Carp "fatalsToBrowser";
  28
  29 my $type     = param('type');
  30 my $userid   = cookie("MAPSUser");
  31    $userid //= $ENV{USER};
  32 my $Userid   = ucfirst $userid;
  33
  34 sub PrintList($) {
  35   my ($type) = @_;
  36
  37   my $year = substr((scalar(localtime)), 20, 4);
  38
  39   print "\################################################################################\n";
  40   print "\#\n";
  41   print "\# MAPS:\t\tMail Authorization and Permission System (MAPS)\n";
  42   print "\# $type.list:\t${Userid}'s $type.list file\n";
  43   print "\# Exported:\t" . localtime . "\n";
  44   print "\#\n";
  45   print "\# Copyright 2001-" . $year . ", Andrew\@DeFaria.com, all rights reserved.\n";
  46   print "\#\n";
  47   print "\################################################################################\n";
  48
  49   FindList(
  50     userid   => $userid,
  51     type     => $type,
  52   );
  53
  54   while (my $rec = GetList) {
  55     $rec->{pattern}   //= '';
  56     $rec->{domain}    //= '';
  57     $rec->{comment}   //= '';
  58     $rec->{hit_count} //= 0;
  59     $rec->{last_hit}  //= '';
  60     $rec->{retention} //= '';
  61
  62     if ($rec->{domain} eq '') {
  63       print "$rec->{pattern},$rec->{comment},$rec->{hit_count},$rec->{last_hit},$rec->{retention}\n";
  64     } else {
  65       print "$rec->{pattern}\@$rec->{domain},$rec->{comment},$rec->{hit_count},$rec->{last_hit},$rec->{retention}\n";
  66     } # if
  67   } # while
  68
  69   return;
  70 } # PrintList
  71
  72 # Main
  73 SetContext($userid);
  74
  75 print header(
  76   -type        => "application/octet-stream",
  77   -attachment  => "$type.list",
  78 );
  79
  80 PrintList($type);
  81
  82 exit;