6 use Hash::Util qw(lock_keys); |
6 use Hash::Util qw(lock_keys); |
7 use IO::File; |
7 use IO::File; |
8 use if $ENV{DEBUG} => "Smart::Comments"; |
8 use if $ENV{DEBUG} => "Smart::Comments"; |
9 |
9 |
10 my %DATA = ( |
10 my %DATA = ( |
11 fn => {}, |
11 fn => {}, |
12 fh => {}, |
12 fh => {}, |
13 header => {}, |
13 header => {}, |
14 body_pos => {}, |
14 body_pos => {}, |
15 ); |
15 ); |
16 |
16 |
17 lock_keys %DATA; |
17 lock_keys %DATA; |
18 |
|
19 |
18 |
20 sub new { |
19 sub new { |
21 my $class = ref $_[0] ? ref shift : shift; |
20 my $class = ref $_[0] ? ref shift : shift; |
22 my $self = bless \(my $x) => $class; |
21 my $self = bless \(my $x) => $class; |
23 my %arg = @_; |
22 my %arg = @_; |
24 |
23 |
25 $DATA{fn}{$self} = $arg{file}; |
24 $DATA{fn}{$self} = $arg{file}; |
26 $DATA{fh}{$self} = my $fh = IO::File->new($DATA{fn}{$self}) |
25 $DATA{fh}{$self} = my $fh = IO::File->new($DATA{fn}{$self}) |
27 or die "Can't open $DATA{fn}{$self}: $!\n"; |
26 or die "Can't open $DATA{fn}{$self}: $!\n"; |
28 |
27 |
29 local $/ = ""; |
28 local $/ = ""; |
30 $DATA{header}{$self} = <$fh>; |
29 $DATA{header}{$self} = <$fh>; |
31 $DATA{body_pos}{$self} = tell($fh); |
30 $DATA{body_pos}{$self} = tell($fh); |
32 |
31 |
33 return $self; |
32 return $self; |
34 } |
33 } |
35 |
34 |
36 sub __header_fields { |
35 sub __header_fields { |
37 my $self = shift; |
36 my $self = shift; |
38 my %h; |
37 my %h; |
39 @h{$DATA{header}{$self} |
38 @h{ $DATA{header}{$self} =~ /^(\S+?[: ])/mg } = (); |
40 =~ /^(\S+?[: ])/mg} = (); |
|
41 return keys %h; |
39 return keys %h; |
42 } |
40 } |
43 |
41 |
44 sub header_content { |
42 sub header_content { |
45 my $self = shift; |
43 my $self = shift; |
46 my $field = shift; |
44 my $field = shift; |
47 |
45 |
48 ### assert: $field =~ /[: ]$/ |
46 ### assert: $field =~ /[: ]$/ |
49 |
47 |
50 # FIXME: not sure if the space following the header field name |
48 # FIXME: not sure if the space following the header field name |
51 # is optional or required |
49 # is optional or required |
52 return $DATA{header}{$self} |
50 return $DATA{header}{$self} =~ /^$field\s+(.*?)(?=^\S)/imsg; |
53 =~ /^$field\s+(.*?)(?=^\S)/imsg; |
|
54 } |
51 } |
55 |
52 |
56 sub orig_header { |
53 sub orig_header { |
57 my $self = shift; |
54 my $self = shift; |
58 my $fh = $DATA{fh}{$self}; |
55 my $fh = $DATA{fh}{$self}; |
59 seek($fh, 0, 0); |
56 seek($fh, 0, 0); |
60 local $/ = ""; |
57 local $/ = ""; |
61 return <$fh>; |
58 return <$fh>; |
62 } |
59 } |
63 |
60 |
64 sub orig_body { |
61 sub orig_body { |
65 my $self = shift; |
62 my $self = shift; |
66 my $fh = $DATA{fh}{$self}; |
63 my $fh = $DATA{fh}{$self}; |
67 seek($fh, $DATA{body_pos}{$self}, 0); |
64 seek($fh, $DATA{body_pos}{$self}, 0); |
68 local $/ = undef; |
65 local $/ = undef; |
69 return <$fh>; |
66 return <$fh>; |
70 } |
67 } |
71 |
68 |
72 sub DESTROY { |
69 sub DESTROY { |
73 my $self = shift; |
70 my $self = shift; |
74 foreach (keys %DATA) { |
71 foreach (keys %DATA) { |
75 delete $DATA{$_}{$self} |
72 delete $DATA{$_}{$self}; |
76 } |
73 } |
77 } |
74 } |
78 |
75 |
79 1; |
76 1; |
80 |
77 |