|
ru.perl
- RU.PERL ----------------------------------------------------------------------
From : yurik shestakov 2:5020/400 07 Mar 2005 12:06:59
To : Misha Shiposh
Subject : Читать/писать Excel-файл
--------------------------------------------------------------------------------
On Sun, Mar 06, 2005 at 10:28:29PM +0300, Misha Shiposh wrote:
MS> PS Как таки с помощью каких модулей, и желательно с примером работать
MS> с эксель файлом?
Искать на CPAN модули:
Spreadsheet::ParseExcel
Spreadsheet::ParseExcel::FmtUnicode
Spreadsheet::WriteExcel
Вот два примера (относительно длинные). Одна функция экспортирует
список из minimalist-а в Excel-файл, и отдает по http.
Вторая функция принимает по http Excel-файл, разбирает его, проверяет
для каждого домена в email существование MX или A записи в DNS, и
складывает полученный список в /var/spool/minimalist/$domain/$list/list
sub export_to_excel
{
my ($r, $basedir, $list, $FL) = @_;
die "No list specified" unless $list;
my $cfg = $r->read_conf($basedir.'/'.$list);
return unless $r->check_auth($cfg);
my $self_url = $r->location;
my $domain = $r->server->server_hostname;
my $fname = "/tmp/$list\@$domain.xls";
unlink $fname if -e $fname;
my $wb = Spreadsheet::WriteExcel->new($fname);
my $ws = $wb->add_worksheet();
my $fmt = $wb->add_format(); # Add a format
$fmt->set_color('black');
$fmt->set_font('Courier New');
$ws->set_column('A:A',42);
$ws->set_column('A:B',42);
my $row = 0;
my $prefix = $basedir.'/'.$list;
my $db_fname = $prefix.'/descr.db';
my %db;
my $db_h = tie(%db, 'DB_File', $db_fname, O_CREAT|O_RDWR, 0660, $DB_HASH)
foreach my $m (@{$$cfg{members}}) {
$ws->write($row,0, $m, $fmt);
my $descr = $db{$m};
if ($descr) {
$ws->write($row,1, decode("CP1251",$descr));
}
++$row;
}
untie %db;
$wb->close;
$r->content_type('application/vnd.ms-excel');
$r->send_http_header;
$header_sent = 1;
my $fi = new FileHandle($fname, 'r') or do {
my $msg = "open($fname): $!";
unlink $fname if -e $fname;
die $msg;
};
$r->send_fd($fi);
$fi->close;
}
sub import_from_excel
{
my ($r, $basedir, $list) = @_;
die "No list specified" unless $list;
my $cfg = $r->read_conf($basedir.'/'.$list);
return unless $r->check_auth($cfg);
$r->my_header;
my $self_url = $r->location;
my $cnt = 0;
$r->print(<<HDR);
<h3 align=center>Import members from Excel file</h3>
HDR
my $q = new CGI;
my $file;
if ($file = $q->param('filename')) {
my $tmpfile = $q->tmpFileName($file);
my $shortfname = ExtractFileName($file);
my $fileinfo = $q->uploadInfo($file);
my $mimetype = $fileinfo ? $fileinfo->{'Content-Type'} : '';
$r->print(<<EOF);
<pre>
shortname: $shortfname
tmpfile : $tmpfile
MIME Type: $mimetype
</pre>
EOF
unless ($mimetype eq 'application/vnd.ms-excel') {
unlink $tmpfile;
die "Not supported mime type (invalid file format?)";
}
my $oExcel = new Spreadsheet::ParseExcel;
my $csid = 'CP1251';
my $oFmt = new Spreadsheet::ParseExcel::FmtUnicode(Unicode_Map => $csid);
my $wb = $oExcel->Parse($tmpfile, $oFmt);
my $ws = $wb->{Worksheet}[0];
my $row = $ws->{MinRow};
my $ok_cnt = 0;
my $err_cnt = 0;
my $res = Net::DNS::Resolver->new;
my %db;
my $prefix = $basedir.'/'.$list;
my $db_fname = $prefix.'/descr.db';
my $db_h = tie(%db, 'DB_File', $db_fname, O_CREAT|O_RDWR, 0660, $DB_HASH)
or die "can't tie($db_fname): $!";
my $email_list = '';
$r->print(<<HDR);
<table align=center border=0 width=75%>
<tr bgcolor=silver>
<th>ADDRESS</th>
<th>CUSTOMER</th>
<th>INFO</th>
</tr>
HDR
for(; defined($ws->{MaxRow}) && $row < $ws->{MaxRow}; ++$row) {
my @row = ();
for(my $iC = $ws->{MinCol} ;
defined $ws->{MaxCol} && $iC <= $ws->{MaxCol}; ++$iC) {
my $cell = $ws->{Cells}[$row][$iC];
push @row, $cell->Value;
}
next unless $row[0] =~ /@([\w\d][\w\d.-]+)/;
my $dom = $1;
my $descr_q = $row[1] || '';
$descr_q =~ s/&/&/g;
$descr_q =~ s/</</g;
$descr_q =~ s/>/>/g;
my $q = $res->search($dom);
my $err='';
unless ($q) {
$err = "<font color=red>".$res->errorstring."</font>";
} else {
if (grep { $_->type eq 'MX' || $_->type eq 'A' } $q->answer) {
++$ok_cnt;
$db{$row[0]} = $row[1];
$email_list .= $row[0]."\n";
} else {
$err = "<font color=red>No MX or A record found</font>";
}
}
++$err_cnt if $err;
my $bgcolor = $row &1 ? '#f0f0f0':'#f0e8d8';
$r->print("<tr bgcolor=$bgcolor><td><tt>$row[0]</tt></td><td>$descr_q</td>
<td>$err</td></tr>\n");
}
untie %db;
$r->print(<<FTR);
<tr bgcolor=silver>
<th>Total good emails: $ok_cnt</th>
<th>Total bad emails: $err_cnt</th>
<th> </th>
</tr>
</table>
FTR
unlink $tmpfile if -e $tmpfile;
if ($ok_cnt) {
my $l_fname = $prefix.'/list';
chdir $basedir || die "chdir($basedir): $!";
system('/usr/bin/ci','-l',"-m'update from $shortfname'", 'list');
my $fo = new FileHandle ($l_fname, "w") or die "create($l_fname): $!";
$fo->print($email_list);
$fo->close;
}
} else {
$r->print("<h4>What's wrong?</h4>\n");
my %h = $r->content;
foreach my $arg (keys %h) {
$r->print("<tt>$arg=$h{$arg}</tt><br>\n");
}
}
$r->my_footer;
}
--
// yurik shestakov
--- ifmail v.2.15dev5.3
* Origin: Unknown (2:5020/400)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
| Тема: |
Автор: |
Дата: |
|
ODBC |
Misha Shiposh |
18 Feb 2005 19:01:43 |
 Re: ODBC |
Stanislav Sukholet |
21 Feb 2005 09:48:52 |
  ODBC |
Misha Shiposh |
28 Feb 2005 00:48:55 |
|
Re: ODBC |
Dmitry Kudriavtsev |
02 Mar 2005 17:37:05 |
 ODBC |
Misha Shiposh |
06 Mar 2005 23:28:29 |
|
Читать/писать Excel-файл |
yurik shestakov |
07 Mar 2005 12:06:59 |
|
Читать/писать Excel-файл |
Misha Shiposh |
09 Mar 2005 02:34:48 |
|
|
