Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # ========== Copyright Header Begin ========================================== |
2 | # | |
3 | # OpenSPARC T2 Processor File: OutputDirector.pm | |
4 | # Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved | |
5 | # 4150 Network Circle, Santa Clara, California 95054, U.S.A. | |
6 | # | |
7 | # * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. | |
8 | # | |
9 | # This program is free software; you can redistribute it and/or modify | |
10 | # it under the terms of the GNU General Public License as published by | |
11 | # the Free Software Foundation; version 2 of the License. | |
12 | # | |
13 | # This program is distributed in the hope that it will be useful, | |
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | # GNU General Public License for more details. | |
17 | # | |
18 | # You should have received a copy of the GNU General Public License | |
19 | # along with this program; if not, write to the Free Software | |
20 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
21 | # | |
22 | # For the avoidance of doubt, and except that if any non-GPL license | |
23 | # choice is available it will apply instead, Sun elects to use only | |
24 | # the General Public License version 2 (GPLv2) at this time for any | |
25 | # software where a choice of GPL license versions is made | |
26 | # available with the language indicating that GPLv2 or any later version | |
27 | # may be used, or where a choice of which version of the GPL is applied is | |
28 | # otherwise unspecified. | |
29 | # | |
30 | # Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara, | |
31 | # CA 95054 USA or visit www.sun.com if you need additional information or | |
32 | # have any questions. | |
33 | # | |
34 | # ========== Copyright Header End ============================================ | |
35 | package OutputDirector; | |
36 | ||
37 | use 5.008; | |
38 | use strict; | |
39 | use warnings; | |
40 | ||
41 | our $VERSION = '1.01'; | |
42 | ||
43 | ||
44 | use fields qw( | |
45 | print_status | |
46 | printf_status | |
47 | print_error | |
48 | printf_error | |
49 | ); | |
50 | ||
51 | ############################################################################## | |
52 | ||
53 | sub new { | |
54 | my $class = shift; | |
55 | my %args = @_; | |
56 | ||
57 | my $this = fields::new($class); | |
58 | ||
59 | foreach my $key (keys %args) { | |
60 | $this->{$key} = $args{$key}; | |
61 | } | |
62 | ||
63 | $this->set_defaults(); | |
64 | return $this; | |
65 | } | |
66 | ||
67 | ############################################################################## | |
68 | ||
69 | sub set_defaults { | |
70 | my $this = shift; | |
71 | ||
72 | $this->{print_status} = | |
73 | sub { print STDOUT @_; } | |
74 | unless defined $this->{print_status}; | |
75 | $this->{printf_status} = | |
76 | sub { printf STDOUT @_; } | |
77 | unless defined $this->{printf_status}; | |
78 | $this->{print_error} = | |
79 | sub { print STDERR @_; } | |
80 | unless defined $this->{print_error}; | |
81 | $this->{printf_error} = | |
82 | sub { printf STDERR @_; } | |
83 | unless defined $this->{printf_error}; | |
84 | } | |
85 | ||
86 | ############################################################################## | |
87 | ||
88 | sub print_status { | |
89 | my $this = shift; | |
90 | my @args = @_; | |
91 | $this->{print_status}->(@args); | |
92 | } | |
93 | ||
94 | ############################################################################## | |
95 | ||
96 | sub printf_status { | |
97 | my $this = shift; | |
98 | my @args = @_; | |
99 | $this->{printf_status}->(@args); | |
100 | } | |
101 | ||
102 | ############################################################################## | |
103 | ||
104 | sub print_error { | |
105 | my $this = shift; | |
106 | my @args = @_; | |
107 | $this->{print_error}->(@args); | |
108 | } | |
109 | ||
110 | ############################################################################## | |
111 | ||
112 | sub printf_error { | |
113 | my $this = shift; | |
114 | my @args = @_; | |
115 | $this->{printf_error}->(@args); | |
116 | } | |
117 | ||
118 | ############################################################################## | |
119 | 1; | |
120 | ||
121 | __END__ | |
122 | ||
123 | =head1 NAME | |
124 | ||
125 | OutputDirector - Object interface to output streams to allow easy redirection | |
126 | ||
127 | =head1 SYNOPSIS | |
128 | ||
129 | use OutputDirector; | |
130 | ||
131 | my $OUT = OutputDirector->new(); | |
132 | ||
133 | $OUT->print_status("Hello, world!\n"); | |
134 | $OUT->print_error("Things are not good.\n"); | |
135 | ||
136 | =head1 ABSTRACT | |
137 | ||
138 | This module provides an object interface for status and error output | |
139 | streams. The intent is that a module that uses an OutputDirector | |
140 | can be trivially modified to redirect output. | |
141 | ||
142 | =head1 DESCRIPTION | |
143 | ||
144 | This module provides an object interface to status and error streams. | |
145 | The intent is that a module or script that uses an OutputDirector can | |
146 | be easily (and dynamically) modified to redirect its output. | |
147 | ||
148 | =head2 Construction | |
149 | ||
150 | The OutputDirector is created by the class method new(). The | |
151 | arguments to new form a hash of arguments whose legal keys are as follows: | |
152 | ||
153 | =over 4 | |
154 | ||
155 | =item print_status | |
156 | ||
157 | Value is a coderef to use in the print_status method. Default method | |
158 | prints arguments to STDOUT. | |
159 | ||
160 | =item printf_status | |
161 | ||
162 | Value is a coderef to use in the printf_status method. Default method | |
163 | prints formatted string to STDOUT. | |
164 | ||
165 | =item print_error | |
166 | ||
167 | Value is a coderef to use in the print_error method. Default method | |
168 | prints arguments to STDERR. | |
169 | ||
170 | =item printf_error | |
171 | ||
172 | Value is a coderef to use in the printf_error method. Default method | |
173 | prints formatted string to STDERR. | |
174 | ||
175 | =back | |
176 | ||
177 | The default OutputDirector is constructed as shown in the default | |
178 | section. If, for instance, you wanted to redefine how messages are | |
179 | printed to the error stream, use: | |
180 | ||
181 | my $OUT = OutputDirector->new( | |
182 | print_error => \&my_print_error, | |
183 | printf_error => \&my_printf_error, | |
184 | ); | |
185 | ||
186 | $OUT->print_error("This string goes to my_print_error\n"); | |
187 | ||
188 | =head2 Methods | |
189 | ||
190 | The OutputDirector has 4 object methods: | |
191 | ||
192 | =over 4 | |
193 | ||
194 | =item print_status(@args) | |
195 | ||
196 | Print the arguments to the status stream. | |
197 | ||
198 | =item printf_status($format, @args) | |
199 | ||
200 | Print formatted string to the status stream. | |
201 | ||
202 | =item print_error(@args) | |
203 | ||
204 | Print the arguments to the error stream. | |
205 | ||
206 | =item printf_error($format, @args) | |
207 | ||
208 | Print formatted string to the error stream. | |
209 | ||
210 | =back | |
211 | ||
212 | =head1 SEE ALSO | |
213 | ||
214 | Triage(3). | |
215 | ||
216 | =cut |