Mercurial > repos > cpt > cpt_psm_recombine
comparison lib/CPT/Writer/TSV.pm @ 1:97ef96676b48 draft
planemo upload commit 94b0cd1fff0826c6db3e7dc0c91c0c5a8be8bb0c
author | cpt |
---|---|
date | Mon, 05 Jun 2023 02:51:26 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
0:b18e8268bf4e | 1:97ef96676b48 |
---|---|
1 package CPT::Writer::TSV; | |
2 no warnings; | |
3 use Moose; | |
4 with 'CPT::Writer'; | |
5 | |
6 sub process { | |
7 my ($self) = @_; | |
8 my %data = %{ $self->data }; | |
9 | |
10 my @sheets = keys %data; | |
11 my %complete_processed_data = map { $_ => "" } @sheets; | |
12 foreach (@sheets) { | |
13 my $tmp_data = ''; | |
14 my $data_struc_ref = $data{$_}; | |
15 $tmp_data .= '"' | |
16 . join( "\"\t\"", | |
17 map { local $_ = $_; s/"/\\"/g; $_ } | |
18 @{ ${$data_struc_ref}{'header'} } ) | |
19 . '"' . "\n"; | |
20 foreach ( @{ ${$data_struc_ref}{'data'} } ) { | |
21 $tmp_data .= '"' . join( | |
22 "\"\t\"", | |
23 map { | |
24 local $_ = $_; | |
25 unless (defined $_) { $_ = "" } | |
26 s/"/\\"/g; | |
27 $_; | |
28 } @{$_} | |
29 ) . '"' . "\n"; | |
30 } | |
31 $complete_processed_data{$_} = $tmp_data; | |
32 } | |
33 $self->processed_data( \%complete_processed_data ); | |
34 $self->processing_complete(1); | |
35 } | |
36 | |
37 sub write { | |
38 | |
39 # Wanted to use child's write method here so I can output multiple files. | |
40 my ($self) = @_; | |
41 if ( $self->processing_complete ) { | |
42 my %complete_processed_data = %{ $self->processed_data() }; | |
43 my @sheets = keys %complete_processed_data; | |
44 | |
45 # When this is initially called, the OutputFilesClass was given | |
46 # a hint as to what files from this analysis should be called. | |
47 # We'll borrow that and modify it each time before putting it | |
48 # back at the end. Since this is the *ONLY* type that has | |
49 # sub-reports, it feels O.K. to do it here. | |
50 my $base_name = $self->OutputFilesClass->given_filename(); | |
51 unless ($base_name) { $base_name = ""; } | |
52 foreach (@sheets) { | |
53 # We update the base filename to include our | |
54 # particular Sheet name. As such the generate function | |
55 # should start generating files with that as part of | |
56 # the name | |
57 $self->OutputFilesClass->given_filename( $base_name . '.' . $_ ); | |
58 $self->OutputFilesClass->extension('csv'); | |
59 my $next_output_file = | |
60 $self->OutputFilesClass->get_next_file(); | |
61 | |
62 # Store the filename we used | |
63 push(@{$self->used_filenames()}, $next_output_file); | |
64 open( my $outfile, '>', $next_output_file ); | |
65 print $outfile $complete_processed_data{$_}; | |
66 close($outfile); | |
67 } | |
68 # Reset it back to default (probably unnecessary) | |
69 $self->OutputFilesClass->given_filename($base_name); | |
70 } | |
71 else { | |
72 warn | |
73 "Write called but processing was not marked as complete. Not writing"; | |
74 } | |
75 | |
76 } | |
77 | |
78 sub suffix { | |
79 return 'csv'; | |
80 } | |
81 no Moose; | |
82 1; | |
83 | |
84 __END__ | |
85 | |
86 =pod | |
87 | |
88 =encoding UTF-8 | |
89 | |
90 =head1 NAME | |
91 | |
92 CPT::Writer::TSV | |
93 | |
94 =head1 VERSION | |
95 | |
96 version 1.99.4 | |
97 | |
98 =head1 AUTHOR | |
99 | |
100 Eric Rasche <rasche.eric@yandex.ru> | |
101 | |
102 =head1 COPYRIGHT AND LICENSE | |
103 | |
104 This software is Copyright (c) 2014 by Eric Rasche. | |
105 | |
106 This is free software, licensed under: | |
107 | |
108 The GNU General Public License, Version 3, June 2007 | |
109 | |
110 =cut |