#!/usr/bin/perl -w
#-----------------------------------------------------------------------------
#
# POPular -- A POP3 server and proxy for large mail systems
#
# $Id: db-create.pl,v 1.4 2001/02/09 15:59:07 sqrt Exp $
#
# http://www.remote.org/jochen/mail/popular/
#
#-----------------------------------------------------------------------------
#
# db-create.pl [-f] <listfile>
#
# Creates a list of DB files from text files. See db-create.list for an
# example of a list file.
#
#-----------------------------------------------------------------------------
#
# Copyright (C) 1999-2001 Jochen Topf <jochen@remote.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
#
#-----------------------------------------------------------------------------
use strict;
use DB_File;
use GDBM_File;
use SDBM_File;
my $force = 0;
if ($ARGV[0] eq "-f") {
shift;
$force = 1;
}
if (! $ARGV[0]) {
print STDERR "Missing argument. Exiting...\n";
exit 1;
}
while (<>) {
next if (/^#/);
next if (/^$/);
chomp;
my $zero = 0;
my $lowercase = 0;
my ($file, $type, $options) = split(/:/, $_, 3);
$zero = 1 if ($options =~ /Z/);
$lowercase = 1 if ($options =~ /L/);
encode($file, $type, $zero, $lowercase);
}
exit 0;
sub encode {
my ($file, $type, $zero, $lowercase) = @_;
my %h;
if ($force) {
unlink("$file.db");
} else {
die("File exists: $file.db\n") if (-f "$file.db");
}
tie(%h, "${type}_File", "$file.db", O_RDWR|O_CREAT, 0644);
open(FILE, $file) or die("Can't open $file: $!\n");
while (my $l = <FILE>) {
next if ($l =~ /^#/);
next if ($l =~ /^$/);
chomp $l;
my ($user, $rem) = split(/:/, $l, 2);
$rem = "1" unless ($rem);
$user = lc($user) if ($lowercase);
if ($zero) {
$h{"$user\000"} = "$rem\000";
} else {
$h{$user} = $rem;
}
}
close FILE;
untie %h;
}
#-- THE END ------------------------------------------------------------------
syntax highlighted by Code2HTML, v. 0.9.1