From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

WBRASWELL / RPerl-7.000000 / lib / RPerl / DataType / Character.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

              
# [[[ HEADER ]]]
package RPerl::DataType::Character;
use strict;
use warnings;
use RPerl::AfterSubclass;
our $VERSION = 0.010_000;
# [[[ OO INHERITANCE ]]]
use parent qw(RPerl::DataType::String);
use RPerl::DataType::String;
# [[[ SUB-TYPES ]]]
# a character is a string of length 0 or 1, meaning a single letter, digit, or other ASCII (Unicode???) symbol
package  # hide from PAUSE indexing
    character;
use strict;
use warnings;
use parent qw(RPerl::DataType::Character);
# method with character return type
package  # hide from PAUSE indexing
    character::method;
use strict;
use warnings;
use parent -norequire, qw(method);
# [[[ PRE-DECLARED TYPES ]]]
package    # hide from PAUSE indexing
    boolean;
package    # hide from PAUSE indexing
    unsigned_integer;
package     # hide from PAUSE indexing
    integer;
package    # hide from PAUSE indexing
    number;
package    # hide from PAUSE indexing
    string;
# [[[ SWITCH CONTEXT BACK TO PRIMARY PACKAGE ]]]
package RPerl::DataType::Character;
use strict;
use warnings;
# [[[ EXPORTS ]]]
use RPerl::Exporter 'import';
our @EXPORT = qw(character_CHECK character_CHECKTRACE character_to_boolean character_to_unsigned_integer character_to_integer character_to_number character_to_string);
our @EXPORT_OK = qw(character_typetest0 character_typetest1);
# [[[ TYPE-CHECKING ]]]
sub character_CHECK {
    { my void $RETURN_TYPE };
    ( my $possible_character ) = @ARG;
    if ( not( defined $possible_character ) ) {
#        croak( "\nERROR ETV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ncharacter value expected but undefined/null value found,\ncroaking" );
        die( "\nERROR ETV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ncharacter value expected but undefined/null value found,\ndying\n" );
    }
    if ( not( main::RPerl_SvCOKp($possible_character) ) ) {
#        croak( "\nERROR ETV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ncharacter value expected but non-character value found,\ncroaking" );
        die( "\nERROR ETV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ncharacter value expected but non-character value found,\ndying\n" );
    }
    return;
}
sub character_CHECKTRACE {
    { my void $RETURN_TYPE };
    ( my $possible_character, my $variable_name, my $subroutine_name ) = @ARG;
    if ( not( defined $possible_character ) ) {
#        croak( "\nERROR ETV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ncharacter value expected but undefined/null value found,\nin variable " . $variable_name . " from subroutine " . $subroutine_name . ",\ncroaking" );
        die( "\nERROR ETV00, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ncharacter value expected but undefined/null value found,\nin variable " . $variable_name . " from subroutine " . $subroutine_name . ",\ndying\n" );
    }
    if ( not( main::RPerl_SvCOKp($possible_character) ) ) {
#        croak( "\nERROR ETV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ncharacter value expected but non-character value found,\nin variable " . $variable_name . " from subroutine " . $subroutine_name . ",\ncroaking" );
        die( "\nERROR ETV01, TYPE-CHECKING MISMATCH, PERLOPS_PERLTYPES:\ncharacter value expected but non-character value found,\nin variable " . $variable_name . " from subroutine " . $subroutine_name . ",\ndying\n" );
    }
    return;
}
# [[[ BOOLEANIFY ]]]
sub character_to_boolean {
    { my boolean $RETURN_TYPE };
    (my character $input_character) = @ARG;
#    character_CHECK($lucky_character);
    character_CHECKTRACE( $input_character, '$input_character', 'character_to_boolean()' );
    if (($input_character * 1) == 0) { return 0; }
    else { return 1; }
    return;
}
# [[[ UNSIGNED INTEGERIFY ]]]
sub character_to_unsigned_integer {
    { my unsigned_integer $RETURN_TYPE };
    (my character $input_character) = @ARG;
#    character_CHECK($lucky_character);
    character_CHECKTRACE( $input_character, '$input_character', 'character_to_unsigned_integer()' );
    return floor abs ($input_character * 1);
}
# [[[ INTEGERIFY ]]]
sub character_to_integer {
    { my integer $RETURN_TYPE };
    (my character $input_character) = @ARG;
#    character_CHECK($lucky_character);
    character_CHECKTRACE( $input_character, '$input_character', 'character_to_integer()' );
    return floor ($input_character * 1);
}
# [[[ NUMBERIFY ]]]
sub character_to_number {
    { my number $RETURN_TYPE };
    (my character $input_character) = @ARG;
#    character_CHECK($lucky_character);
    character_CHECKTRACE( $input_character, '$input_character', 'character_to_number()' );
    return $input_character * 1.0;
}
# [[[ STRINGIFY ]]]
sub character_to_string {
    { my string $RETURN_TYPE };
    (my character $input_character) = @ARG;
#    character_CHECK($lucky_character);
    character_CHECKTRACE( $input_character, '$input_character', 'character_to_string()' );
    return $input_character;
}
# [[[ TYPE TESTING ]]]
sub character_typetest0 { { my character $RETURN_TYPE }; return chr(main::RPerl__DataType__Character__MODE_ID() + (ord '0')); }
sub character_typetest1 {
    { my character $RETURN_TYPE };
    (my character $lucky_character) = @ARG;
#    character_CHECK($lucky_character);
    character_CHECKTRACE( $lucky_character, '$lucky_character', 'character_typetest1()' );
    return chr((ord $lucky_character) + main::RPerl__DataType__Character__MODE_ID());
}
1;  # end of class