[Cascavel-pm] exemplo de uso de Tie::File
Marco Lima
marco.lima em e-via.com.br
Quarta Abril 6 11:24:37 PDT 2005
Gostei ! vc aplicou quase tudo que foi conversado, e serve como exemplo
da utilização dos recursos ... mas para o objetivo em questão é prático
? quero dizer ... esforço x resultado ...
Como já dizia Dave Cross ... um simples open & close não resolveria o
problema ?
[ ]ão
> 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/
> _______________________________________________
> Cascavel-pm mailing list
> Cascavel-pm em pm.org
> http://mail.pm.org/mailman/listinfo/cascavel-pm
>
>
Marco Lima
J. A. P. H.
marco.lima em e-via.com.br
mago em rio.pm.org
+55 19 96 56 06 46
Sociedade Perl do Brasil | http://www.perl.org.br
Perl Monks | http://www.perlmonks.org
Brasil Perl Mongers | http://brasil.pm.org
Register Linux User #355235
Slackware Linux, for the subgenius
Mais detalhes sobre a lista de discussão Cascavel-pm