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

[Alceu R. de Freitas Jr.]

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/