|
0
|
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
|
