lib/Yaala/Config.pm

   1 package Yaala::Config;
   2
   3 use strict;
   4 use warnings;
   5 use Exporter;
   6
   7 @Yaala::Config::EXPORT_OK = qw/get_config parse_argv read_config get_checksum/;
   8
   9 @Yaala::Config::ISA = ('Exporter');
  10
  11 =head1 Config.pm
  12
  13 Parsing of configuration files and query method.
  14
  15 =head1 Usage
  16
  17 use Yaala::Config qw#get_config read_config#;
  18
  19 read_config ("filename");
  20 read_config ($filehandle);
  21
  22 get_config ("key");
  23
  24 get_checksum ();
  25
  26 =head1 Config Syntax
  27
  28 Here are the syntax rules:
  29
  30 =over 4
  31
  32 =item *
  33
  34 An options starts with a keyword, followed by a colon, then the value for
  35 that key and is ended with a semi-colon. Example:
  36
  37 keyword: value;
  38
  39 =item *
  40
  41 Text in single- or souble quotes is taken literaly. Quotes can not be
  42 escaped. However, singlequotes enclosed in double quotes (and vice versa)
  43 are perfectly ok. Examples:
  44
  45 teststring: "Yay, it's a string!";
  46
  47 html: '<span style="color: #fe0000;">';
  48
  49 =item *
  50
  51 Hashes are start comments and are ignored to the end of the line. Hashes
  52 enclosed in quotes are B<not> interpreted as comments.. See html-example
  53 above..
  54
  55 =item *
  56
  57 Linebreaks and spaces (unless when in quotes..) are ignored. Strings may
  58 not span multiple lines. Use something along this lines instead:
  59
  60 multiplelineoption: "This is a very very long"
  61         "string that continues in the next line";
  62
  63 =item *
  64
  65 Any key may occur more than once. You can separate two or more values with
  66 commas:
  67
  68 key: value1, value2, "This, is ONE value..";
  69
  70 key: value4;
  71
  72 =back
  73
  74 =head1 Interna
  75
  76 =head2 Structure of $config
  77
  78 C<$config-E<gt>{'key'} = ['val0', 'val1', ...];>
  79
  80 =cut
  81
  82 our $config = {};
  83
  84 my $VERSION = '$Id: Config.pm,v 1.4 2003/12/07 14:52:02 octo Exp $';
  85 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  86
  87 return (1);
  88
  89 =head2 get_config ($key)
  90
  91 Queries the config structure for the given key and returns the value(s).
  92 In list context all values are returned, in scalar context only the most
  93 recent one.
  94
  95 =cut
  96
  97 sub get_config
  98 {
  99         my $key = shift;
 100         my $val;
 101
 102         if (!defined ($config->{$key}))
 103         {
 104                 return (wantarray () ? () : '');
 105         }
 106
 107         $val = $config->{$key};
 108
 109         if (wantarray ())
 110         {
 111                 return (@$val);
 112         }
 113         else
 114         {
 115                 return ($val->[0]);
 116         }
 117 }
 118
 119 =head2 parse_argv (@argv)
 120
 121 Parses ARGV and adds command-line options to the internal config
 122 structure.
 123
 124 =cut
 125
 126 sub parse_argv
 127 {
 128         my @argv = @_;
 129
 130         while (@argv)
 131         {
 132                 my $item = shift (@argv);
 133
 134                 if ($item =~ m/^--?(\S+)/)
 135                 {
 136                         my $key = lc ($1);
 137
 138                         if (!@argv)
 139                         {
 140                                 print STDERR $/, __FILE__, ": No value for key '$key'",
 141                                         'present.';
 142                                 next;
 143                         }
 144
 145                         my $val = shift (@argv);
 146
 147                         push (@{$config->{$key}}, $val);
 148                 }
 149                 elsif ($item)
 150                 {
 151                         push (@{$config->{'input'}}, $item);
 152                 }
 153                 else
 154                 {
 155                         print STDERR $/, __FILE__, ': Ignoring empty argument.';
 156                 }
 157         }
 158
 159         return (1);
 160 }
 161
 162 =head2 parse_config ($string)
 163
 164 Parses $string and adds the extracted configuration options to the
 165 internal structure.
 166
 167 =cut
 168
 169 sub parse_config
 170 {
 171         my $text = shift;
 172         my $tmp = '';
 173         my @rep;
 174         my $rep = 0;
 175
 176         local ($/) = "\n";
 177
 178         $text =~ s/\r//sg;
 179
 180         for (split (m/\n+/s, $text))
 181         {
 182                 my $line = $_;
 183                 chomp ($line);
 184
 185                 # escape quoted text
 186                 while ($line =~ m/^[^#]*(['"]).*?\1/)
 187                 {
 188                         $line =~ s/(['"])(.*?)\1/<:$rep:>/;
 189                         push (@rep, $2);
 190                         $rep++;
 191                 }
 192
 193                 $line =~ s/#.*$//;
 194                 $line =~ s/\s*//g;
 195
 196                 $tmp .= $line;
 197         }
 198
 199         $text = lc ($tmp);
 200
 201         while ($text =~ m/(\w+):([^;]+);/g)
 202         {
 203                 my $key = $1;
 204                 my @val = split (m/,/, $2);
 205
 206                 s/<:(\d+):>/$rep[$1]/eg for (@val);
 207
 208                 push (@{$config->{$key}}, @val);
 209         }
 210
 211         return (1);
 212 }
 213
 214 =head2 read_config ($file)
 215
 216 Reads the configuration file. $file must either be a filename, a reference
 217 to one or a reference to a filehandle.
 218
 219 =cut
 220
 221 sub read_config
 222 {
 223         my $arg = shift;
 224         my $fh;
 225         my $text;
 226         my $need_close = 0;
 227         local ($/) = undef; # slurp mode ;)
 228
 229         if (ref ($arg) eq 'GLOB')
 230         {
 231                 $fh = $arg->{'IO'};
 232         }
 233         elsif (!ref ($arg) || ref ($arg) eq 'SCALAR')
 234         {
 235                 my $scalar_arg;
 236                 if (ref ($arg)) { $scalar_arg = $$arg; }
 237                 else { $scalar_arg = $arg; }
 238
 239                 if (!-e $scalar_arg)
 240                 {
 241                         print STDERR $/, __FILE__, ': Configuration file ',
 242                                 "'$scalar_arg' does not exist";
 243                         return (0);
 244                 }
 245
 246                 unless (open ($fh, "< $scalar_arg"))
 247                 {
 248                         print STDERR $/, __FILE__, ': Unable to open ',
 249                                 "'$scalar_arg': $!";
 250                         return (0);
 251                 }
 252
 253                 $need_close++;
 254         }
 255         else
 256         {
 257                 my $type = ref ($arg);
 258
 259                 print STDERR $/, __FILE__, ": Reference type $type not ",
 260                         'valid';
 261                 return (0);
 262         }
 263
 264         # By now we should have a valid filehandle in $fh
 265
 266         $text = <$fh>;
 267
 268         close ($fh) if ($need_close);
 269
 270         parse_config ($text);
 271
 272         return (1);
 273 }
 274
 275 sub get_checksum
 276 {
 277         my $logtype = get_config ('logtype');
 278         my @selects = get_config ('select');
 279
 280         my $checksum = lc ($logtype) . '::' . join (':', map { lc ($_) } (sort (@selects)));
 281
 282         return ($checksum);
 283 }
 284
 285 =head1 Author
 286
 287 Florian octo Forster E<lt>octo@verplant.orgE<gt>