1package Rose::HTML::Object::Messages; 2 3use strict; 4 5use Carp; 6 7use base 'Rose::HTML::Object::Exporter'; 8 9our $VERSION = '0.618'; 10 11our $Debug = 0; 12 13use Rose::Class::MakeMethods::Generic 14( 15 inheritable_scalar => 16 [ 17 '_message_names', 18 'message_id_to_name_map', 19 'message_name_to_id_map', 20 ], 21); 22 23BEGIN 24{ 25 __PACKAGE__->_message_names([]); 26 __PACKAGE__->message_id_to_name_map({}); 27 __PACKAGE__->message_name_to_id_map({}); 28} 29 30sub init_export_tags 31{ 32 my($class) = shift; 33 34 my $list = $class->message_names; 35 36 $class->export_tags 37 ( 38 all => $list, 39 field => [ grep { /^FIELD_/ } @$list ], 40 form => [ grep { /^FORM_/ } @$list ], 41 date => [ grep { /^DATE_|_(?:YEAR|MONTH|DAY)$/ } @$list ], 42 time => [ grep { /^TIME_|_(?:HOUR|MINUTE|SECOND)$/ } @$list ], 43 email => [ grep { /^EMAIL_/ } @$list ], 44 phone => [ grep { /^PHONE_/ } @$list ], 45 number => [ grep { /^NUM_/ } @$list ], 46 set => [ grep { /^SET_/ } @$list ], 47 string => [ grep { /^STRING_/ } @$list ], 48 ); 49} 50 51sub import 52{ 53 my($class) = shift; 54 55 $class->use_private_messages; 56 $class->init_export_tags; 57 58 if($Rose::HTML::Object::Exporter::Target_Class) 59 { 60 $class->SUPER::import(@_); 61 } 62 else 63 { 64 local $Rose::HTML::Object::Exporter::Target_Class = (caller)[0]; 65 $class->SUPER::import(@_); 66 } 67} 68 69our %Private; 70 71sub use_private_messages 72{ 73 my($class) = shift; 74 75 unless($Private{$class}) 76 { 77 $Private{$class} = 1; 78 79 # Make private copies of inherited data structures 80 # (shallow copy is sufficient) 81 $class->message_names([ $class->message_names ]); 82 $class->message_id_to_name_map({ %{$class->message_id_to_name_map} }); 83 $class->message_name_to_id_map({ %{$class->message_name_to_id_map} }); 84 } 85} 86 87sub message_id_exists { defined $_[0]->message_id_to_name_map->{$_[1]} } 88sub message_name_exists { defined $_[0]->message_name_to_id_map->{$_[1]} } 89 90sub message_names 91{ 92 my($class) = shift; 93 94 $class->_message_names(@_) if(@_); 95 96 wantarray ? @{$class->_message_names} : 97 $class->_message_names; 98} 99 100sub get_message_id 101{ 102 my($class, $symbol) = @_; 103 no strict 'refs'; 104 my $const = "${class}::$symbol"; 105 return &$const if(defined &$const); 106 return undef; 107} 108 109sub message_ids 110{ 111 my($class) = shift; 112 my $map = $class->message_id_to_name_map; 113 114 return wantarray ? 115 (sort { $a <=> $b } keys %$map) : 116 [ sort { $a <=> $b } keys %$map ]; 117} 118 119sub get_message_name 120{ 121 no warnings 'uninitialized'; 122 return $_[0]->message_id_to_name_map->{$_[1]}; 123} 124 125sub add_message 126{ 127 my($class, $name, $id) = @_; 128 129 $class->use_private_messages; 130 131 unless($class->imported($name)) 132 { 133 if(exists $class->message_name_to_id_map->{$name} && 134 $class->message_name_to_id_map->{$name} != $id) 135 { 136 croak "Could not add message '$name' - a message with that name already exists ", 137 '(', $class->message_name_to_id_map->{$name}, ')'; 138 } 139 140 if(exists $class->message_id_to_name_map->{$id} && 141 $class->message_id_to_name_map->{$id} ne $name) 142 { 143 croak "Could not add message '$name' - a message with the id $id already exists ", 144 '(', $class->message_id_to_name_map->{$id}, ')'; 145 } 146 } 147 148 MAKE_CONSTANT: 149 { 150 no strict 'refs'; 151 my $const = "${class}::$name"; 152 unless($class->can($name) || defined &$const) 153 { 154 *{"${class}::$name"} = sub() { $id }; 155 156 #my $error; 157 # 158 #TRY: 159 #{ 160 # local $@; 161 # eval "package $class; use constant $name => $id;"; 162 # $error = $@; 163 #} 164 # 165 #croak "Could not create constant '$name' in $class - $error" if($error); 166 } 167 } 168 169 unless(exists $class->message_name_to_id_map->{$name}) 170 { 171 push(@{$class->_message_names}, $name); 172 } 173 174 $class->message_id_to_name_map->{$id} = $name; 175 $class->message_name_to_id_map->{$name} = $id; 176 177 return; 178} 179 180sub add_messages 181{ 182 my($class) = shift; 183 184 $class->use_private_messages; 185 186 no strict 'refs'; 187 188 if(@_) 189 { 190 foreach my $name (@_) 191 { 192 $class->add_message($name, "${class}::$name"->()); 193 } 194 } 195 else 196 { 197 foreach my $name (keys %{"${class}::"}) 198 { 199 my $fq_name = "${class}::$name"; 200 201 next unless(defined *{$fq_name}{'CODE'} && $name =~ /^[A-Z0-9_]+$/); 202 203 my $code = $class->can($name); 204 205 # Skip it if it's not a constant 206 next unless(defined prototype($code) && !length(prototype($code))); 207 208 # Should not need this check? 209 next if($name =~ /^(BEGIN|DESTROY|AUTOLOAD|TIE.*)$/); 210 211 $Debug && warn "$class ADD $name = ", $code->(), "\n"; 212 $class->add_message($name, $code->()); 213 } 214 } 215} 216 217# 218# Messages 219# 220 221use constant CUSTOM_MESSAGE => -1; 222 223# Fields and labels 224use constant FIELD_LABEL => 1; 225use constant FIELD_DESCRIPTION => 2; 226use constant FIELD_REQUIRED_GENERIC => 4; 227use constant FIELD_REQUIRED_LABELLED => 5; 228use constant FIELD_REQUIRED_SUBFIELD => 6; 229use constant FIELD_REQUIRED_SUBFIELDS => 7; 230use constant FIELD_PARTIAL_VALUE => 8; 231use constant FIELD_INVALID_GENERIC => 10; 232use constant FIELD_INVALID_LABELLED => 11; 233 234use constant FIELD_LABEL_YEAR => 10_000; 235use constant FIELD_LABEL_MONTH => 10_001; 236use constant FIELD_LABEL_DAY => 10_002; 237use constant FIELD_LABEL_HOUR => 10_003; 238use constant FIELD_LABEL_MINUTE => 10_004; 239use constant FIELD_LABEL_SECOND => 10_005; 240 241use constant FIELD_ERROR_LABEL_YEAR => 11_000; 242use constant FIELD_ERROR_LABEL_MONTH => 11_001; 243use constant FIELD_ERROR_LABEL_DAY => 11_002; 244use constant FIELD_ERROR_LABEL_HOUR => 11_003; 245use constant FIELD_ERROR_LABEL_MINUTE => 11_004; 246use constant FIELD_ERROR_LABEL_SECOND => 11_005; 247 248use constant FIELD_ERROR_LABEL_MINIMUM_DATE => 11_006; 249use constant FIELD_ERROR_LABEL_MAXIMUM_DATE => 11_007; 250 251# Forms 252use constant FORM_HAS_ERRORS => 100; 253 254# Numerical messages 255use constant NUM_INVALID_INTEGER => 1300; 256use constant NUM_INVALID_INTEGER_POSITIVE => 1301; 257use constant NUM_NOT_POSITIVE_INTEGER => 1302; 258use constant NUM_BELOW_MIN => 1303; 259use constant NUM_ABOVE_MAX => 1304; 260use constant NUM_INVALID_NUMBER => 1305; 261use constant NUM_INVALID_NUMBER_POSITIVE => 1306; 262use constant NUM_NOT_POSITIVE_NUMBER => 1307; 263 264# String messages 265use constant STRING_OVERFLOW => 1400; 266 267# Date messages 268use constant DATE_INVALID => 1500; 269use constant DATE_MIN_GREATER_THAN_MAX => 1501; 270 271# Time messages 272use constant TIME_INVALID => 1550; 273use constant TIME_INVALID_HOUR => 1551; 274use constant TIME_INVALID_MINUTE => 1552; 275use constant TIME_INVALID_SECONDS => 1553; 276use constant TIME_INVALID_AMPM => 1554; 277 278# Email messages 279use constant EMAIL_INVALID => 1600; 280 281# Phone messages 282use constant PHONE_INVALID => 1650; 283 284# Set messages 285use constant SET_INVALID_QUOTED_STRING => 1700; 286use constant SET_PARSE_ERROR => 1701; 287 288BEGIN { __PACKAGE__->add_messages } 289 2901; 291 292__END__ 293 294=head1 NAME 295 296Rose::HTML::Object::Messages - Message ids and named constants for use with HTML objects. 297 298=head1 SYNOPSIS 299 300 package My::HTML::Object::Messages; 301 302 use strict; 303 304 # Import the standard set of message ids 305 use Rose::HTML::Object::Messages qw(:all); 306 use base qw(Rose::HTML::Object::Messages); 307 308 ## 309 ## Define your new message ids below 310 ## 311 312 # Message ids from 0 to 29,999 are reserved for built-in messages. 313 # Negative message ids are reserved for internal use. Please use 314 # message ids 30,000 or higher for your messages. Suggested message 315 # id ranges and naming conventions for various message types are 316 # shown below. 317 318 # Field labels 319 320 use constant FIELD_LABEL_LOGIN_NAME => 100_000; 321 use constant FIELD_LABEL_PASSWORD => 100_001; 322 ... 323 324 # Field error messages 325 326 use constant FIELD_ERROR_PASSWORD_TOO_SHORT => 101_000; 327 use constant FIELD_ERROR_USERNAME_INVALID => 101_001; 328 ... 329 330 # Generic messages 331 332 use constant LOGIN_NO_SUCH_USER => 200_000; 333 use constant LOGIN_USER_EXISTS_ERROR => 200_001; 334 ... 335 336 # This line must be below all the "use constant ..." declarations 337 BEGIN { __PACKAGE__->add_messages } 338 339 1; 340 341=head1 DESCRIPTION 342 343L<Rose::HTML::Object::Messages> stores message ids and names. The message ids are defined as Perl L<constants|constant> with integer values. The constants themselves as well as the mapping between the symbolic constant names and their values are stored as class data. 344 345If you merely want to import one of the standard message id constants, you may use this module as-is (see the L<EXPORTS|/EXPORTS> section for details). If you want to define your own messages, you must subclass this module exactly as shown in the synopsis. The order of the statements is important! 346 347When adding your own messages, you are free to choose any integer message id values, subject to the following constraints: 348 349=over 4 350 351=item * Message ids from 0 to 29,999 are reserved for built-in messages. 352 353=item * Negative message ids are reserved for internal use. 354 355=back 356 357Please use ids 30,000 or higher for your messages. Constant names may contain only the characters C<[A-Z0-9_]> and must be unique among all message constant names. 358 359=head1 EXPORTS 360 361L<Rose::HTML::Object::Messages> does not export any symbols by default. 362 363The 'all' tag: 364 365 use Rose::HTML::Object::Messages qw(:all); 366 367will cause all message name constant to be imported. 368 369The following tags will cause all messages whose names match the regular expression to the right of the tag name to be imported. 370 371 TAG NAME REGEX 372 ----- ----------------- 373 field ^FIELD_ 374 form ^FORM_ 375 date ^DATE_|_(?:YEAR|MONTH|DAY)$ 376 time ^TIME_|_(?:HOUR|MINUTE|SECOND)$ 377 email ^EMAIL_ 378 phone ^PHONE_ 379 number ^NUM_ 380 set ^SET_ 381 string ^STRING_ 382 383For example, this will import all the message constants whose names begin with "FIELD_" 384 385 use Rose::HTML::Object::Messages qw(:field); 386 387Finally, you can import individual message constant names as well: 388 389 use Rose::HTML::Object::Messages qw(FIELD_LABEL_YEAR TIME_INVALID); 390 391A complete listing of the default set of message constant names appears in the next section. 392 393=head1 BUILT-IN MESSAGES 394 395The list of built-in messages constant names appears below. You should not rely on the actual numeric values of these constants. Import and refer to them only by their symbolic names. 396 397 FIELD_LABEL 398 FIELD_DESCRIPTION 399 FIELD_REQUIRED_GENERIC 400 FIELD_REQUIRED_LABELLED 401 FIELD_REQUIRED_SUBFIELD 402 FIELD_REQUIRED_SUBFIELDS 403 FIELD_PARTIAL_VALUE 404 FIELD_INVALID_GENERIC 405 FIELD_INVALID_LABELLED 406 407 FIELD_LABEL_YEAR 408 FIELD_LABEL_MONTH 409 FIELD_LABEL_DAY 410 FIELD_LABEL_HOUR 411 FIELD_LABEL_MINUTE 412 FIELD_LABEL_SECOND 413 414 FIELD_ERROR_LABEL_YEAR 415 FIELD_ERROR_LABEL_MONTH 416 FIELD_ERROR_LABEL_DAY 417 FIELD_ERROR_LABEL_HOUR 418 FIELD_ERROR_LABEL_MINUTE 419 FIELD_ERROR_LABEL_SECOND 420 421 FIELD_ERROR_LABEL_MINIMUM_DATE 422 FIELD_ERROR_LABEL_MAXIMUM_DATE 423 424 FORM_HAS_ERRORS 425 426 NUM_INVALID_INTEGER 427 NUM_INVALID_INTEGER_POSITIVE 428 NUM_NOT_POSITIVE_INTEGER 429 NUM_BELOW_MIN 430 NUM_ABOVE_MAX 431 NUM_INVALID_NUMBER 432 NUM_INVALID_NUMBER_POSITIVE 433 NUM_NOT_POSITIVE_NUMBER 434 435 STRING_OVERFLOW 436 437 DATE_INVALID 438 DATE_MIN_GREATER_THAN_MAX 439 440 TIME_INVALID 441 TIME_INVALID_HOUR 442 TIME_INVALID_MINUTE 443 TIME_INVALID_SECONDS 444 TIME_INVALID_AMPM 445 446 EMAIL_INVALID 447 448 PHONE_INVALID 449 450 SET_INVALID_QUOTED_STRING 451 SET_PARSE_ERROR 452 453=head1 CLASS METHODS 454 455=over 4 456 457=item B<add_message NAME, ID> 458 459Add a new message constant with NAME and an integer ID value. Message ids from 0 to 29,999 are reserved for built-in messages. Negative message ids are reserved for internal use. Please use message ids 30,000 or higher for your messages. Constant names may contain only the characters C<[A-Z0-9_]> and must be unique among all message names. 460 461=item B<add_messages [NAME1, NAME2, ...]> 462 463If called with no arguments, this method L<adds|/add_message> all message L<constants|constant> defined in the calling class. Example: 464 465 __PACKAGE__->add_messages; 466 467If called with a list of constant names, add each named constant to the list of messages. These L<constants|constant> must already exist in the calling class. Example: 468 469 use constant MY_MESSAGE1 => 123456; 470 use constant MY_MESSAGE2 => 123457; 471 ... 472 __PACKAGE__->add_messages('MY_MESSAGE1', 'MY_MESSAGE2'); 473 474=item B<get_message_id NAME> 475 476Returns the integer message id corresponding to the symbolic constant NAME, or undef if no such name exists. 477 478=item B<get_message_name ID> 479 480Returns the symbolic message constant name corresponding to the integer message ID, or undef if no such message ID exists. 481 482=item B<message_id_exists ID> 483 484Return true if the integer message ID exists, false otherwise. 485 486=item B<message_name_exists NAME> 487 488Return true if the symbolic message constant NAME exists, false otherwise. 489 490=item B<message_ids> 491 492Returns a list (in list context) or reference to an array (in scalar context) of integer message ids. 493 494=item B<message_names> 495 496Returns a list (in list context) or reference to an array (in scalar context) of message names. 497 498=back 499 500=head1 AUTHOR 501 502John C. Siracusa (siracusa@gmail.com) 503 504=head1 LICENSE 505 506Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 507