16
16
use POSIX qw/ strftime/ ;
17
17
use IO::Compress::Zip qw( zip $ZipError) ;
18
18
19
+ use MIME::Base64;
20
+
19
21
$ENV {PATH }=" $ENV {PATH}:/opt/cg_pipeline/scripts" ;
20
22
21
23
use Config::Simple;
22
24
use SneakerNet qw/ exitOnSomeSneakernetOptions recordProperties readConfig passfail command logmsg version/ ;
23
25
use List::MoreUtils qw/ uniq/ ;
24
26
25
- our $VERSION = " 3.4 " ;
27
+ our $VERSION = " 3.7 " ;
26
28
our $CITATION = " Email whoever by Lee Katz" ;
27
29
28
30
my $snVersion =version();
@@ -159,35 +161,63 @@ sub emailWhoever{
159
161
logmsg " To: $to " ;
160
162
my $from =$$settings {from } || die " ERROR: need to set 'from' in the settings.conf file!" ;
161
163
my $subject =" $runName QC" ;
162
- my $body =" Please see below for QC information on $runName .\n\n " ;
164
+
165
+ my $body =" <div>\n " ;
166
+ $body .=" Please see below for QC information on $runName .\n\n " ;
163
167
$body .=" For more details, please see the other attachments.\n " ;
164
- $body .=" - TSV files can be opened in Excel\n " ;
165
- $body .=" - LOG files can be opened in Wordpad, Notepad++, or VSCode\n " ;
166
- $body .=" - HTML files can be opened in Edge\n " ;
167
- $body .=" - Full path: " .realpath($dir )." /SneakerNet\n " ;
168
+ $body .=" <ul>\n " ;
169
+ $body .=" <li>TSV files can be opened in Excel</li>\n " ;
170
+ $body .=" <li>LOG files can be opened in Wordpad, Notepad++, or VSCode</li>\n " ;
171
+ $body .=" <li>HTML files can be opened in Edge</li>\n " ;
172
+ $body .=" <li>Full path: " .realpath($dir )." /SneakerNet</li>\n " ;
173
+ $body .=" </ul>\n " ;
168
174
$body .=" \n This message was brought to you by SneakerNet v$snVersion !\n " ;
169
- $body .=" Documentation can be found at https://github.com/lskatz/SneakerNet\n " ;
175
+ $body .=" <p>Documentation can be found at https://github.com/lskatz/SneakerNet</p>\n " ;
176
+ $body .=" </div>\n " ;
170
177
171
178
# Failure messages in the body
172
- $body .=" \n Any samples that have failed QC as shown in passfail.tsv are listed below.\n " ;
179
+ $body .=" <div>\n " ;
180
+ $body .=" Any samples that have failed QC as shown in passfail.tsv are listed below.\n " ;
181
+ $body .=" <ul>\n " ;
173
182
for my $fastq (keys (%$failure )){
174
183
my $failureMessage =" " ;
175
184
for my $failureCategory (keys (%{$$failure {$fastq }})){
176
185
if ($$failure {$fastq }{$failureCategory } == 1){
177
- $failureMessage .=$fastq . " \n " ;
186
+ $failureMessage .=" <li> $fastq </li> \n " ;
178
187
last ; # just list a given failed fastq once
179
188
}
180
189
}
181
190
$body .=$failureMessage ;
182
191
}
192
+ $body .=" </ul></div>\n " ;
193
+
194
+ $body = tsvToHtml(" $dir /SneakerNet/forEmail/QC_summary.tsv" , $settings );
195
+ $body .= " <p style='font:smaller;'>\n " ;
196
+ $body .= " This message was brought to you by SneakerNet v$snVersion !\n " ;
197
+ $body .= " Documentation can be found at <a href='https://github.com/lskatz/SneakerNet'>github.com/lskatz/SneakerNet</a>.\n " ;
198
+ $body .= " </p>\n " ;
199
+
200
+
201
+ # https://stackoverflow.com/a/11725308
202
+ my $mailpart = generate_uuid();
203
+ my $mailpart_body = generate_uuid();
183
204
184
205
my $emailFile = " $$settings {tempdir}/email.txt" ;
185
206
open (my $fh , " >" , $emailFile ) or die " ERROR: could not write to $emailFile : $! " ;
186
207
print $fh " To: $to \n " ;
187
208
print $fh " From: $from \n " ;
188
209
print $fh " Subject: $subject \n " ;
210
+ print $fh " MIME-Version: 1.0\n " ;
211
+ print $fh " Content-Type: multipart/mixed; boundary=\" $mailpart \"\n " ;
212
+ print $fh " \n " ;
213
+ print $fh " --$mailpart \n " ;
214
+ print $fh " Content-Type: multipart/alternative; boundary=\" $mailpart_body \"\n " ;
189
215
print $fh " \n " ;
216
+ print $fh " --$mailpart_body \n " ;
217
+ print $fh " Content-Type: text/html; charset=\" utf-8\"\n " ;
218
+ print $fh " Content-Disposition: inline\n " ;
190
219
print $fh " $body \n " ;
220
+ print $fh " --$mailpart_body --\n " ;
191
221
192
222
# Save a list of files to be attached
193
223
my @attachment ;
@@ -208,7 +238,7 @@ sub emailWhoever{
208
238
my @finalAttachment ;
209
239
for my $file (@attachment ){
210
240
if (-s $file > 1e7){
211
- logmsg " NOTE : $file is too big. I will not attach it." ;
241
+ logmsg " WARNING : $file is too big. I will not attach it." ;
212
242
} else {
213
243
push (@finalAttachment , $file );
214
244
}
@@ -226,7 +256,7 @@ sub emailWhoever{
226
256
227
257
# Finally, attach the files
228
258
for my $file (@finalAttachment ){
229
- append_attachment($fh , $file );
259
+ append_attachment($fh , $file , $mailpart );
230
260
}
231
261
232
262
close $fh ;
@@ -240,6 +270,92 @@ sub emailWhoever{
240
270
# Utility subs #
241
271
# ###############
242
272
273
+ sub generate_uuid {
274
+ my @chars = (' a' ..' f' , 0..9);
275
+ my $uuid = ' ' ;
276
+
277
+ $uuid .= $chars [rand @chars ] for 1..8;
278
+ $uuid .= ' -' ;
279
+ $uuid .= $chars [rand @chars ] for 1..4;
280
+ $uuid .= ' -' ;
281
+ $uuid .= $chars [rand @chars ] for 1..4;
282
+ $uuid .= ' -' ;
283
+ $uuid .= $chars [rand @chars ] for 1..4;
284
+ $uuid .= ' -' ;
285
+ $uuid .= $chars [rand @chars ] for 1..12;
286
+
287
+ return $uuid ;
288
+ }
289
+
290
+ # Transform a tsv file into an html string
291
+ sub tsvToHtml{
292
+ my ($tsv , $settings ) = @_ ;
293
+
294
+ my $html ;
295
+
296
+ my @footer ;
297
+
298
+ $html .= " <!-- START $tsv -->\n " ;
299
+
300
+ $html .= " <table style='border:black solid 1px;'>" ;
301
+
302
+ my @evenOddBackground = (' #EEE' ,' #CCC' );
303
+
304
+ # Read the table and divvy it up into header, body, footer
305
+ my (@body , $footer );
306
+ open (my $fh , " <" , $tsv ) or die " ERROR: could not read $tsv : $! " ;
307
+ my $header = <$fh >;
308
+ chomp ($header );
309
+ my @header = split (/ \t / , lc ($header ));
310
+ while (my $line = <$fh >){
311
+ chomp ($line );
312
+ my @F = split (/ \t / , $line );
313
+ my %F ;
314
+ @F {@header } = @F ;
315
+ if ($line =~ / ^#/ ){
316
+ $line =~ s / ^#\s *// ;
317
+ push (@footer , $line );
318
+ } else {
319
+ push (@body , \%F );
320
+ }
321
+ }
322
+ close $fh ;
323
+
324
+ # Sort the body
325
+ @body = sort {
326
+ $$a {score } <=> $$b {score } ||
327
+ $$a {sample } cmp $$b {sample }
328
+ } @body ;
329
+
330
+ $html .= " <thead><tr style='background:#333;'>\n " ;
331
+ $html .= " <td>" . join (" </td><td>" , @header ) . " </td>\n " ;
332
+ $html .= " </tr></thead>\n " ;
333
+ for my $hash (@body ){
334
+ # Background color is determined by running the line number mod number of colors
335
+ my $background = $evenOddBackground [$. % scalar (@evenOddBackground )];
336
+
337
+ $html .= " <tr style='background-color:$background ;'>\n " ;
338
+ for my $h (@header ){
339
+ $html .= " <td>$$hash {$h }</td>\n " ;
340
+ }
341
+ $html .= " </tr>\n " ;
342
+ }
343
+ $html .= " </table>\n " ;
344
+
345
+ # Footer lines
346
+ if (@footer ){
347
+ $html .= " <ul style='font-size:smaller;color:#333;'>\n " ;
348
+ for my $line (@footer ){
349
+ $html .= " <li>$line </li>\n " ;
350
+ }
351
+ $html .= " </ul>\n " ;
352
+ }
353
+
354
+ $html .= " <!-- END $tsv -->\n " ;
355
+
356
+ return $html ;
357
+ }
358
+
243
359
# http://stackoverflow.com/a/20359734
244
360
sub flatten {
245
361
map { ref $_ ? flatten(@{$_ }) : $_ } @_ ;
@@ -289,22 +405,21 @@ sub zip_file {
289
405
290
406
# Add an attachment to an email file handle
291
407
sub append_attachment {
292
- my ($fh , $file_path ) = @_ ;
408
+ my ($fh , $file_path , $separator ) = @_ ;
293
409
294
410
# Encode the attachment content using base64 encoding
295
411
my $attachment_name = basename($file_path );
296
-
297
- open (my $attachment_fh , " <" , $file_path ) or die " Failed to open attachment file $file_path : $! " ;
298
- binmode $attachment_fh ;
299
- my $attachment_content = do { local $/ ; <$attachment_fh > };
300
- close $attachment_fh ;
301
-
302
- my $encoded_content = pack (" u" , $attachment_content );
412
+ my $attachment_ext = $attachment_name ;
413
+ $attachment_ext =~ s / .+\. // ;
414
+ my $encoded_content = encode_base64(` cat $file_path ` );
303
415
die " Failed to encode attachment content from $file_path : $! " if $? ;
304
416
305
- print $fh " begin 644 $attachment_name \n " ;
417
+ print $fh " --$separator \n " ;
418
+ print $fh " Content-Type: application/$attachment_ext ; name=\" $attachment_name \"\n " ;
419
+ print $fh " Content-Transfer-Encoding: base64\n " ;
420
+ print $fh " Content-Disposition: attachment; filename=\" $attachment_name \"\n " ;
421
+ print $fh " \n " ;
306
422
print $fh $encoded_content . " \n " ;
307
- print $fh " end\n " ;
308
423
309
424
# Print a newline to separate MIME parts
310
425
print $fh " \n " ;
0 commit comments