view release on metacpan or  search on metacpan

lib/AnyData/Storage/File.pm  view on Meta::CPAN

sub open_local_file {
    my( $self,$file, $open_mode ) = @_;
    my $dir = $self->{f_dir} || './';
    my($fname,$path) = fileparse($file);
    my($foo2,$os_cur_dir) = fileparse('');
    my $haspath = 1 if $path and $path ne $os_cur_dir;
    if (!$haspath && $file !~ /^$open_table_re/o) {
	$file = HAS_FILE_SPEC
                ? File::Spec->catfile($dir, $file)
		: $dir . "/$file";
    }
    my $fh;
    $open_mode ||= 'r';
    my %valid_mode = (
    r  => q/read       read an existing file, fail if already exists/,
    u  => q/update     read & modify an existing file, fail if already exists/,
    c  => q/create     create a new file, fail if it already exists/,
    o  => q/overwrite  create a new file, overwrite if it already exists/,
    );
    my %mode = (
       r   => O_RDONLY,
       u   => O_RDWR,
       c   => O_CREAT | O_RDWR | O_EXCL,
       o   => O_CREAT | O_RDWR | O_TRUNC
    );
    my $help = qq(
       r  if file exists, get shared lock
       u  if file exists, get exclusive lock
       c  if file doesn't exist, get exclusive lock
       o  truncate if file exists, else create; get exclusive lock
    );
    if ( !$valid_mode{$open_mode} ) {
        print "\nBad open_mode '$open_mode'\nValid modes are :\n";

        for ('r','u','c','o'){
        print "   $_ = $valid_mode{$_}\n";
      }
        exit;
    }
    if ($open_mode eq 'c') {
	if (-f $file) {
	    die "Cannot create '$file': Already exists";
	}
    }
    if ($open_mode =~ /[co]/ ) {
	if (!($fh = IO::File->new( $file, $mode{$open_mode} ))) {
	    die "Cannot open '$file': $!";
	}
	if (!$fh->seek(0, 0)) {
	    die " Error while seeking back: $!";
	}
    }
    if ($open_mode =~ /[ru]/) {
	die "Cannot read file '$file': doesn't exist!" unless -f $file;
	if (!($fh = IO::File->new($file, $mode{$open_mode}))) {
	    die " Cannot open '$file': $!";
	}
    }
    binmode($fh);
    $fh->autoflush(1);
    if ( HAS_FLOCK ) {
	if ( $open_mode eq 'r') {
	    if (!flock($fh, LOCK_SH)) {
		die "Cannot obtain shared lock on '$file': $!";
	    }
	} else {
	    if (!flock($fh, LOCK_EX)) {
		die " Cannot obtain exclusive lock on '$file': $!";
	    }
	}
    }
    print "OPENING $file, mode = '$open_mode'\n" if $DEBUG;
    return( $file, $fh, $open_mode) if wantarray;
    return( $fh );
}

sub print_col_names {
    my($self,$parser,$col_names) = @_;
    my $fields = $col_names || $self->{col_names} || $parser->{col_names};
    return undef unless scalar @$fields;
    $self->{col_names} = $fields;
    return $fields if $parser->{keep_first_line};
    my $first_line = $self->get_record();
    my $fh         = $self->{fh};
    $self->seek_first_record;

    my $end = $parser->{record_sep} || "\n";
    my $colStr =  $parser->write_fields(@$fields);
    $colStr = join( ',',@$fields) . $end if ref($parser) =~ /Fixed/;
    $fh->write($colStr,length $colStr);
    $self->{first_row_pos} = $fh->tell();
}

sub get_col_names {
    my($self,$parser) = @_;
    my @fields = ();
    if ($parser->{keep_first_line}) {
        my $cols = $parser->{col_names};
        return undef unless $cols;
        return $cols if ref $cols eq 'ARRAY';
        @fields = split ',',$cols;
#die "@fields";
        return scalar @fields
           ? \@fields
           : undef;
    } 
    my $fh         = $self->{fh};
    $fh->seek(0,0) if $fh;
    my $first_line = $self->get_record($parser);
#print $first_line;
    if ( $first_line ) {
        @fields = ref($parser) =~ /Fixed/
            ? split /,/,$first_line
            : $parser->read_fields($first_line);
    }
#    my @fields = $first_line
#         ? $parser->read_fields($first_line)
#        : ();
#print "<$_>" for @fields; print "\n";