[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