annotate variant_effect_predictor/Bio/EnsEMBL/Utils/IO/FASTASerializer.pm @ 3:d30fa12e4cc5 default tip

Merge heads 2:a5976b2dce6f and 1:09613ce8151e which were created as a result of a recently fixed bug.
author devteam <devteam@galaxyproject.org>
date Mon, 13 Jan 2014 10:38:30 -0500
parents 1f6dce3d34e0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
1 =head1 LICENSE
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
2
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
3 Copyright (c) 1999-2012 The European Bioinformatics Institute and
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
4 Genome Research Limited. All rights reserved.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
5
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
6 This software is distributed under a modified Apache license.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
7 For license details, please see
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
8
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
9 http://www.ensembl.org/info/about/code_licence.html
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
10
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
11 =head1 CONTACT
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
12
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
13 Please email comments or questions to the public Ensembl
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
14 developers list at <dev@ensembl.org>.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
15
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
16 Questions may also be sent to the Ensembl help desk at
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
17 <helpdesk@ensembl.org>.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
18
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
19 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
20
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
21 =head1 NAME
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
22
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
23 Bio::EnsEMBL::Utils::IO::FASTASerializer
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
24
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
25 =head1 SYNOPSIS
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
26
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
27 my $serializer = Bio::EnsEMBL::Utils::IO::FASTASerializer->new($filehandle);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
28 $serializer->chunk_factor(1000);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
29 $serializer->line_width(60);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
30 $serializer->print_Seq($slice);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
31
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
32 $serializer = Bio::EnsEMBL::Utils::IO::FASTASerializer->new($filehandle,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
33 sub {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
34 my $slice = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
35 return "Custom header";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
36 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
37 );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
38
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
39 =head1 DESCRIPTION
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
40
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
41 Replacement for SeqDumper, making better use of shared code. Outputs FASTA
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
42 format with optional custom header and formatting parameters. Set line_width
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
43 and chunk_factor to dictate buffer size depending on application. A 60kb
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
44 buffer is used by default with a line width of 60 characters.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
45
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
46 Custom headers are set by supplying an anonymous subroutine to new(). Custom
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
47 header code must accept a Slice or Bio::PrimarySeqI compliant object as
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
48 argument and return a string.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
49
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
50 The custom header method can be overridden later through set_custom_header()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
51 but this is not normally necessary.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
52
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
53 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
54
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
55 package Bio::EnsEMBL::Utils::IO::FASTASerializer;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
56
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
57 use strict;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
58 use warnings;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
59 use Bio::EnsEMBL::Utils::Exception;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
60 use Bio::EnsEMBL::Utils::Scalar qw/assert_ref check_ref/;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
61
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
62 use base qw(Bio::EnsEMBL::Utils::IO::Serializer);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
63
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
64 =head2 new
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
65
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
66 Arg [1] : Filehandle (optional)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
67 Arg [2] : CODEREF subroutine for writing custom headers
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
68 Arg [3] : [optional] Chunking size (integer)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
69 Arg [4] : [optional] Line width (integer)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
70 Example : $dumper = Bio::EnsEMBL::Utils::IO::FASTASerializer->new($filehandle,$header_function,1000,60);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
71 Description: Constructor
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
72 Allows the specification of a custom function for rendering
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
73 header lines.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
74 Returntype : Bio::EnsEMBL::Utils::IO::FASTASerializer;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
75 Exceptions : none
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
76 Caller : general
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
77
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
78 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
79
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
80 sub new {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
81 my $caller = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
82 my $class = ref($caller) || $caller;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
83 my $filehandle = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
84 my $header_function = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
85 my $chunk_factor = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
86 my $line_width = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
87
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
88 my $self = $class->SUPER::new($filehandle);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
89
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
90 $self->{'header_function'} = $header_function;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
91 $self->{'line_width'} = ($line_width)? $line_width : 60;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
92 $self->{'chunk_factor'} = ($chunk_factor)? $chunk_factor : 1000;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
93 # gives a 60kb buffer by default, increase for higher database and disk efficiency.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
94
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
95 # TODO: Check this error trap works as intended
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
96 if ( defined($self->{'header_function'}) ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
97 if (ref($self->{'header_function'}) ne "CODE") {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
98 throw("Custom header function must be an anonymous subroutine when instantiating FASTASerializer");}
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
99 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
100 else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
101 $self->{'header_function'} = sub {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
102 my $slice = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
103
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
104 if(check_ref($slice, 'Bio::EnsEMBL::Slice')) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
105 my $id = $slice->seq_region_name;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
106 my $seqtype = 'dna';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
107 my $idtype = $slice->coord_system->name;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
108 my $location = $slice->name;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
109
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
110 return "$id $seqtype:$idtype $location";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
111 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
112 else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
113 # must be a Bio::Seq , or we're doomed
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
114
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
115 return $slice->display_id;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
116 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
117 };
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
118
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
119 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
120
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
121 return $self;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
122 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
123
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
124 =head2 print_metadata
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
125
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
126 Arg [1] : Bio::EnsEMBL::Slice
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
127 Description: Printing header lines into FASTA files. Usually handled
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
128 internally to the serializer.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
129 Returntype : None
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
130 Caller : print_Seq
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
131 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
132
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
133 sub print_metadata {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
134 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
135 my $slice = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
136 my $fh = $self->{'filehandle'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
137 my $function = $self->header_function();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
138 my $metadata = $function->($slice);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
139 print $fh '>'.$metadata."\n";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
140 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
141
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
142 =head2 print_Seq
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
143
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
144 Arg [1] : Bio::EnsEMBL::Slice or other Bio::PrimarySeqI compliant object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
145
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
146 Description: Serializes the slice into FASTA format. Buffering is used
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
147 While other Bioperl PrimarySeqI implementations can be used,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
148 a custom header function will be required to accommodate it.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
149
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
150 Returntype : None
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
151
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
152 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
153
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
154 sub print_Seq {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
155 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
156 my $slice = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
157 my $fh = $self->{'filehandle'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
158
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
159 $self->print_metadata($slice);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
160 my $width = $self->{line_width};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
161
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
162 # set buffer size
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
163 my $chunk_size = $self->{'chunk_factor'} * $width;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
164
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
165 my $start = 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
166 my $end = $slice->length();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
167
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
168 #chunk the sequence to conserve memory, and print
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
169
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
170 my $here = $start;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
171
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
172 while($here <= $end) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
173 my $there = $here + $chunk_size - 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
174 $there = $end if($there > $end);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
175 my $seq = $slice->subseq($here, $there);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
176 $seq =~ s/(.{1,$width})/$1\n/g;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
177 print $fh $seq or die "Error writing to file handle";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
178 $here = $there + 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
179 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
180
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
181 if ($slice->length > 0) {$self->{'achieved_something'} = 1;}
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
182
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
183 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
184
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
185 =head2 line_width
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
186
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
187 Arg [1] : Integer e.g. 60 or 80
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
188 Description: Set and get FASTA format line width. Default is 60
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
189 Returntype : Integer
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
190
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
191 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
192
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
193 sub line_width {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
194 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
195 my $line_width = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
196 if ($line_width) { $self->{'line_width'} = $line_width };
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
197 return $self->{'line_width'}
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
198 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
199
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
200 =head2 chunk_factor
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
201 Arg [1] : Integer e.g. 1000
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
202 Description: Set and get the multiplier used to dictate buffer size
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
203 Chunk factor x line width = buffer size in bases.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
204 Returntype : Integer
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
205 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
206
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
207 sub chunk_factor {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
208 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
209 my $chunk_factor = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
210 if ($chunk_factor) { $self->{'chunk_factor'} = $chunk_factor};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
211 return $self->{'chunk_factor'}
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
212 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
213
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
214 =head2 set_custom_header
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
215
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
216 Arg [1] : CODE reference
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
217 Description: Set the custom header function. Normally this is done at
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
218 construction time, but can be overridden here.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
219 Example : $serializer->set_custom_header( sub { return 'New header'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
220 Returntype :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
221
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
222 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
223
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
224 sub set_custom_header {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
225 my ($self, $new_header_function) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
226 $self->header_function($new_header_function);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
227 return;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
228 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
229
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
230 =head2 header_function
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
231
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
232 Arg [1] : CODE reference (optional)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
233 Description: Getter/setter for the custom header code
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
234 Example : $serializer->header_function( sub { return 'New header'});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
235 Returntype : CODE
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
236
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
237 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
238
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
239 sub header_function {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
240 my ($self, $header_function) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
241 if($header_function) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
242 assert_ref($header_function, 'CODE', 'header_function');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
243 $self->{header_function} = $header_function;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
244 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
245 return $self->{header_function};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
246 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
247
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
248 1;