[Cascavel-pm] exemplo de uso de Tie::File
Alceu R. de Freitas Jr.
glasswalk3r em yahoo.com.br
Quarta Abril 6 11:58:39 PDT 2005
--- Marco Lima <marco.lima em e-via.com.br> escreveu:
> 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 ...
Sim, a aplicação é prática:
http://faus.sourceforge.net. Eu ainda não postei esse
código lá.
> Como já dizia Dave Cross ... um simples open & close
> não resolveria o
> problema ?
Resolveria, mas eu teria que reproduzir o que o
Tie::File faz por mim: loop no conteúdo, para eu
encontrar uma entrada única e alterá-la.
E eu preciso fazer isso de uma maneira razoavelmente
segura, visto que posso ter múltiplos usuários
tentando acessar o arquivo. O Tie::File já tem um
método para realizar o lock consultivo.
Criar um backup do arquivo original e capturar sinais
para tentar parar aplicação de uma forma razoável
também parece importante.
Eu perdi um tempo razoável descobrindo como o Samba
grava usuários no smbpasswd. Acho que vou criar um
módulo para fazer isso. ;-)
Eu andei brincando com perl -d:DProf e dprofpp para
ver como o script se comportava... retirar o "use
warnings" e "use strict" do script garante umas
frações de segundo a menos no tempo de execução. Claro
que só dá para fazer isso depois que seu programa não
tiver bugs (se é
> > 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.
>
=== message truncated ===
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