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
|
#!/usr/bin/perl -w
=head1 NAME
Debconf::Template::Transient - Transient template object
=cut
package Debconf::Template::Transient;
use strict;
use POSIX;
use base 'Debconf::Template';
use fields qw(_fields);
=head1 DESCRIPTION
This class provides Template objects that are not backed by a persistent
database store. It is useful for situations where transient operations
needs to be performed on templates. Note that unlike regular templates,
multiple transient templates may exist with the same name.
=cut
=head1 CLASS METHODS
=item new(template)
The name of the template to create must be passed to this function.
=cut
sub new {
my $this=shift;
my $template=shift;
unless (ref $this) {
$this = fields::new($this);
}
$this->{template}=$template;
$this->{_fields}={};
return $this;
}
=head2 get
This method is not supported by this function. Multiple transient templates
with the same name can exist.
=cut
sub get {
die "get not supported on transient templates";
}
=head2 fields
Returns a list of all fields that are present in the object.
=cut
sub fields {
my $this=shift;
return keys %{$this->{_fields}};
}
=head2 clearall
Clears all the fields of the object.
=cut
sub clearall {
my $this=shift;
foreach my $field (keys %{$this->{_fields}}) {
delete $this->{_fields}->{$field};
}
}
=head2 AUTOLOAD
Creates and calls accessor methods to handle fields.
This supports internationalization.
=cut
{
my @langs=Debconf::Template::_getlangs();
sub AUTOLOAD {
(my $field = our $AUTOLOAD) =~ s/.*://;
no strict 'refs';
*$AUTOLOAD = sub {
my $this=shift;
return $this->{_fields}->{$field}=shift if @_;
# Check to see if i18n should be used.
if ($Debconf::Template::i18n && @langs) {
foreach my $lang (@langs) {
# Lower-case language name because
# fields are stored in lower case.
return $this->{_fields}->{$field.'-'.lc($lang)}
if exists $this->{_fields}->{$field.'-'.lc($lang)};
}
}
return $this->{_fields}->{$field};
};
goto &$AUTOLOAD;
}
}
=head1 AUTHOR
Joey Hess <joeyh@debian.org>
=cut
1
|
