[Cascavel-pm] exemplo de uso de Tie::File

Marco Lima marco.lima em e-via.com.br
Quarta Abril 6 12:05:36 PDT 2005


Sem comentários !!! Esse é o nosso palestrante de OO ...

Workshop de programação na Fatec
Palestra: Perl Orientado a Objeto 
Alceu Rodrigues de Freitas Junior
http://www.linux-pg.com.br

[  ]'ção

>  --- 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/
> _______________________________________________
> 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