Parent Directory
| 
Revision Log
Revision 3569 - (view) (download) (as text)
| 1 : | dpvc | 2579 | ######################################################################### |
| 2 : | # | ||
| 3 : | # The basic context (Parser::Context is a subclass of this) | ||
| 4 : | # | ||
| 5 : | |||
| 6 : | package Value::Context; | ||
| 7 : | my $pkg = "Value::Context"; | ||
| 8 : | use strict; | ||
| 9 : | |||
| 10 : | # | ||
| 11 : | # Create a new Context object and initialize its data lists | ||
| 12 : | # | ||
| 13 : | sub new { | ||
| 14 : | my $self = shift; my $class = ref($self) || $self; | ||
| 15 : | my $context = bless { | ||
| 16 : | flags => {}, | ||
| 17 : | pattern => { | ||
| 18 : | number => '(?:\d+(?:\.\d*)?|\.\d+)(?:E[-+]?\d+)?', | ||
| 19 : | signedNumber => '[-+]?(?:\d+(?:\.\d*)?|\.\d+)(?:E[-+]?\d+)?', | ||
| 20 : | }, | ||
| 21 : | format => { | ||
| 22 : | dpvc | 2597 | number => '%g', # default format for Reals |
| 23 : | dpvc | 2579 | }, |
| 24 : | error => { | ||
| 25 : | string => '', | ||
| 26 : | pos => undef, | ||
| 27 : | message => '', | ||
| 28 : | flag => 0, | ||
| 29 : | dpvc | 3370 | msg => {}, # for localization |
| 30 : | dpvc | 2579 | }, |
| 31 : | data => { | ||
| 32 : | hashes => ['lists'], | ||
| 33 : | arrays => ['data'], | ||
| 34 : | values => ['flags','pattern','format'], | ||
| 35 : | }, | ||
| 36 : | }, $class; | ||
| 37 : | my %data = (lists=>{},flags=>{},@_); | ||
| 38 : | $context->{_lists} = new Value::Context::Lists($context,%{$data{lists}}); | ||
| 39 : | $context->{_flags} = new Value::Context::Flags($context,%{$data{flags}}); | ||
| 40 : | $context->{_initialized} = 1; | ||
| 41 : | $context->update; | ||
| 42 : | return $context; | ||
| 43 : | } | ||
| 44 : | |||
| 45 : | # | ||
| 46 : | # Implemented in subclasses | ||
| 47 : | # | ||
| 48 : | sub update {} | ||
| 49 : | |||
| 50 : | # | ||
| 51 : | # Access to the data lists | ||
| 52 : | # | ||
| 53 : | sub lists {(shift)->{_lists}} | ||
| 54 : | sub flags {(shift)->{_flags}} | ||
| 55 : | sub flag {(shift)->{_flags}->get(shift)} | ||
| 56 : | |||
| 57 : | # | ||
| 58 : | # Make a copy of a Context object | ||
| 59 : | # | ||
| 60 : | sub copy { | ||
| 61 : | my $self = shift; | ||
| 62 : | my $context = $self->new(); | ||
| 63 : | $context->{_initialized} = 0; | ||
| 64 : | foreach my $data (@{$context->{data}{hashes}}) { | ||
| 65 : | $context->{$data} = {}; | ||
| 66 : | foreach my $x (keys %{$self->{$data}}) { | ||
| 67 : | $context->{$data}{$x} = {%{$self->{$data}{$x}}}; | ||
| 68 : | } | ||
| 69 : | $context->{"_$data"}->update; | ||
| 70 : | } | ||
| 71 : | foreach my $data (@{$context->{data}{arrays}}) { | ||
| 72 : | $context->{$data} = {}; | ||
| 73 : | foreach my $x (keys %{$self->{$data}}) { | ||
| 74 : | $context->{$data}{$x} = [@{$self->{$data}{$x}}]; | ||
| 75 : | } | ||
| 76 : | } | ||
| 77 : | foreach my $data (@{$context->{data}{values}}) { | ||
| 78 : | $context->{$data} = {%{$self->{$data}}}; | ||
| 79 : | } | ||
| 80 : | $context->{_initialized} = 1; | ||
| 81 : | return $context; | ||
| 82 : | } | ||
| 83 : | |||
| 84 : | dpvc | 2664 | |
| 85 : | # | ||
| 86 : | dpvc | 2606 | # Make stringify produce TeX or regular strings |
| 87 : | # | ||
| 88 : | sub texStrings {shift->flags->set(StringifyAsTeX=>1)} | ||
| 89 : | sub normalStrings {shift->flags->set(StringifyAsTeX=>0)} | ||
| 90 : | |||
| 91 : | # | ||
| 92 : | dpvc | 2579 | # Clear error flags |
| 93 : | # | ||
| 94 : | sub clearError { | ||
| 95 : | my $error = (shift)->{error}; | ||
| 96 : | $error->{string} = ''; | ||
| 97 : | $error->{pos} = undef; | ||
| 98 : | $error->{message} = ''; | ||
| 99 : | dpvc | 3370 | $error->{original} = ''; |
| 100 : | dpvc | 2579 | $error->{flag} = 0; |
| 101 : | } | ||
| 102 : | |||
| 103 : | # | ||
| 104 : | # Set the error flags | ||
| 105 : | # | ||
| 106 : | sub setError { | ||
| 107 : | my $error = (shift)->{error}; | ||
| 108 : | dpvc | 3504 | my ($message,$string,$pos,$more,$flag) = @_; |
| 109 : | dpvc | 3370 | my @args = (); |
| 110 : | ($message,@args) = @{$message} if ref($message) eq 'ARRAY'; | ||
| 111 : | $error->{original} = $message; | ||
| 112 : | while ($message && $error->{msg}{$message}) {$message = $error->{msg}{$message}} | ||
| 113 : | while ($more && $error->{msg}{$more}) {$more = $error->{msg}{$more}} | ||
| 114 : | $message = sprintf($message,@args) if scalar(@args) > 0; | ||
| 115 : | $message .= sprintf($more,$pos->[0]+1) if $more; | ||
| 116 : | $error->{message} = $message; | ||
| 117 : | $error->{string} = $string; | ||
| 118 : | dpvc | 3442 | $error->{pos} = $pos; |
| 119 : | dpvc | 3504 | $error->{flag} = $flag || 1; |
| 120 : | dpvc | 2579 | } |
| 121 : | |||
| 122 : | ######################################################################### | ||
| 123 : | # | ||
| 124 : | # Load the subclasses. | ||
| 125 : | # | ||
| 126 : | |||
| 127 : | use Value::Context::Data; | ||
| 128 : | |||
| 129 : | ######################################################################### | ||
| 130 : | |||
| 131 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |