| 165 | |
| 166 | === オブジェクトの永続化 === |
| 167 | 当然のことながら,展開先ソースコードが必要になる. |
| 168 | |
| 169 | * object.pm |
| 170 | {{{ |
| 171 | #!perl |
| 172 | #!/usr/bin/perl |
| 173 | |
| 174 | use strict; |
| 175 | use diagnostics; |
| 176 | use warnings; |
| 177 | |
| 178 | package object; |
| 179 | |
| 180 | sub new { |
| 181 | my $class = shift; |
| 182 | bless { "1" => "hogera" }, $class; |
| 183 | } |
| 184 | |
| 185 | sub unko { |
| 186 | my $self = shift; |
| 187 | return $self->{"1"}; |
| 188 | } |
| 189 | |
| 190 | 1; |
| 191 | |
| 192 | __END__ |
| 193 | }}} |
| 194 | |
| 195 | * freeze.pl |
| 196 | {{{ |
| 197 | #!perl |
| 198 | #!/usr/bin/perl |
| 199 | |
| 200 | use strict; |
| 201 | use diagnostics; |
| 202 | use warnings; |
| 203 | use Storable qw(nfreeze); |
| 204 | use object; |
| 205 | |
| 206 | my $obj = new object; |
| 207 | |
| 208 | my $serialized = nfreeze($obj); |
| 209 | print r_escape($serialized); |
| 210 | |
| 211 | sub r_escape { |
| 212 | my $s = shift; |
| 213 | $s =~ s/([%\r\n])/sprintf("%%%02X", ord($1))/ge; |
| 214 | return $s; |
| 215 | } |
| 216 | }}} |
| 217 | |
| 218 | * thaw.pl |
| 219 | {{{ |
| 220 | #!perl |
| 221 | #!/usr/bin/perl |
| 222 | |
| 223 | use strict; |
| 224 | use diagnostics; |
| 225 | use warnings; |
| 226 | use Storable qw(thaw); |
| 227 | use object; |
| 228 | |
| 229 | my $str = ""; |
| 230 | $str .= $_ while (<>); |
| 231 | |
| 232 | my $obj = thaw(r_unescape($str)); |
| 233 | print $obj->unko(), "\n"; |
| 234 | |
| 235 | sub r_unescape { |
| 236 | my $s = shift; |
| 237 | $s =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge; |
| 238 | return $s; |
| 239 | } |
| 240 | }}} |
| 241 | |
| 242 | * 実行結果 |
| 243 | {{{ |
| 244 | #!sh |
| 245 | $ ./freeze.pl | ./thaw.pl |
| 246 | hogera |
| 247 | }}} |