view release on metacpan or  search on metacpan

lib/CAD/Drawing/IO/Circ.pm  view on Meta::CPAN

		@list = map({"$directory/$_$suffix"} keys(%{$s->{l}}));
	}
	else {
		@list = glob("$directory/*$suffix");
	}
	foreach my $file (@list) {
		my $layer = $file;
		$layer =~ s#^$directory/*##;
		$layer =~ s/$suffix$//;
		$n->{l} && ($n->{l}{$layer} && next);
#        print "$file -> $layer\n";
		open(CIRCLESIN, $file); 
		while(my $line = <CIRCLESIN>) {
			chomp($line);
			$line || next;
			my($ids,$cord,$r,$co,$lt) = split(/\s*:\s*/, $line);
			$s->{c} && ($s->{c}{$co} || next);
			$n->{c} && ($n->{c}{$co} && next);
#            print "adding id: $ids\n";
			my %addopts = (
					layer=>$layer,
					color=>$co, 
					linetype=>$lt,
					id=>$ids
					);
			my @pt = split(/\s*,\s*/, $cord);
			my $addr = $self->addcircle(\@pt, $r, {%addopts});
			push(@addr_list, $addr);
		} # end while reading file
		close(CIRCLESIN);
	} # end foreach $file
	return(@addr_list);
} # end subroutine load definition
########################################################################

=head2 save

  $drw->save();

=cut
sub save {
	my $self = shift;
	my ($directory, $opts) = @_;
	my %opts = %$opts;
	if(-e $directory) {
		(-d $directory) or croak("$directory is not a directory");
	}
	else {
		mkdir($directory) or croak("could not create $directory");
	}
	# does the new .circ file smash the old?
	my $suffix = $opts->{suffix};
	if(my $inf = $self->pingcirc($directory)) {
		$suffix || ($suffix = $inf->{suffix});
	}
	if($opts{type} =~ m/(\..*)$/) {
		$suffix = $1;
	}
	$suffix || die "need suffix\n";
	$opts{suffix} = $suffix;
	$self->write_circdata($directory, \%opts);
	my ($s, $n) = check_select($opts);
	foreach my $layer ($self->getLayerList()) {
		$s->{l} && ($s->{l}{$layer} || next);
		$n->{l} && ($n->{l}{$layer} && next);
		my $outfile = "$directory/$layer$suffix";
#        print "out to $outfile\n";
		open(CIRCLESOUT, ">$outfile") or 
			croak "cannot open $outfile for write\n";
		foreach my $circ ($self->getAddrByType($layer, "circles")) {
			my $obj = $self->getobj($circ);
			print CIRCLESOUT "$circ->{id}:" .
				join(",", @{$obj->{pt}}) . ":" .
				"$obj->{rad}:$obj->{color}:$obj->{linetype}\n";
			$opts->{kok} && $self->remove($circ);
		}
		close(CIRCLESOUT);
	}

} # end subroutine save definition
########################################################################

=head2 pingcirc

Returns a hash reference for colon-separated key-value pairs in the
".circ_data" file which is found inside of $directory.  If the file is
not found, returns undef. 

The key may not contain colons.  Colons in values will be preserved
as-is.

  $drw->pingcirc($directory);

=cut
sub pingcirc {
	my $self = shift;
	my ($directory) = @_;
	open(TAG, "$directory/$circtag") or return();
	my %info;
	foreach my $line (<TAG>) {
		$line =~ s/\s+$//;
		# keys may not contain colons, but values can
		# whitespace around first colon is optional
		my ($key, $val) = split(/\s*:\s*/, $line, 2);
		$info{$key} = $val;
		}
	close(TAG);
	return(\%info);
} # end subroutine pingcirc definition
########################################################################

=head2 write_circdata

  $drw->write_circdata($directory, \%options);

=cut
sub write_circdata {
	my $self = shift;
	my ($directory, $opts) = @_;
	my $circfile = "$directory/$circtag";
	# maybe load the existing one first and then over-write it?
	my $existing = $self->pingcirc($directory);
	my %info;
	$existing && (%info = %$existing);
	if($opts->{info}) {
		foreach my $key (%{$opts->{info}}) {
			$info{$key} = $opts->{info}{$key};
		}
	}
	$info{suffix} = $opts->{suffix};
	open(CDATA, ">$circfile") or croak "cannot open $circfile for write";
	foreach my $key (keys(%info)) {
		print CDATA "$key:$info{$key}\n";
	}
	close(CDATA);

} # end subroutine write_circdata definition
########################################################################


1;