← Back to branch summary

~vcs-imports/debconf/svn

« back to all changes in this revision

Viewing changes to src/debconf/Debconf/Format/822.pm

  • Committer: joeyh
  • Date: 2011-02-02 00:33:44 UTC
  • Revision ID: svn-v4:a4a2c43b-8ac3-0310-8836-e0e880c912e2:trunk:2516
moved to git

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/debconf/Debconf/Format/822.pm
1
 
#!/usr/bin/perl -w
2
 
 
3
 
=head1 NAME
4
 
 
5
 
Debconf::Format::822 - RFC-822-ish output format
6
 
 
7
 
=cut
8
 
 
9
 
package Debconf::Format::822;
10
 
use strict;
11
 
use base 'Debconf::Format';
12
 
 
13
 
=head1 DESCRIPTION
14
 
 
15
 
This formats data in a vaguely RFC-822-ish way.
16
 
 
17
 
=cut
18
 
 
19
 
# Not needed.
20
 
sub beginfile {}
21
 
sub endfile {}
22
 
 
23
 
sub read {
24
 
        my $this=shift;
25
 
        my $fh=shift;
26
 
        
27
 
        # Make sure it's sane.
28
 
        local $/="\n";
29
 
        
30
 
        my $name;
31
 
        my %ret=(
32
 
                owners => {},
33
 
                fields => {},
34
 
                variables => {},
35
 
                flags => {},
36
 
        );
37
 
 
38
 
        my $invars=0;
39
 
        my $line;
40
 
        while ($line = <$fh>) {
41
 
                chomp $line;
42
 
                last if $line eq ''; # blank line is our record delimiter
43
 
 
44
 
                # Process variables.
45
 
                if ($invars) {
46
 
                        if ($line =~ /^\s/) {
47
 
                                $line =~ s/^\s+//;
48
 
                                my ($var, $value)=split(/\s*=\s?/, $line, 2);
49
 
                                $value=~s/\\n/\n/g;
50
 
                                $ret{variables}->{$var}=$value;
51
 
                                next;
52
 
                        }
53
 
                        else {
54
 
                                $invars=0;
55
 
                        }
56
 
                }
57
 
 
58
 
                # Process the main structure.
59
 
                my ($key, $value)=split(/:\s?/, $line, 2);
60
 
                $key=lc($key);
61
 
                if ($key eq 'owners') {
62
 
                        foreach my $owner (split(/,\s+/, $value)) {
63
 
                                $ret{owners}->{$owner}=1;
64
 
                        }
65
 
                }
66
 
                elsif ($key eq 'flags') {
67
 
                        foreach my $flag (split(/,\s+/, $value)) {
68
 
                                $ret{flags}->{$flag}='true';
69
 
                        }
70
 
                }
71
 
                elsif ($key eq 'variables') {
72
 
                        $invars=1;      
73
 
                }
74
 
                elsif ($key eq 'name') {
75
 
                        $name=$value;
76
 
                }
77
 
                elsif (length $key) {
78
 
                        $value=~s/\\n/\n/g;
79
 
                        $ret{fields}->{$key}=$value;
80
 
                }
81
 
        }
82
 
 
83
 
        return unless defined $name;
84
 
        return $name, \%ret;
85
 
}
86
 
 
87
 
sub write {
88
 
        my $this=shift;
89
 
        my $fh=shift;
90
 
        my %data=%{shift()};
91
 
        my $name=shift;
92
 
 
93
 
        print $fh "Name: $name\n" or return undef;
94
 
        foreach my $field (sort keys %{$data{fields}}) {
95
 
                my $val=$data{fields}->{$field};
96
 
                $val=~s/\n/\\n/g;
97
 
                print $fh ucfirst($field).": $val\n" or return undef;
98
 
        }
99
 
        if (keys %{$data{owners}}) {
100
 
                print $fh "Owners: ".join(", ", sort keys(%{$data{owners}}))."\n"
101
 
                        or return undef;
102
 
        }
103
 
        if (grep { $data{flags}->{$_} eq 'true' } keys %{$data{flags}}) {
104
 
                print $fh "Flags: ".join(", ",
105
 
                        grep { $data{flags}->{$_} eq 'true' }
106
 
                                sort keys(%{$data{flags}}))."\n"
107
 
                        or return undef;
108
 
        }
109
 
        if (keys %{$data{variables}}) {
110
 
                print $fh "Variables:\n" or return undef;
111
 
                foreach my $var (sort keys %{$data{variables}}) {
112
 
                        my $val=$data{variables}->{$var};
113
 
                        $val=~s/\n/\\n/g;
114
 
                        print $fh " $var = $val\n" or return undef;
115
 
                }
116
 
        }
117
 
        print $fh "\n" or return undef; # end of record delimiter
118
 
        return 1;
119
 
}
120
 
 
121
 
=head1 AUTHOR
122
 
 
123
 
Joey Hess <joeyh@debian.org>
124
 
 
125
 
=cut
126
 
 
127
 
1