|
0
|
1 =pod
|
|
|
2
|
|
|
3 =head1 LICENSE
|
|
|
4
|
|
|
5 Copyright (c) 1999-2012 The European Bioinformatics Institute and
|
|
|
6 Genome Research Limited. All rights reserved.
|
|
|
7
|
|
|
8 This software is distributed under a modified Apache license.
|
|
|
9 For license details, please see
|
|
|
10
|
|
|
11 http://www.ensembl.org/info/about/code_licence.html
|
|
|
12
|
|
|
13 =head1 NAME
|
|
|
14
|
|
|
15 Serializer - An abstract serializer for turning EnsEMBL data into other formats
|
|
|
16
|
|
|
17 =head1 AUTHOR
|
|
|
18
|
|
|
19 Kieron Taylor, 2011 - ktaylor@ebi.ac.uk
|
|
|
20
|
|
|
21 =head1 SYNOPSIS
|
|
|
22
|
|
|
23 my $serializer = new Serializer( $filehandle );
|
|
|
24 $serializer->print_feature_list( \@list_of_features );
|
|
|
25
|
|
|
26 =head1 DESCRIPTION
|
|
|
27
|
|
|
28 Subclass this class to create a format-specific serializer.
|
|
|
29 Be sure to implement print_feature at the bare minimum
|
|
|
30
|
|
|
31 =cut
|
|
|
32
|
|
|
33 package Bio::EnsEMBL::Utils::IO::Serializer;
|
|
|
34 use strict;
|
|
|
35 use warnings;
|
|
|
36 use Bio::EnsEMBL::Utils::Exception;
|
|
|
37 use Bio::EnsEMBL::Utils::SeqDumper;
|
|
|
38
|
|
|
39
|
|
|
40 =head2 new
|
|
|
41
|
|
|
42 Constructor
|
|
|
43 Arg [1] : Optional File handle
|
|
|
44 Returntype : Bio::EnsEMBL::Utils::IO::Serializer
|
|
|
45
|
|
|
46 =cut
|
|
|
47
|
|
|
48 sub new {
|
|
|
49 my $class = shift;
|
|
|
50 my $self = {
|
|
|
51 'filehandle' => shift,
|
|
|
52 'achieved_something' => 0,
|
|
|
53 };
|
|
|
54 bless $self, $class;
|
|
|
55 if (!defined ($self->{'filehandle'})) {
|
|
|
56 # no file handle, let the handle point to a copy of STDOUT instead
|
|
|
57 open $self->{'filehandle'}, ">&STDOUT";
|
|
|
58 $self->{'stdout'} = 1;
|
|
|
59 }
|
|
|
60 return $self;
|
|
|
61 }
|
|
|
62
|
|
|
63 =head2 DESTROY
|
|
|
64
|
|
|
65 Destructor
|
|
|
66 Description: Restores default state of the STDOUT filehandle as it is a copy
|
|
|
67 and may not flush correctly.
|
|
|
68 =cut
|
|
|
69
|
|
|
70 sub DESTROY {
|
|
|
71 my $self = shift;
|
|
|
72 if ($self->{'stdout'}) {
|
|
|
73 close $self->{'filehandle'};
|
|
|
74 }
|
|
|
75 }
|
|
|
76
|
|
|
77 =head2 print_metadata
|
|
|
78
|
|
|
79 Arg [1] : String
|
|
|
80 Description: Pipes a custom string into the filehandle that the serializer is using
|
|
|
81
|
|
|
82 =cut
|
|
|
83
|
|
|
84 sub print_metadata {
|
|
|
85 my $self = shift;
|
|
|
86 my $text = shift;
|
|
|
87 my $fh = $self->{'filehandle'};
|
|
|
88 print $fh "\n".$text."\n";
|
|
|
89 }
|
|
|
90
|
|
|
91 =head2 print_main_header
|
|
|
92
|
|
|
93 Arg [1] : Data for header, depends on serializer
|
|
|
94 Description: Printing the header text or metadata required for this file format,
|
|
|
95 Re-implement in the serializer.
|
|
|
96 Returntype : None
|
|
|
97 =cut
|
|
|
98
|
|
|
99 sub print_main_header {
|
|
|
100 my $self = shift;
|
|
|
101 warning("No writer for headers in this format. Nothing done" );
|
|
|
102 }
|
|
|
103
|
|
|
104 =head2 printed_something
|
|
|
105 Description: Check if serializer has printed any useful data. Not accurate with FASTA
|
|
|
106 due to non-reporting dumper.
|
|
|
107 Returntype : Boolean
|
|
|
108 =cut
|
|
|
109
|
|
|
110 sub printed_something {
|
|
|
111 my $self = shift;
|
|
|
112 if ($self->{'achieved_something'}) { return 1;}
|
|
|
113 else {return 0;}
|
|
|
114 }
|
|
|
115
|
|
|
116 =head2 formatted_write
|
|
|
117
|
|
|
118 Arg [1] : Line format, see Perldoc of formline()
|
|
|
119 Arg [2] : Array of arguments to suit the line format in Arg [1]
|
|
|
120 Description: Writes data to the filehandle and rigidly formats it.
|
|
|
121 Refer to Perldoc on formline() to specify valid formats.
|
|
|
122 Useful for fixed-width file formats.
|
|
|
123 Suicides in the event of file system issues.
|
|
|
124 Example : my $FORMAT = '^<<<<<<<<<<<<<<<<<<<|<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n';
|
|
|
125 $serializer->formatted_write($FORMAT,@text_fields);
|
|
|
126 Returntype : None
|
|
|
127 =cut
|
|
|
128
|
|
|
129 sub formatted_write {
|
|
|
130 my ($self, $FORMAT, @values) = @_;
|
|
|
131 my $fh = $self->{'filehandle'};
|
|
|
132
|
|
|
133 #while the last value still contains something
|
|
|
134 while(defined($values[-1]) and $values[-1] ne '') {
|
|
|
135 formline($FORMAT, @values);
|
|
|
136 print $fh $^A or die "Failed write to filehandle";
|
|
|
137 $^A = '';
|
|
|
138 }
|
|
|
139 }
|
|
|
140
|
|
|
141 1;
|
