view release on metacpan or  search on metacpan

lib/Inline/Files/Virtual.pm  view on Meta::CPAN

	    line   => $linecount,
	  };
        $offset += length($marker) + length($data);
        $linecount += linecount($marker, $data);
        push @$vfiles, $vfile;
        push @{$mfs{$marker}}, $vfile;
    }
    $afs{$file}{vfiles} = $vfiles;
    return @{$vfiles}[1..$#$vfiles]; 
}

my $new_counter = 0;
sub vf_open (*;$$$) {
    DEBUG && TRACE(@_);
    my $glob   = shift;
    my $file   = shift;
    my $symbol = shift;

    my $mode;
    if ($file && $file =~ /^(?:\|-|-\||>|<|>>|>:.*)$/) {
        $mode = $file;
        $file = $symbol;
        $symbol = shift;
    }

    no strict;
    if (defined $glob) {
	$glob = caller() . "::$glob" unless ref($glob) || $glob =~ /::/;
        # The following line somehow manages to cause failure on threaded perls.
        # The good news is that everything works just fine without it.
	# $glob = \*{$glob};
    }
    else {
	# autovivify for: open $fh, $filename
	$glob = $_[0] = \do{local *ANON};
    }

    if (!$mode) {
        # Resolve file
        $file ||= "";
        $file =~ s/^([^\w\s\/]*)\s*//i;
        $mode = $1 || "";

        if (!$mode && $file =~ s/\s*\|\s*$//) {
            $mode = $mode || "-|";
        }
    }
    unless ($file) {
        my $scalar = *{$glob}{SCALAR};
        $file = $scalar ? $$scalar : "";
        $file =~ s/^([^a-z\s\/]*)\s*//i;
        $mode = $mode || $1 || "<";
    }
    $mode ||= "<";
    $file = $mfs{$file}[0] if $file and exists $mfs{$file};

    # Create a new Inline file (for Inline::Files only)
    if (not $file and defined $Inline::Files::{get_filename}) {
	(my $marker = *{$glob}{NAME}) =~ s|.*::(.*)|$1|;
	if ($marker =~ /^[A-Z](?:_*[A-Z0-9]+)*$/) {
	    if ($file = Inline::Files::get_filename((caller)[0])) {
		$marker = "__${marker}__\n";
		my $vfile = sprintf "$file(NEW%-0.8d)", ++$new_counter;
		$vfs{$vfile} =
		  { data   => '',
		    marker => $marker,
		    offset => -1,
		    line   => -1,
		  };
		push @{$mfs{$marker}}, $vfile;
		push @{$afs{$file}{vfiles}}, $vfile;
		$file = $vfile;
	    }
	}
    }

    $! = 2, return 0 unless $file; # Can't work at this point; confuses core
    # Default to CORE::open
    unless (exists $vfs{$file}) {
        return CORE::open($glob, $mode, $file);
    }

    my $afile = $file =~ /^(.*)[(](NEW)?\d+[)]$/ ? $1 :
      croak "Internal error\n";

    # If file is virtual, tie it up, and set it up
    my $impl = tie (*$glob, 'Inline::Files::Virtual', 
		    $file, $afile, $mode, $symbol);

    $afs{$afile}{changed} = 0;
    $impl->TRUNCATE() if (exists $write{$mode}
			  and not exists $preserve{$mode});
    return 1;
}

sub linecount {
    DEBUG && TRACE();
    my $sum = 0;
    foreach (@_) { $sum += tr/\n// }
    return $sum;
}

sub vf_save {
    DEBUG && TRACE(@_);
    my @files = @_;
    @files = keys %afs unless @files;
    for my $file (@files) {
	next unless $afs{$file}{changed};
        $afs{$file}{changed}=0;
        local *FILE;
        open FILE, ">$file"
          and print FILE map { my $entry = $vfs{$_};
			       if (length $entry->{data}) {
				   chomp $entry->{data};
				   $entry->{data} .= "\n";
			       }
			       "$entry->{marker}$entry->{data}";
			   } @{$afs{$file}{vfiles}}
	and close FILE
	  or ($^W and warn "Could not vf_save '$file'\n$!")
	    and return 0;