view release on metacpan or  search on metacpan

lib/Chemistry/File/SLN.pm  view on Meta::CPAN

            scratch => 0, charges => 0);
    }
    my @sln_attr;
    while (my ($attr, $value) = each %{$tree->{attr}}) {
        if ($attr eq 'name') {
            $mol->name($value);
        } elsif ($attr eq 'type') {
            $mol->type($value);
        } elsif ($attr eq 'coord3d') {
            $self->read_coords($mol, $value);
        } else {
            push @sln_attr, $attr, $value;
        }
    }
    $mol->attr("sln/attr", {@sln_attr}) if @sln_attr;
    $mol;

}

sub compile_atom {
    my ($self, $mol, $node, $closures) = @_;
    my $atom = $mol->new_atom(
        symbol          => $node->{symbol},
        hydrogens       => $node->{hcount},
        formal_charge   => $node->{attr}{charge},
    );
    $atom->attr("sln/attr", $node->{attr});
    delete $node->{attr}{charge};
    $closures->{$node->{id}} = $atom if $node->{id};
    $atom;
}

my %TYPE_TO_ORDER = (
    '-' => 1,
    '=' => 2,
    '#' => 3,
    ':' => 1, 
    '.' => 0,
);

sub compile_bond {
    my ($self, $mol, $node, $atom1, $atom2) = @_;
    my $order = $TYPE_TO_ORDER{$node->{type}};
    if ($order) {
        my $bond = $mol->new_bond(
            type => $node->{type}, 
            atoms=>[$atom1, $atom2],
            order => $order,
        );
        $bond->attr("sln/attr", $node->{attr});
        if ($node->{type} eq ':') { 
            $_->aromatic(1) for ($atom1, $atom2, $bond);
        }
    }
}

sub read_coords {
    my ($self, $mol, $coords_str) = @_;
    $coords_str =~ s/[()]//g;
    my (@coords) = split /,/, $coords_str;
    my $fh = $mol->formula_hash;
    my $n = sum(values %$fh);
    my $sprout = (@coords == 3*$n);
    for my $atom ($mol->atoms) {
        $atom->coords(splice @coords, 0, 3);
        if ($sprout) {
            for (1 .. $atom->implicit_hydrogens) {
                my $H = $mol->new_atom(symbol => 'H', 
                    coords => [splice @coords, 0, 3]);
                $mol->new_bond(atoms => [$atom, $H]);
            }
            $atom->implicit_hydrogens(0);
        } 
    }
}


########### WRITER #################


sub write_string {
    my ($self, $mol_ref, %opts) = @_;

    my $eol;
    my @mols;
    if ($opts{mols}) {
        @mols = @{$opts{mols}};
        $eol = "\n";
    } else {
        @mols = $mol_ref; 
        $eol = "";
    }

    my $sln;
    for my $mol (@mols) {
        $sln .= $self->write_mol($mol, %opts) . $eol;
    }
    $sln;
}

sub write_mol {
    my ($self, $mol, %opts) = @_;

    my $oldmol = $mol;
    $mol = $mol->clone; 

    my $sln = '';
    my @id_log;
    if ($mol->atoms) {
        my @atoms = $self->clean_mol($mol, %opts);

        my $visited = {};
        my @s;
        for my $atom (@atoms) {
            next if $visited->{$atom};
            my $ring_atoms = {};

            # first pass to find and number the ring bonds
            $self->find_ring_bonds($mol, \%opts, $atom, undef, {}, $ring_atoms);

            # second pass to actually generate the sln string