/[cvs]/nfo/perl/scripts/umltools/ConfigPatcher/Handlers.pm.save
ViewVC logotype

Annotation of /nfo/perl/scripts/umltools/ConfigPatcher/Handlers.pm.save

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (vendor branch)
Tue Oct 22 02:25:56 2002 UTC (21 years, 7 months ago) by joko
Branch: nfo, MAIN
CVS Tags: v000, HEAD
Changes since 1.1: +0 -0 lines
+ initial import


1 joko 1.1 package ConfigPatcher::Handlers;
2    
3     use strict;
4     use warnings;
5    
6     sub s2f {
7     my $filename = shift;
8     my $string = shift;
9     open(FH, '>' . $filename);
10     print FH $string;
11     print FH "\n";
12     close(FH);
13     }
14    
15     sub f2s {
16     my $filename = shift;
17     # read file at once (be careful with big files!!!)
18     open(FH, '<' . $filename);
19     my @buf_arr = <FH>;
20     my $buf = join("", @buf_arr);
21     close(FH);
22     return $buf;
23     }
24    
25     sub a2f {
26     my $filename = shift;
27     my $string = shift;
28     open(FH, '>>' . $filename);
29     print FH "\n";
30     print FH $string;
31     print FH "\n";
32     close(FH);
33     }
34    
35     sub ris {
36     my $string = shift;
37     my $re_table_r = shift;
38     my %re_table = %{$re_table_r};
39     my @re_find = keys %re_table;
40    
41     # replace all keys with substitutes from hash "%re_table"
42     foreach my $find (@re_find) {
43     my $replace = $re_table{$find};
44     $string =~ s/$find/$replace/g;
45     }
46    
47     return $string;
48     }
49    
50     sub rif {
51     my $filename = shift;
52     my $re_table_r = shift;
53    
54     my $buf = f2s($filename);
55     $buf = ris($buf, $re_table_r);
56     s2f($filename, $buf);
57     }
58    
59     sub findKeyEntries {
60     my $string = shift;
61     my $pattern = shift;
62     my @arr = split("\n", $string);
63     my @entries;
64     foreach (@arr) {
65     chomp;
66     #print "l: ", $_, "\n";
67     if (m/$pattern/) {
68     push @entries, $1;
69     }
70     }
71     return \@entries;
72     }
73    
74     # ---------------------------------
75     # is a context-entry in a file?
76     # a "context-entry" is an entry identified
77     # by a certain keystring, which itself
78     # is detected dynamically
79     sub isEntryInFile {
80    
81     my $chk = shift;
82     my $content_current = f2s($chk->{filename});
83    
84     #print $content_current, "\n";
85    
86     if (my @keys = @{findKeyEntries($chk->{'out'}, $chk->{'pattern'}{'EntryDetect'})}) {
87     foreach (@keys) {
88     my $pattern = $chk->{'pattern'}{'EntryCheck'};
89     $pattern =~ s/\@\@KEY\@\@/$_/;
90     #print "line: $_; pat: \"$pattern\"", "\n";
91     my $bool_AlreadyThere = ($content_current =~ m/$pattern/);
92     if ($bool_AlreadyThere eq '1') {
93     $chk->{'EntryFound'} = $_;
94     return 1;
95     }
96     }
97     }
98    
99     }
100    
101    
102    
103    
104    
105     sub generic_hostname {
106     my $filename = shift;
107     my $hostname = $ConfigPatcher::Main::vhost{'net'}{'hostname'};
108     s2f($filename, $hostname);
109     return 1;
110     }
111    
112     sub generic_resolvconf {
113     my $filename = shift;
114     my $ns = $ConfigPatcher::Main::vhost{'net'}{'nameserver'};
115     s2f($filename, "nameserver $ns");
116     return 1;
117     }
118    
119     sub generic_hosts {
120     my $filename = shift;
121     my $hostname = $ConfigPatcher::Main::vhost{'net'}{'hostname'};
122     my $ip = $ConfigPatcher::Main::vhost{'net'}{'ip'};
123     rif(
124     $filename,
125     {
126     '@@UML_IP@@' => $ip,
127     '@@UML_FQHN@@' => $hostname,
128     }
129     );
130     return 1;
131     }
132    
133     sub debian_interfaces {
134    
135     my $filename = shift;
136     my $ip = $ConfigPatcher::Main::vhost{'net'}{'ip'};
137     my $device = $ConfigPatcher::Main::vhost{'net'}{'device'};
138    
139     # -----------------
140     my %tmpl;
141     $tmpl{'in'} = '
142     auto @@UML_DEVICE@@
143     iface @@UML_DEVICE@@ inet static
144     address @@UML_IP@@
145     netmask 255.255.255.255
146     network @@UML_IP@@
147     broadcast @@UML_IP@@
148     gateway @@UML_IP@@
149     ';
150     $tmpl{'pattern'}{'EntryDetect'} = 'iface (.+?) ';
151     $tmpl{'pattern'}{'EntryCheck'} = 'iface @@KEY@@ ';
152     # -----------------
153    
154     $tmpl{'out'} =
155     ris(
156     $tmpl{'in'},
157     {
158     '@@UML_DEVICE@@' => $device,
159     '@@UML_IP@@' => $ip,
160     }
161     );
162    
163     my %chk = %tmpl;
164     $chk{'filename'} = $filename;
165     $chk{'EntryFound'} = ' ';
166     if (isEntryInFile(\%chk)) {
167     print "\n", " an entry specifying \"", $chk{'EntryFound'}, "\" already exists in \"$filename\", will not overwrite!!! ";
168     } else {
169     a2f($filename, $tmpl{'out'});
170     return 1;
171     }
172    
173     }
174    
175     1;
176    

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed