[Cascavel-pm] exemplo de uso de Tie::File
Alceu R. de Freitas Jr.
glasswalk3r em yahoo.com.br
Quarta Abril 6 10:53:36 PDT 2005
Olá monges,
Estou ressuscitando o papo sobre usar Tie::File. A
alguns dias atrás eu pedi ajuda aos monges, e agora
estou postando o código em que trabalhei usando o
módulo. Até aonde eu testei, ele está funcional.
Dicas? Sugestões? Bugs? Por favor, me avisem!
[]'s
Alceu
----
use Fcntl qw (:DEFAULT :flock);
use Crypt::SmbHash '0.12';
use File::Temp;
use Tie::File;
use File::Copy;
use sigtrap qw(handler abort normal-signals);
delete @ENV{
'IFS','CDPATH','ENVB','BASH_ENV','ENV','PATH'};
$ENV{PATH}='/usr/sbin';
my $file = shift;
my $user = shift;
my $date = localtime(time);
my $temp_file = tmpnam();
die "[$date] FAUS: You must give complete pathname to
smbpasswd file as a parameter.\n" unless (
defined($file) );
die "[$date] FAUS: You must give a username as
parameter.\n" unless ( defined($user) );
chomp($file);
chomp($user);
$file =~ /^(\/[\w\/]+smbpasswd)$/ ? ($file = $1) : die
"[$date] FAUS: Invalid characters in pathname
parameter.\n";
$user =~ /^([\w\$]+)$/ ? $user = $1 : die "[$date]
FAUS: Invalid characters in user parameter.\n";
if (-e $file) {
copy($file,$temp_file) or die "Backup copy failed:
$!\n";
}
my @content;
my $file_obj;
$file_obj = tie( @content, 'Tie::File', $file, mode =>
O_RDWR, memory => 0) or die "Cannot read $file: $!\n";
$file_obj->flock(LOCK_EX);
# check if the user already exists in the file
my $flag = 'false';
my $search = quotemeta($user);
foreach (@content) {
next unless /\w+/;
if ( /^$search/o ) {
$flag = 'true';
my @temp = split(/\:/,$_);
unless ( $temp[4] =~/D/ ) {
# should get only the flags
if ( $temp[4] =~ /^\[([UWNX]+)\s+\]$/ ) {
$temp[4] = $1;
# adding the spaces necessary to get the fixed length
$temp[4] = sprintf "[%-11s]",
'D'.$temp[4];
} else {
error("Cannot change user $user:
invalid file format.",
\@content,
\$file_obj);
}
}
$temp[5] = sprintf "LCT-%08X:", time;
$_ = join(':', em temp);
}
}
unless ($flag eq 'true') {
error("The user $user does not exists in the
smbpasswd file",\@content,\$file_obj);
}
undef $file_obj;
untie @content;
unlink($temp_file) or die "Failed to remove backup
file $temp_file: $!\n";
##################################
# function area
##################################
# dies, but before tries to close the reference file
sub error {
my $message = shift;
my $file_ref = shift;
my $object_ref = shift;
undef $object_ref;
untie $file_ref if ($file_ref);
#restores backup
copy ($temp_file, $file) or die "Failed to restore
$file backup file: $!\n";
unlink($temp_file) or die "Failed to remove backup
file $temp_file: $!\n";
die $message."\n";
}
sub abort {
my $signame = shift;
error ("Aborted due an received SIG$signame
signal.",\@content,\$file_obj);
}
Alceu Rodrigues de Freitas Junior
--------------------------------------
glasswalk3r em yahoo.com.br
http://www.imortais.cjb.net
-----------------------------------------------------------------------
A well-used door needs no oil on its hinges.
A swift-flowing stream does not grow stagnant.
Neither sound nor thoughts can travel through a vacuum.
Software rots if not used.
These are great mysteries -- The Tao Of Programming, 5.1
Yahoo! Acesso Grátis - Internet rápida e grátis.
Instale o discador agora! http://br.acesso.yahoo.com/
Mais detalhes sobre a lista de discussão Cascavel-pm