Mercurial > repos > cpt > cpt_psm_recombine
comparison lib/CPT/Writer/TSV_U.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_U; | |
| 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_U | |
| 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 |
