1###########################################################
2# A Perl package for showing/modifying JPEG (meta)data.   #
3# Copyright (C) 2004,2005,2006 Stefano Bettelli           #
4# See the COPYING and LICENSE files for license terms.    #
5###########################################################
6package Image::MetaData::JPEG::Record;
7use Image::MetaData::JPEG::Backtrace;
8use Image::MetaData::JPEG::data::Tables
9    qw(:Endianness :RecordTypes :RecordProps :Lookups);
10no  integer;
11use strict;
12use warnings;
13
14###########################################################
15# These simple methods should be used instead of standard #
16# "warn" and "die" in this package; they print a much     #
17# more elaborated error message (including a stack trace).#
18# Warnings can be turned off altogether simply by setting #
19# Image::MetaData::JPEG::show_warnings to false.          #
20###########################################################
21sub warn { my ($this, $message) = @_;
22	   warn Image::MetaData::JPEG::Backtrace::backtrace
23	       ($message, "Warning" . $this->info(), $this)
24	       if $Image::MetaData::JPEG::show_warnings; }
25sub die  { my ($this, $message) = @_;
26	   die Image::MetaData::JPEG::Backtrace::backtrace
27	       ($message,"Fatal error" . $this->info(), $this);}
28sub info { my ($this) = @_;
29	   my $key  = (ref $this && $this->{key})  || '<no key>';
30	   my $type = (ref $this && $this->{type}) || '<no type>';
31	   return " [key $key] [type $type]"; }
32
33###########################################################
34# A regular expression matching a legal endianness value. #
35###########################################################
36my $ENDIANNESS_OK = qr/$BIG_ENDIAN|$LITTLE_ENDIAN/o;
37
38###########################################################
39# Constructor for a generic key - values pair for storing #
40# properties to be found in JPEG segments. The key is     #
41# either a numeric value (whose exact meaning depends on  #
42# the segment type, and can be found by means of lookup   #
43# tables), or a descriptive string. The values are to be  #
44# found in the scalar pointed to by the data reference,   #
45# and they come togheter with a value type; the meaning   #
46# of the value type is taken by the APP1 type table, but  #
47# this standard can be used also for the other segments   #
48# (but it is not stored in the file on disk, exception    #
49# made for some APP segments). The count must be given    #
50# for fixed-length types. The enddianness must be given   #
51# for numeric properties with more than 1 byte.           #
52#=========================================================#
53# The "values" are a sequence, so this field is a list;   #
54# it stores $count elements for numeric records, and a    #
55# single scalar for non-numeric ones ("count", in this    #
56# case, corresponds to the size of $$dataref; if $count   #
57# is undefined, no length test is performed on $$dataref).#
58#=========================================================#
59# Types are as follows:                                   #
60#  0  NIBBLES    two 4-bit unsigned integers (private)    #
61#  1  BYTE       An 8-bit unsigned integer                #
62#  2  ASCII      A variable length ASCII string           #
63#  3  SHORT      A 16-bit unsigned integer                #
64#  4  LONG       A 32-bit unsigned integer                #
65#  5  RATIONAL   Two LONGs (numerator and denominator)    #
66#  6  SBYTE      An 8-bit signed integer                  #
67#  7  UNDEFINED  A generic variable length string         #
68#  8  SSHORT     A 16-bit signed integer                  #
69#  9  SLONG      A 32-bit signed integer (2's complem.)   #
70# 10  SRATIONAL  Two SLONGs (numerator and denominator)   #
71# 11  FLOAT      A 32-bit float (a single float)          #
72# 12  DOUBLE     A 64-bit float (a double float)          #
73# 13  REFERENCE  A Perl list reference (internal)         #
74#=========================================================#
75# Added a new field, "extra", which can be used to store  #
76# additional information one does not know where to put.  #
77# (The need originated from APP13 record descriptions).   #
78###########################################################
79sub new {
80    my ($pkg, $akey, $atype, $dataref, $count, $endian) = @_;
81    # die immediately if $dataref is not a reference
82    $pkg->die('Reference not found') unless ref $dataref;
83    # create a Record object with some fields filled
84    my $this  = bless {
85	key     => $akey,
86	type    => $atype,
87	values  => [],
88	extra   => undef,
89    }, $pkg;
90    # use big endian as default endianness
91    $endian = $BIG_ENDIAN unless defined $endian;
92    # get the actual length of the $$dataref scalar
93    my $current  = length($$dataref);
94    # estimate the right length of $data for numeric types
95    # (remember that some types can return "no expectation", i.e. 0).
96    my $expected = $pkg->get_size($atype, $count);
97    # for variable-length records (those with $expected == 0), the length
98    # test must be run against $count, so we update $expected here if
99    # necessary (if $count was not given a value at call time, $expected
100    # is set to $current and the length test will never fail).
101    $expected = $count ? $count : $current if $expected == 0;
102    # Throw an error if the supplied memory area is incorrectly sized
103    $this->die("Incorrect size (expected $expected, found $current)")
104	if ($current != $expected);
105    # get a reference to the internal value list
106    my $tokens = $this->{values};
107    # read the type length (used only for integers and rationals)
108    my $tlength = $JPEG_RECORD_TYPE_LENGTH[$this->{type}];
109    # References, strings and undefined data can be immediately saved
110    # (1 element). All integer types can be treated toghether, and
111    # rationals can be treated as integer (halving the type length).
112    my $cat = $this->get_category();
113    push @$tokens,
114        $cat =~ /S|p/ ? $$dataref :
115	$cat eq 'I' ? $this->decode_integers($tlength  , $dataref, $endian) :
116	$cat eq 'R' ? $this->decode_integers($tlength/2, $dataref, $endian) :
117	$cat eq 'F' ? $this->decode_floating($tlength  , $dataref, $endian) :
118	$this->die('Unknown category');
119    # die if the token list is empty
120    $this->die('Empty token list') if @$tokens == 0;
121    # return the blessed reference
122    return $this;
123}
124
125###########################################################
126# Syntactic sugar for a type test. The two arguments are  #
127# $this and the numeric type.                             #
128###########################################################
129sub is { return $_[1] == $_[0]{type}; }
130
131###########################################################
132# This method returns a character describing the category #
133# which the type of the current record belongs to.        #
134# There are currently only five categories:               #
135# references  : 'p' -> Perl references (internal)         #
136# integer     : 'I' -> NIBBLES, (S)BYTE, (S)SHORT,(S)LONG #
137# string-like : 'S' -> ASCII, UNDEF                       #
138# fractional  : 'R' -> RATIONAL, SRATIONAL                #
139# float.-point: 'F' -> FLOAT, DOUBLE                      #
140# The method is sufficiently clear to use $_[0] instead   #
141# of $this (is it a speedup ?)                            #
142###########################################################
143sub get_category { return $JPEG_RECORD_TYPE_CATEGORY[$_[0]{type}]; }
144
145###########################################################
146# This method returns true or false depending on the      #
147# record type being a signed integer or not (i.e. being   #
148# SBYTE, SSHORT, SLONG or SRATIONAL). The method is       #
149# sufficiently simple to use $_[0] instead of $this.      #
150###########################################################
151sub is_signed { return $JPEG_RECORD_TYPE_SIGN[$_[0]{type}] eq 'Y'; }
152
153###########################################################
154# This method calculates a record memory footprint; it    #
155# needs the record type and the record count. This method #
156# is class static (it can be called without an underlying #
157# object), so it cannot use $this. $count defaults to 1.  #
158# Remember that a type length of zero means that size     #
159# should not be tested (this comes from TYPE_LENGHT = 0). #
160###########################################################
161sub get_size {
162    my ($this, $type, $count) = @_;
163    # if count is unspecified, set it to 1
164    $count = 1 unless defined $count;
165    # die if the type is unknown or undefined
166    $this->die('Undefined record type') unless defined $type;
167    $this->die("Unknown record type ($type)")
168	if $type < 0 || $type > $#JPEG_RECORD_TYPE_LENGTH;
169    # return the type length times $count
170    return $JPEG_RECORD_TYPE_LENGTH[$type] * $count;
171}
172
173###########################################################
174# This class static method receives a number of Record    #
175# features (key, type and count) and a list of values,    #
176# and tries to build a Record with that type and count    #
177# containing those values. On success, it returns the     #
178# record reference, on failure it returns undef.          #
179# ------------------------------------------------------- #
180# Floating point values are matched to six decimal digits #
181###########################################################
182sub check_consistency {
183    my ($pkg, $key, $type, $count, $tokens) = @_;
184    # create a dummy Record, the "fix" its type and its value list
185    my $record = new Image::MetaData::JPEG::Record($key, $ASCII, \ "");
186    @$record{'type', 'values'} = ($type, $tokens);
187    # try to get back the record properties; return undef if it fails
188    (undef, undef, my $new_count, my $dataref) = eval { $record->get() };
189    return undef unless defined $dataref;
190    # if $count was previously undefined, listen to the Record encoder
191    $count = $new_count unless defined $count;
192    # if counts are already different, there is no hope (this
193    # can happen if $count was faulty: we haven't used it sofar).
194    return undef if $count != $new_count;
195    # build the real record by re-parsing the data reference; in my
196    # opinion this should never fail, so I don't check the result.
197    # Does this provide more chances to find a bug?
198    $record = new Image::MetaData::JPEG::Record($key, $type, $dataref, $count);
199    # return undef if the number of values does not match
200    my $new_tokens = $record->{values};
201    return undef unless scalar @$tokens == scalar @$new_tokens;
202    # the new record can however have a value list different from
203    # what we hope, since some data types could wrap. So we now
204    # compare the value lists and return undef if they differ.
205    for (0..$#$tokens) {
206	return undef if ($record->get_category() eq 'F') ?
207	    # due to the nature of floating point values, the comparison
208	    # is limited to six decimal digits (the new token has a precision
209	    # of 23 or 52 binary digits, while the old one is just a string)
210	    sprintf("%.6g",$$new_tokens[$_]) ne sprintf("%.6g",$$tokens[$_]) :
211	    # for all other types, compare the plain values
212	    $$new_tokens[$_] ne $$tokens[$_]; }
213    # if you get here, everything is ok: return the record reference
214    return $record;
215}
216
217###########################################################
218# This method returns a particular value in the value     #
219# list, its index being the only argument. If the index   #
220# is undefined (not supplied), the sum of all values is   #
221# returned. The index is checked for out-of-bound errors. #
222#=========================================================#
223# For string-like records, "sum" -> "concatenation".      #
224###########################################################
225sub get_value {
226    my ($this, $index) = @_;
227    # get a reference to the value list
228    my $values = $this->{values};
229    # access a single value if an index is defined or
230    # there is only one value (follow to sum otherwise)
231    goto VALUE_INDEX if defined $index || @$values == 1;
232  VALUE_SUM:
233    return ($this->get_category() eq 'S') ?
234	# perform concatenation for string-like values
235	join "", @$values :
236	# perform addition for numeric values
237	eval (join "+", @$values);
238  VALUE_INDEX:
239    # $index defaults to zero
240    $index = 0 unless defined $index;
241    # get the last legal index
242    my $last_index = $#$values;
243    # check that $index is legal, throw an exception otherwise
244    $this->die("Out-of-bound index ($index > $last_index)")
245	if $index > $last_index;
246    # return the desired value
247    return $$values[$index];
248}
249
250###########################################################
251# This method sets a particular value in the value list.  #
252# If the index is undefined (not supplied), the first     #
253# (0th) value is set. The index is check for out-of-bound #
254# errors. This method is dangerous: call only internally. #
255###########################################################
256sub set_value {
257    my ($this, $new_value, $index) = @_;
258    # get a reference to the value list
259    my $values = $this->{values};
260    # set the first value if index is defined
261    $index = 0 unless defined $index;
262    # check out-of-bound condition
263    my $last_index = $#$values;
264    $this->die("Out-of-bound index ($index > $last_index)")
265	if $index > $last_index;
266    # set the value
267    $$values[$index] = $new_value;
268}
269
270###########################################################
271# These private functions take signed/unsigned integers   #
272# and return their unsigned/signed version; the type      #
273# length in bytes must also be specified. $_[0] is the    #
274# original value, $_[1] is the type length. $msb[$n] is   #
275# an unsigned integer with the 8*$n-th bit turned up.     #
276# There is also a function for converting binary data as  #
277# a string into a big-endian number (iteratively) and a   #
278# function for interchanging bytes with nibble pairs.     #
279###########################################################
280{ my @msb = map { 2**(8*$_ - 1) } 0..20;
281  sub to_signed   { ($_[0] >= $msb[$_[1]]) ? ($_[0] - 2*$msb[$_[1]]) : $_[0] }
282  sub to_unsigned { ($_[0] < 0) ? ($_[0] + 2*$msb[$_[1]]) : $_[0] }
283  sub to_number   { my $v=0; for (unpack "C*", $_[0]) { ($v<<=8) += $_; } $v }
284  sub to_nibbles  { map { chr(vec($_[0], $_, 4)) } reverse (0..1) }
285  sub to_byte     { my $b="x"; vec($b,$_^1,4) = ord($_[$_]) for (0..1) ; $b }
286}
287
288###########################################################
289# This method decodes a sequence of 8$n-bit integers, and #
290# correctly takes into account signedness and endianness. #
291# The data size must be validated in advance: in this     #
292# routine it must be a multiple of the type size ($n).    #
293#=========================================================#
294# NIBBLES are treated apart. A "nibble record" is indeed  #
295# a pair of 4-bit values, so the type length is 1, but    #
296# each element must enter two values into @tokens. They   #
297# are always big-endian and unsigned.                     #
298#=========================================================#
299# Don't use shift operators, which are a bit too tricky.. #
300###########################################################
301sub decode_integers {
302    my ($this, $n, $dataref, $endian) = @_;
303    # safety check on endianness
304    $this->die('Unknown endianness') unless $endian =~ $ENDIANNESS_OK;
305    # prepare the list of raw tokens
306    my @tokens = unpack "a$n" x (length($$dataref)/$n), $$dataref;
307    # correct the tokens for endianness if necessary
308    @tokens = map { scalar reverse } @tokens if $endian eq $LITTLE_ENDIAN;
309    # rework the raw token list for nibbles.
310    @tokens = map { to_nibbles($_) } @tokens if $this->is($NIBBLES);
311    # convert to 1-byte digits and concatenate them (assuming big-endian)
312    @tokens = map { to_number($_) } @tokens;
313    # correction for signedness.
314    @tokens = map { to_signed($_, $n) } @tokens if $this->is_signed();
315    # return the token list
316    return @tokens;
317}
318
319###########################################################
320# This method encodes the content of $this->{values} into #
321# a sequence of 8$n-bit integers, correctly taking into   #
322# account signedness and endianness. The return value is  #
323# a reference to the encoded scalar, ready to be written  #
324# to disk. See decode_integers() for further details.     #
325###########################################################
326sub encode_integers {
327    my ($this, $n, $endian) = @_;
328    # safety check on endianness
329    $this->die('Unknown endianness') unless $endian =~ $ENDIANNESS_OK;
330    # copy the value list (the original should not be touched)
331    my @tokens = @{$this->{values}};
332    # correction for signedness
333    @tokens = map { to_unsigned($_, $n) } @tokens if $this->is_signed();
334    # convert the number into 1-byte digits (assuming big-endian)
335    @tokens = map { my $enc = ""; vec($enc, 0, 8*$n) = $_; $enc } @tokens;
336    # reconstruct the raw token list for nibbles.
337    @tokens = map { to_byte($tokens[2*$_], $tokens[2*$_+1]) } 0..(@tokens)/2-1
338	if $this->is($NIBBLES);
339    # correct the tokens for endianness if necessary
340    @tokens = map { scalar reverse } @tokens if $endian eq $LITTLE_ENDIAN;
341    # reconstruct a string from the list of raw tokens
342    my $data = pack "a$n" x (scalar @tokens), @tokens;
343    # return a reference to the reconstructed string
344    return \ $data;
345}
346
347###########################################################
348# This method decodes a data area containing a sequence   #
349# of floating point values, correctly taking into account #
350# the endianness. The type size $n can therefore be only  #
351# 4, 8 or 12 (but you will not be able to store extended  #
352# precision numbers unless your system provides support   #
353# for them [a Cray?]). The data size must be validated in #
354# advance: here it must be a multiple of the type size.   #
355###########################################################
356sub decode_floating {
357    my ($this, $n, $dataref, $endian) = @_;
358    # safety check on endianness
359    $this->die('Unknown endianness') unless $endian =~ $ENDIANNESS_OK;
360    # prepare the list of raw tokens
361    my @tokens = unpack "a$n" x (length($$dataref)/$n), $$dataref;
362    # correct the tokens for endianness if necessary (to native endianness)
363    @tokens = map { scalar reverse } @tokens if $endian ne $NATIVE_ENDIANNESS;
364    # select the correct conversion format (single/double/extended)
365    my $format = ('f', 'd', 'D')[$n/4 - 1];
366    # loop over all tokens (numbers) and extract them
367    @tokens = map { unpack $format, $_ } @tokens;
368    # return the token list
369    return @tokens;
370}
371
372###########################################################
373# This method encodes the content of $this->{values} into #
374# a sequence of floating point numbers, correctly taking  #
375# into account the endianness. The returned value is a    #
376# reference to the encoded scalar, ready to be written to #
377# disk. See decode_floating() for further details.        #
378###########################################################
379sub encode_floating {
380    my ($this, $n, $endian) = @_;
381    # safety check on endianness
382    $this->die('Unknown endianness') unless $endian =~ $ENDIANNESS_OK;
383    # get a simpler reference to the value list
384    my @tokens = @{$this->{values}};
385    # select the correct conversion format (single/double/extended)
386    my $format = ('f', 'd', 'D')[$n/4 - 1];
387    # loop over all tokens (floating point numbers)
388    @tokens = map { pack $format, $_ } @tokens;
389    # correct the tokens for endianness if necessary (from native endianness)
390    @tokens = map { scalar reverse } @tokens if $endian ne $NATIVE_ENDIANNESS;
391    # reconstruct a string from the list of raw tokens
392    my $data = join '', @tokens;
393    # return a reference to the reconstructed string
394    return \ $data;
395}
396
397###########################################################
398# This method returns the content of the record: in list  #
399# context it returns (key, type, count, data_reference).  #
400# The reference points to a packed scalar, ready to be    #
401# written to disk. In scalar context, it returns "data",  #
402# i.e. the dereferentiated data_reference. This is tricky #
403# (but handy for other routines). The endianness argument #
404# defaults to $BIG_ENDIAN. See ctor for further details.  #
405###########################################################
406sub get {
407    my ($this, $endian) = @_;
408    # use big endian as default endianness
409    $endian = $BIG_ENDIAN unless defined $endian;
410    # get the record type and a reference to the internal value list
411    my $type     = $this->{type};
412    my $tokens   = $this->{values};
413    my $category = $this->get_category();
414    # read the type length (only used for integers and rationals)
415    my $tlength  = $JPEG_RECORD_TYPE_LENGTH[$type];
416    # References, strings and undefined data contain a single value
417    # (to be taken a reference at). All integer types can be treated
418    # toghether, and rationals can be treated as integer (halving the
419    # type length). Floating points still to be coded.
420    my $dataref =
421	$category =~ /S|p/ ? \ $$tokens[0] :
422	$category eq 'I' ? $this->encode_integers($tlength  , $endian) :
423	$category eq 'R' ? $this->encode_integers($tlength/2, $endian) :
424	$category eq 'F' ? $this->encode_floating($tlength  , $endian) :
425	$this->die('Unknown category');
426    # calculate the "count" (the number of elements for numeric types
427    # and the length of $$dataref for references, strings, undefined)
428    my $count = length($$dataref) / ( $category =~ /S|p/ ? 1 : $tlength );
429    # return the result, depending on the context
430    wantarray ? ($this->{key}, $type, $count, $dataref) : $$dataref;
431}
432
433###########################################################
434# This routine reworks $ASCII and $UNDEF record values    #
435# before displaying them. In particular, unreasonably     #
436# long strings are trimmed and non-printing characters    #
437# are replaced with their hexadecimal representation.     #
438# Strings are then enclosed between delimiters, and null- #
439# terminated ones can have their last character chopped   #
440# off (but a dot is added after the closing delimiter).   #
441# Remember to copy the string to avoid side-effects!      #
442# ------------------------------------------------------- #
443# $_[0] --> this contains the string to be modified.      #
444# $_[1] --> this contains the string delimiter (" or ')   #
445# $_[2] --> true if the last null char is to be replaced  #
446###########################################################
447sub string_manipulator {
448    # max length of the part of the string we want to display
449    # (after conversion of non-printing chars to hex repr.)
450    my $maxlen = 40;
451    # running variables
452    my ($left, $string) = (length $_[0], '');
453    my ($delim, $dropnull) = @_[1,2];
454    # loop over all characters in the string
455    for (0..(length($_[0])-1)) {
456	# get a copy of the current character
457	my $token = substr($_[0], $_, 1);
458	# translate it to a string if it is non-printing
459	$token =~ s/[\000-\037\177-\377]/sprintf "\\%02x",ord($&)/e;
460	# stop here if the overall string becomes too long
461	last if length($token) + length($string) > $maxlen;
462	# update running variables
463	--$left; $string .= $token; }
464    # transform the terminating null character into a dot if the
465    # string does not start with a slash, then put delimiters
466    # around the string (the dot remains outside, however).
467    $string = "${delim}$string${delim}";
468    $string =~ s/^(.*)\\00${delim}$/$1${delim}\./ if $dropnull;
469    # print the reworked string (if the string was shortened,
470    # add a notice to the end and use a fixed length field)
471    sprintf($left ? '%-'.(3+$maxlen)."s($left more chars)" : '%-s', $string);
472}
473
474###########################################################
475# This method returns a string describing the content of  #
476# the record. The argument is a reference to an array of  #
477# names, which are to be used as successive keys in a     #
478# general hash keeping translations of numeric tags.      #
479# No argument is needed if the key is already non-numeric.#
480###########################################################
481sub get_description {
482    my ($this, $names) = @_;
483    # some internal parameters
484    my $maxlen = 25; my $max_tokens = 7;
485    # try not to die every time if $names is undefined ...
486    $names = [] unless defined $names;
487    # assume that the key is a string (so, it is its own
488    # description, and no numeric value is to be shown)
489    my $descriptor = $this->{key};
490    my $numerictag = undef;
491    # however, if it is a number we need more work
492    if ($descriptor =~ /^\d*$/) {
493	# get the relevant hash for the description of this record
494	my $section_hash = JPEG_lookup(@$names);
495	# fix the numeric tag
496	$numerictag = $descriptor;
497        # extract a description string; if there is no entry in the
498	# hash for this key, replace the descriptor with a sort of
499	# error message (non-existent tags differ from undefined ones)
500	$descriptor =
501	    ! exists $$section_hash{$descriptor}  ? "?? Unknown record ??"  :
502	    ! defined $$section_hash{$descriptor} ? "?? Nameless record ??" :
503	    $$section_hash{$descriptor} }
504    # calculate an appropriate tabbing
505    my $tabbing = " \t" x (scalar @$names);
506    # prepare the description (don't make it exceed $maxlen characters).
507    $descriptor = substr($descriptor, 0, $maxlen/2)
508	. "..." . substr($descriptor, - $maxlen/2 + 3)
509	if length($descriptor) > $maxlen;
510    # initialise the string to be returned at the end
511    my $description = sprintf "%s[%${maxlen}s]", $tabbing, $descriptor;
512    # show also the numeric tag for this record (if present)
513    $description .= defined $numerictag ?
514	sprintf "<0x%04x>", $numerictag : "<......>";
515    # show the tag type as a string
516    $description .= sprintf " = [%9s] ", $JPEG_RECORD_TYPE_NAME[$this->{type}];
517    # show the "extra" field if present
518    $description .= "<$this->{extra}>" if defined $this->{extra};
519    # take a reference to the list of objects to process
520    my $tokens = $this->{values};
521    # we want to write at most $max_tokens tokens in the value list
522    my $extra = $#$tokens - $max_tokens;
523    my $token_limit = $extra > 0 ? $max_tokens : $#$tokens;
524    # some auxiliary variables (depending only on the record type)
525    my $intfs = $this->is_signed() ? '%d' : '%u';
526    my $sep   = $this->is($ASCII)  ? '"'  : "'" ;
527    my $text  = sub { string_manipulator($_[0], $sep, $this->is($ASCII)) };
528    # integers, strings and floating points are written in sequence;
529    # rationals must be written in pairs (use a flip-flop);
530    # undefined values are written on a byte per byte basis.
531    my $f = '/';
532    foreach (@$tokens[0..$token_limit]) {
533	# update the flip flop
534	$f = $f eq ' ' ? '/' : ' ';
535	# some auxiliary variables
536	my $category = $this->get_category();
537	# show something, depending on category and type
538	$description .=
539	    $category eq 'p' ? sprintf ' --> 0x%06x', $_         :
540	    $category eq 'S' ? sprintf '%s'         , &$text($_) :
541	    $category eq 'I' ? sprintf ' '.$intfs   , $_         :
542	    $category eq 'F' ? sprintf ' %g'        , $_         :
543	    $category eq 'R' ? sprintf '%s'.$intfs  , $f, $_     :
544	    $this->die('Unknown error condition'); }
545    # terminate the line; remember to put a warning note if there were
546    # more than $max_tokens element to display, then return the description
547    $description .= " ... ($extra more values)" if $extra > 0;
548    $description .= "\n";
549    # return the descriptive string
550    return $description;
551}
552
553# successful package load
5541;
555