lib/Packages/CommonCode.pm

   1 # Packages::CommonCode - random utility functions
   2 #
   3 # Copyright (C) 2006  Jeroen van Wolffelaar <jeroen@wolffelaar.nl>
   4 # Copyright (C) 2006-2007 Frank Lichtenheld
   5 #
   6 #    This program is free software; you can redistribute it and/or modify
   7 #    it under the terms of the GNU General Public License as published by
   8 #    the Free Software Foundation; either version 1 of the License, or
   9 #    (at your option) any later version.
  10 #
  11 #    This program is distributed in the hope that it will be useful,
  12 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #    GNU General Public License for more details.
  15 #
  16 #    You should have received a copy of the GNU General Public License
  17 #    along with this program; if not, write to the Free Software
  18 #    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 package Packages::CommonCode;
  21
  22 use strict;
  23 use warnings;
  24
  25 use DB_File;
  26 use File::Path;
  27
  28 use base 'Exporter';
  29
  30 our %EXPORT_TAGS = ( 'all' => [ qw(parse_control_par activate activate_dir mkdirp) ] );
  31 our @EXPORT_OK = @{$EXPORT_TAGS{all}};
  32
  33 sub parse_control_par {
  34     local ($_) = @_;
  35
  36     my %data = ();
  37     chomp;
  38     s/\n /\377/g;
  39     while (/^(\S+):\s*(.*)\s*$/mg) {
  40         my ($key, $value) = ($1, $2);
  41         $value =~ s/\377/\n /g;
  42         $key =~ tr [A-Z] [a-z];
  43         $data{$key} = $value;
  44     }
  45
  46     return %data;
  47 }
  48
  49 sub activate {
  50     my ($file) = @_;
  51
  52     rename("${file}.new", $file)
  53         or die "rename ${file}.new $file failed: $!\n";
  54 }
  55
  56 sub activate_dir {
  57     my ($dir) = @_;
  58
  59     my $tmp = "${dir}.old";
  60     rename($dir, $tmp);
  61     activate($dir);
  62     rmtree($tmp);
  63 }
  64
  65 sub mkdirp {
  66     my ($dir) = @_;
  67
  68     -d $dir || mkpath($dir);
  69 }
  70
  71 1;