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