Hi,
Here is a copy of the occp4.pm file which we use at the PDB Depositions
and Processing Site at the EBI. This perl module works and can be
called as following:
#/bin/perl
require '/ebi/msd/work2/msdsd/production/x86_64/lib/site_perl/occp4.pm';
my $sfcheck = new occp4('sfcheck','hklin'=>$sf,'xyzin'=>$pdb);
$sfcheck->logfile(">sfcheck_$pdbid.log");
$sfcheck->keywords(LABIN=>"I=I SIGI=SIGI");
&error("sfcheck did not complete properly, check $sflog file") if
($sfcheck->run());
Hope it helps.
Jawahar Swaminathan
[log in to unmask] wrote:
> Dear CCP4 users,
>
> I am writing a PERL script to execute a number of CCP4 commands (ncsmask,
> pdbset, and dm) in succession. I have tried using system call or PIPE
> command, neither of which work. The ccp4 scripts generated work independently
> on the command line.
>
>
> Any suggestions?
>
> Thank you in advance!
>
#!/ebi/msd/bin/perl
#
# $Id: occp4.pm,v 1.5 1999/02/08 08:35:42 manu Exp $
#
# $Log: occp4.pm,v $
# Revision 1.5 1999/02/08 08:35:42 manu
# added copyright notice
#
# Revision 1.4 1998/09/14 13:20:04 manu
# documentation
#
# Revision 1.3 1998/09/14 10:08:18 manu
# split_pdb
#
# Revision 1.2 1998/08/31 14:24:36 manu
# minor changes in documentation
#
# Revision 1.1 1998/08/31 13:42:58 manu
# Initial revision
#
# This is occp4.pm, an object-oriented perl module for writing ccp4 scripts
# Copyright (C) 1999 Emmanuel Courcelle & Jean-Pierre Samama
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#
# New versions should be available on ftp://ftp.ipbs.fr
# Comments are to be sent to [log in to unmask]
#
=head1 NAME
occp4.pm - Object oriented CCP4 module
=head1 DESCRIPTION
This module is VERY useful when you want to use ccp4 programs from within
a perl script. The ccp4 environment I<must> be loaded before the script is
started.
=head1 The constructors
$ccp4_obj = new OCCP4('prgm_name',log1=>"file1",log2=>"file2",...);
B<'prgm_name'> is the name of a ccp4 program.
B<log1=E<gt>"file1"> are pairs of logical names/real names, used by the
ccp4 programs for specifying the input/output files. Those parameters are
optional, and may be overriden with the iofiles (see L<"iofiles, iofildel">
member function).
=head1 The destructor
When the memory allocated for the object is returned to the system (at the end
of the block, or more generally when no reference points to that object, see
perl documentation for the details),
a destructor is called. Its only action is to unlink the temporary files
which did belong to this object.
If the debug flag 'F' is specified, the files are I<not> unlinked, but a
message is printed to the standard output.
=head1 The member functions
Following paragraphs describe the member functions available from every object.
=head2 keywords, keywdel, keywrep
(1) $ccp4_obj->keywords(keyw1=>"val1",keyw2=>"val2",...)
(2) $value=$ccp4_obj->keywords('keyword')
(3) @value=$ccp4_obj->keywords('keyword')
(4) @keywords=$ccp4_obj->keywords()
(5) $ccp4_obj->keywdel('keyw1','keyw2')
(6) $ccp4_obj->keywrep(keyw1=>"val1",keyw2=>"val2")
You must use (1) to set the value of one or several keywords.
If the function is called and this keyword is already defined,
the new value is 'appended', ie the same keyword may appear several times.
(2) is used to retrieve the value of one specific keyword. If the keyword
appears several times, B<only the first> occurrence of the keyword will be
retrieved this way. If you want to retrieve B<all> occurrences of a specific
keyword, use (3). (4) is used to retrieve all the keyword/value pairs in one
operation. (5) The keywdel function is used to delete B<all occurrences> of
one given keyword. (6) The keywrep function deletes B<all occurrences> of
the specified keywords, and replaces them with the values passed by parameters.
See also L<"Special values">, L<"input_file, input_string, input_src">,
L<"The KCCP4 and LCCP4 global variables">.
=head2 iofiles, iofildel
(1) $ccp4_obj->iofiles(HKLIN=>"$file1",HKLOUT=>"$file2",...)
(2) $file=$ccp4_obj->iofiles('HKLIN')
(3) %files=$ccp4_obj->iofiles()
(4) $ccp4_obj->iofildel('HKLIN')
(1) is used to set or change the value of a logical name for the input or
output files (they can also. (2) is used to retrieve the value of a
logical name. (3) is used to retrieve all logical name/real name pairs.
(4) iofildel is used to delete one logical name from the list of iofiles.
See also L<"Special values">, L<"The KCCP4 and LCCP4 global variables">
=over 4
=item differences between keywords() and iofiles()
=back
There are important differences between keywords and iofiles:
=over 4
=item *
The files parameters are specified on the command line, but the keywords
are specified through the standard input. See also the ccp4 documentation
=item *
There may be several occurrences of one given keyword, but B<only one>
occurrence of one logical name
=back
=head2 Special values
=over 4
=item CHANA.ext
The special value 'CHANA' or 'CHANA.ext' means that the module must choose a
temporary file name (CHANA="CHoose A NAme"), so that you don't have to bother
with this. However, you may specify an extension (.ext). If you specify only
CHANA, there is no extension. This value may appear anywhere in the iofiles or
keywords values.
More important, when this value is specified, the file is recorded as a
temporary file, and it is removed when the object is destroyed.
See also L<"chana">.
=back
=head2 input_file, input_string, input_src
=over 4
=item input_file
(1) $ccp4_obj->input_file("filename")
(2) $value=$ccp4_obj->input_file
Only used if "F" (file) is one of the sources specified.
(1) Selects the name of the file, (2) returns the previously selected name.
=item input_string
(1) $ccp4_obj->input_string("string")
(2) $value=$ccp4_obj->input_string
Only used if "S" (String) is one of the sources specified.
(1) Sets the string, (2) returns the current string.
=item input_src
(1) $ccp4_obj->input_src("K F S")
(2) $value=$ccp4_obj->input_src
Select/return the sources for the standard input of the ccp4 program.
I<K> means keywords, I<F> means File, I<S> means String. The order of the
selected source is important, so that the "K F S" means: use the keywords,
then the file, end with the string. This allows to use programs other than
ccp4, for instance xplor. Default value is "K" (Keywords only).
=back
=head2 logfile
(1) $ccp4_obj->logfile("String")
(2) $ccp4_obj->logfile(">>String")
(3) $value=$ccp4_obj->logfile();
Selects the name of the logfile. A value of logfile is chosen by the object as
soon as the object is created. This value can be retrieved using (3). It can
be overriden using (1) or (2). When using (2), the logfile is opened in
append mode.
B<WARNING> If you do not modify the name of the logfile, this file is
considered as a I<temporary> file, because the name is internally chosen using
the B<chana> algorithm (see L<"chana">).
=head2 environ, defaults, nodef, verbosity
(1) $ccp4_obj->environ($file)
(2) $value = $ccp4_obj->environ()
(3) $ccp4_obj->default($file)
(4) $value = $ccp4_obj->default()
(5) $ccp4_obj->nodef(1)
(6) $ccp4_obj->nodef(0)
(7) $value = $ccp4_obj->nodef()
(8) $ccp4_obj->verbosity(n)
(9) $value=$ccp4_obj->verbosity()
(1) and (2) are used to set and retrieve the environ.def file. If this
parameter is set, the program is ran with the -e option
(see the ccp4 documentation).
(3) and (4) are used to set and retrieve the default.def file. If this
parameter is set, the program is ran with the -d option
(see the ccp4 documentation).
(5) If nodef is set the ccp4 program is called with the -n option. (6) resets
the option, (7) queries the object about the status of this option (see the
ccp4 documentation).
(8) sets the verbosity level, (9) queries the current level. See the ccp4
documentation. Default is 0, ie no -v option.
=head2 run
$ccp4_obj->run()
The ccp4 program is run, as explained here:
=over 4
=item *
The command line is built by the object, using the iofiles (logicals and
real names) and the currently selected options
(see L<"environ, defaults, nodef, verbosity"> and L<"iofiles, iofildel">).
=item *
The keywords (keyword-values pairs), the file, or the string, as selected by
I<input_src>, are copied to a temporary file. The standard input is redirected
to this file. See L<"keywords, keywdel, keywrep"> and
L<"input_file, input_string, input_src">.
=item *
The output is redirected to a logfile, whose name may be fixed with the
I<logfile()> member function. If there is no currently selected name,
the program will use a temporary file, choosing a name by himself. See
L<"logfile">
=item *
If the debug flag 'R' is selected for this object (see debug), a message is
printed to the error standard.
=item *
If the debug flag 'V' is selected for this object (see debug), every file
declared with a logical (see iofiles) is verified agains existence, size, etc.
See L<"Debugging support">.
=item *
The ccp4 program is ran, an the function returns the exit code of the program
=back
=head2 chana
$ccp4_obj->chana(ext);
The chana (CHoose A NAme) function returns a temporary file name.
The file is named $PID-prgm-oid-$fid.ext with:
=over 4
=item $PID
The pid of the process, as allocated by perl
=item prgm
The ccp4 program name attached to this object.
=item $oid
The object-id
=item $fid
The file-id, incremented every time the function is called for a given object
=item ext
passed by parameter if any. If no parameter is specified, there is no
extension. When the reserved 'CHANA.ext' parameter is specified to a keyword
or an iofiles, this function is called.
=back
When the special value 'CHANA' or 'CHANA.ext' is specified in a keyword or in an
iofiles call, this function is internally called.
See L<"Special values">.
=over 4
=item tips using the chana function
This function is very convenient to create temporary file names: it is
possible to create a temporary object, with a dummy program name, then
calling chana to retrieve a name of temporary file. You may create and use
the file, it will be deleted when the object is destoyed.
=begin html
<PRE>
my $tmp_file=new occp4('tmp-file');
$tmp_file->chana('mtz');
$tmp_file=0;
</PRE>
=end html
=back
=head1 Debugging support
Several debugging flags are provided:
=over 4
=item *
B<"" [default value]> no debug
=item *
B<"N"> A message is printed to stderr when an object is created
=item *
B<"D"> A message is printed to stderr when an object is destroyed
=item *
B<"R"> A message is printed to stderr when an object executes a ccp4 program. The options, the logicals, the keywords are printed.
=item *
B<"V"> Every file specified in iofiles is checked, and a message is displayed
about it (does it exist or not,...)
=item *
B<"F"> When the object is destroyed, no file is deleted, but a message is
displayed instead.
=back
The debugging can be obtained with the modification of the occp4::DEBUG
variable, or by using a member function. The first method is valid for ALL
objects created after the modification, the second may be applied on an
object-by-object basis.
=over 4
=item the occp4::DEBUG variable
When this variable is set as just explained, every subsequently created object
is affected with this debug level. It is thus convenient to set the debug level
for all the objects in one time. However, the already created objects are not
affected by a modification of this variable.
=item The debug member function
$ccp4_obj->debug("D") permits to set the debug level for only one object.
=back
=head1 Global variables
=head2 The KCCP4 and LCCP4 global variables
(1) $occp4::KCCP4 = 0;
(2) $occp4::LCCP4 = 0;
The default value for those variables is '1'.
KCCP4 governs the way the keywords are treated: if 1, they are treated as
explained in the ccp4 documentation, ie only the first four characters are
recognized, and the case is ignored. Thus, keyword 'FORM' and 'format' are
considered by occp4 as 'FORM'. if 0, the keywords 'FORM' and 'format' are
considered bu occp4 as two different keywords. This may sometimes lead to
difficult track bugs, as however those keywords are not different for the
underlying ccp4 program.
LCCP4 governs the way the logicals are treated: if 1, the case is ignored, as
in ccp4, if 0 the case is not ignored, so that 'hklin' is considered by
the module as different from 'HKLIN'.
=head1 Other variables and functions
The following describes convenient functions included with the package.
=head2 occp4::user
$user = occp4::user
The user name is stored in this variable. More portable than using `whoami`.
=head2 occp4::date
$date = occp4::date();
Returns the date, correctly formated for displaying.
More portable than using `date`.
=head2 occp4::cat
occp4::cat("file1","file2",...,"fileN");
Concatenates the ascii files file1, file2, ... to the file fileN.
Just to retrieve the convenient unix function cat, in a portable way.
=head2 The occp4::pdb_split function
This function is useful for splitting a line read from a pdb file, using the
pdb specifications. Each pdb record should be [hummm... not sure of the
completness] recognized, so that the line is correctly splitted.
my @fields = occp4::pdb_split(string);
returns an array, each item is a field of the record.
If it is a ATOM record, for instance, $fields[8],$fields[9], $fields[10] are
the X,Y,Z coordinates.
=head1 WARNING
=over 4
=item *
Modifying $occp4::KCCP4 and $occp4::LCCP4 global variables could lead to
unpredictable results, unless you modifiy those variables at the beginning
of your script, just before creating any new object.
=item *
It is somewhat stupid calling $ccp4_obj->debut("N"): as the object is already
created, it is too late for him... Thus the debug flag "N" must be specified
through the global variable $occp4::debug
=back
=head1 BUGS
The pdb_split function is incomplete.
None I am aware of. Please send a mail tp [log in to unmask] if you find some.
=head1 COPYRIGHT
manu, just for free people
=for html (
<A HREF=http://lpf.ai.mit.edu/>see lpf</A>)
=head1 AUTHOR
Emmanuel COURCELLE ([log in to unmask])
=cut
#
#
package occp4;
use strict;
use English;
use Carp;
#
# Global varables = they may be used by the caller
#
$occp4::VERSION='1.00';
$occp4::DEBUG="";
$occp4::TMPDIR=$ENV{'CCP4_SCR'};
$occp4::KCCP4=1; # See the function _kccp4
$occp4::LCCP4=1; # See the function _lccp4
#
# Object counter = increased by the constructor, never decreased.
# Thus, every created object will have a unique Id (oid)
my $occp4_count = 0;
#
# BEGIN
#
# This sub is called when a 'require OCCP4' is executed.
# Several variables are initialized, and a check is made to be sure that ccp4 and xplor are loaded.
#
sub BEGIN {
croak "ERROR - can't find \$CBIN env variable" unless (exists $ENV{'CBIN'});
croak "ERROR - can't find \$CCP4_SCR env variable" unless (exists $ENV{'CCP4_SCR'});
$occp4::PID=$$;
$occp4::user = getpwuid($UID);
};
#
# new
#
# The constructor of our occp4 class
#
# Init all private fields...
#
# $oid the object id
# $fid the file id (for file names created by CHANA)
# $ccp4_appli the ccp4 program
# $DEBUG the initial debug level
# %iofiles the iofiles hash
# @delfiles files to delete when the object is destroyed
#
sub new {
my $proto=shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
$occp4_count++;
my $oid = $occp4_count;
$self->{'oid'} = $oid;
my $fid=0;
$self->{'fid'} = \$fid;
$self->{'ccp4_appli'}=shift;
$self->{'DEBUG'} = $occp4::DEBUG;
my @delfiles;
$self->{'delfiles'} = \@delfiles;
my %iofiles;
$self->{'iofiles'}=\%iofiles;
confess ('Bad parameters') if ($#_==0);
$self->iofiles(@_) if ($#_>0);
$self->{'nodef'}=0;
$self->{'verbosity'}=0;
my %keywords;
$self->{'keywords'}=\%keywords;
$self->{'input_src'}='K';
if ($occp4::DEBUG =~ /N/) { # debug - print a msg to stderr
print STDERR "occp4 object created - $self->{'ccp4_appli'}";
print STDERR " - id = $oid\n";
};
return $self;
};
#
# DESTROY
# The destructor of all our objects
#
sub DESTROY {
my $self=shift;
my $delfiles=$self->{'delfiles'};
my $DEBUG=$self->{'DEBUG'};
if ($DEBUG =~ /D/) {
print STDERR "occp4 object destructed - $self->{'ccp4_appli'} - ";
print STDERR "id = $self->{'oid'}\n";
};
if ($#$delfiles>=0) {
foreach my $f (@$delfiles) {
if ($DEBUG =~ /F/) {
print STDERR "DEBUG FLAG F - file $f Not deleted\n";
} else {
unlink($f);
print STDERR " deleted file $f\n" if ($DEBUG =~ /D/);
};
};
};
};
#
# logfile
#
# If called without arg, just read the currently logfile if any, else generate a logfile
# If called with an arg, replace the current logfile with the new logfile.
#
sub logfile {
my $self=shift;
my $forcelog=shift;
if ($forcelog) {
my $logfile;
if ($forcelog =~ /^CHANA/) {
$logfile=$self->chana('log');
} else {
$logfile=$forcelog;
};
$self->{'logfile'} = $logfile;
return $logfile;
} else {
return $self->{'logfile'} if (exists $self->{'logfile'});
my $logfile=$self->chana('log');
$self->{'logfile'}=$logfile;
return $logfile;
};
};
#
# chana
#
# The Choose a Name member function
# param = the extension (optional)
#
sub chana {
my $self = shift;
my $ext = shift;
my $fct = $self->{'ccp4_appli'};
my $oid = $self->{'oid'};
my $fid = $self->{'fid'}; # NOTE - THIS is a reference to the real value
my $delfiles=$self->{'delfiles'};
my $filename = _chana($fct,$oid,$fid,$ext);
push(@$delfiles,$filename);
return $filename;
};
#
# keywords
#
# To set/retrieve keyword/values pairs of parameters
# This function is just an interface to several different functions
#
# --> No arg, List context calls _get_kwd_all
# --> No arg, Scalar context ERROR
# --> One arg, List context calls _get_kwd_one_list
# --> One arg, Scalar context calls _get_kwd_one_scalar
# --> Even nb of arguments, calls _set_kwd
#
# NOTE - Warning, there is always at least the $self arg.
#
sub keywords {
return _get_kwd_all(@_) if ($#_==0 and wantarray());
confess('Bad context') if ($#_==0 and !wantarray());
return _get_kwd_one_list(@_) if ($#_==1 and wantarray());
return _get_kwd_one_scalar(@_) if ($#_==1 and !wantarray());
return _set_kwd(@_) if ($#_>1);
};
#
# _set_kwd
#
# Set the keywords/pairs to the values requested.
#
sub _set_kwd {
my $self=shift;
confess ('odd number of parameters') if ($#_%2==0);
my $keywords=$self->{'keywords'};
while ($#_ >= 0) { # scan the parameters
my $k=shift;
$k=_kccp4($k);
my $v=shift;
if (!exists $keywords->{$k}) { # this keywords does not exist yet
my @val=();
$keywords->{$k}=\@val; # create an array for him
};
while ( $v =~ /CHANA\.(\w+)/ ) { # track CHANA.ext patterns
my $sv=$self->chana($1);
$v =~ s/CHANA\.\w+/$sv/;
};
while ( $v =~ /CHANA/ ) { # track remaining CHANA patterns
my $sv=$self->chana();
$v =~ s/CHANA/$sv/;
};
my $val=$keywords->{$k};
push(@$val,$v); # push a new value in the array
};
return 1; # dummy return value;
};
#
# _get_kwd_all
#
# get ALL keywords in one operation
# Retrieve all keywords.
# The keyword is formatted as follows:
# KEYWORD value
# It is thus legal to write something like:
#
# open(FILE ">KEYWORDS");
# <FILE>=$obj->keywords();
# close(FILE)
#
sub _get_kwd_all {
my $self=shift;
my $keywords=$self->{'keywords'};
my @rvl=();
foreach my $k (keys %$keywords) {
my $val=$keywords->{$k};
foreach my $v (@$val) {
push(@rvl,"$k $v");
};
};
return @rvl;
};
#
# _get_kwd_one_list
#
# get One keyword value, in a list context
# The list returned is the array of values for this keyword
#
sub _get_kwd_one_list {
my $self=shift;
my $k=shift;
my $keywords=$self->{'keywords'};
my $val=$keywords->{_kccp4($k)};
return @$val;
}
#
# _get_kwd_one_scalar
#
# get one keyword value, in a scalar context
# WARNING !!! Return ONLY the first value of this keyword
#
sub _get_kwd_one_scalar {
my $self=shift;
my $k=shift;
my $keywords=$self->{'keywords'};
my $val=$keywords->{_kccp4($k)};
return $$val[0];
}
#
# keywdel
#
# deletes all occurrences of the keywords passed by parameters
#
sub keywdel {
my $self=shift;
my $keywords=$self->{'keywords'};
my @keywds;
foreach my $k (@_) {
push(@keywds,_kccp4($k));
};
foreach my $k (@keywds) {
if (exists($keywords->{$k})) {
delete($keywords->{$k});
} else {
carp "Keyword $k unknown";
};
};
};
#
# keywrep
#
# For each keyword passed by parameter, replace its value with
# new values.
#
sub keywrep {
my $self=shift;
my $keywords=$self->{'keywords'};
my %kv = @_; # The parameters list
my @ks; # The sorted keywords
foreach my $k (sort keys %kv) {
push(@ks,_kccp4($k));
};
my @uks; # The sorted, uniq keywords
my $old_k=0;
for my $k (@ks) {
next if ($k eq $old_k);
push(@uks,$k);
$old_k=$k;
};
$self->keywdel(@uks); # Delete all those keywords
$self->keywords(%kv);
};
#
# _kcpp4
#
# replace the keyword passed by parameter with a ccp4-equivalent keyword:
# -capitalize it
# -use only first 4 letters
# return the modified keyword, unless $occp4::KCCP4 == 0
#
sub _kccp4 {
my $k=shift;
return $occp4::KCCP4 ? uc(substr($k,0,4)) : $k;
};
#
# _lccp4
#
# replace the logical name passed by parameter with the same name, capitalized.
# return the capitalized name, unless $occp4::LCCP4 == 0
#
sub _lccp4 {
my $l=shift;
return $occp4::LCCP4 ? uc($l) : $l;
};
#
#
#
# iofiles
#
# If no parameter, returns the %iofiles hash
# If one parameter, returns the real file name associated with this logical
# If several parameters, those must be (log/real) pairs, set those logicals and returns none.
#
sub iofiles {
my $self=shift;
my $iofiles=$self->{'iofiles'};
return %$iofiles if ($#_==-1); # No parameter
return $iofiles->{_lccp4($_[0])} if ($#_==0); # One parameter
while ($#_>-1) {
confess ("Bad parameters") if ($#_==0); # bad (key,files) parameters
my $logical=shift;
my $filename=shift;
$self->occp4::_new_iofiles($logical,$filename);
};
};
#
# _new_iofiles
#
# Declare a new iofile for this object.
# If this logical already exists, it is replaced by the new file name.
# Called by new and iofiles()
#
# param 1 = logical
# param 2 = file name
#
sub _new_iofiles {
my $self=shift;
my $logical=shift;
$logical=_lccp4($logical);
my $filename=shift;
my $iofiles=$self->{'iofiles'};
if ($filename =~ /^CHANA\.(.+)?/) { # CHANA.ext
my $ext = $1;
$filename = $self->chana($ext);
};
if ($filename eq 'CHANA') { # CHANA
$filename = $self->chana();
};
$iofiles->{$logical} = $filename;
};
#
# iofildel
#
# Deletes the iofiles whose logicals are passed by parameters
#
sub iofildel {
my $self=shift;
my $iofiles=$self->{'iofiles'};
for my $l (@_) {
$l=_lccp4($l);
if (exists($iofiles->{$l})) {
delete $iofiles->{$l};
} else {
carp "logical $l unknown";
};
};
}
#
# environ, default, nodef, verbosity subs
#
sub environ {
my $self=shift;
$self->{'environ'} = shift if ($#==0);
return $self->{'environ'};
};
sub default {
my $self=shift;
$self->{'default'} = shift if ($#==0);
return $self->{'default'};
};
sub nodef {
my $self=shift;
$self->{'nodef'} = shift if ($#==0);
return $self->{'nodef'};
};
sub verbosity {
my $self=shift;
$self->{'verbosity'} = shift if ($#==0);
return $self->{'verbosity'};
};
#
# input_src, input_file, input_string
#
sub input_src {
my $self=shift;
if ($#==0) {
my $input_src=shift;
$self->{'input_src'} = $input_src;
};
return $self->{'input_src'};
};
sub input_file {
my $self=shift;
if ($#==0) {
my $filename = shift;
if ($filename =~ /^CHANA\.(.+)?/) { # CHANA.ext
my $ext = $1;
$filename = $self->chana($ext);
};
if ($filename eq 'CHANA') { # CHANA
$filename = $self->chana();
};
$self->{'input_file'} = $filename;
};
return $self->{'input_file'};
};
sub input_string {
my $self=shift;
$self->{'input_string'} = shift if ($#==0);
return $self->{'input_string'};
};
#
# run
#
# Run the program
#
# 1/ Create a temporary file
# 2/ Write the (keywords, value) to this file
# 3/ Build the command line
# 4/ execute the program
# 5/ return the status
#
sub run {
my $self=shift;
my $ccp4_appli = $self->{'ccp4_appli'};
my $infile = $self->chana("run"); # Temporary .run file
open(INFILE,">$infile");
foreach my $s (split(/ /,$self->{'input_src'})) { # 1, 2 or 3 sources
if ($s eq 'K') { # KEYWORDS
my $keywords=$self->{'keywords'};
foreach my $k (keys %$keywords) {
my $values=$keywords->{$k};
foreach my $v (@$values) {
print INFILE "$k $v\n";
};
};
};
if ($s eq 'S') { # STRING
confess "No input_string set" unless (exists($self->{'input_string'}));
print INFILE "$self->{'input_string'}\n";
};
if ($s eq 'F') { # FILE
confess "No input_file set" unless (exists($self->{'input_file'}));
open(INFILE_SRC,"$self->{'input_file'}");
while(<INFILE_SRC>) {
print INFILE;
};
close(INFILE_SRC);
};
};
print INFILE "END\n";
close(INFILE);
my $logfile= $self->logfile();
my $cmd_line;
$cmd_line .= $ccp4_appli;
$cmd_line .= " -n" if ($self->{'nodef'});
$cmd_line .= " -v $self->{'verbosity'}" if ($self->{'verbosity'});
$cmd_line .= " -d $self->{'default'}" if (exists $self->{'default'});
$cmd_line .= " -e $self->{'environ'}" if (exists $self->{'environ'});
my $iofiles = $self->{'iofiles'};
foreach my $f (keys %$iofiles) {
$cmd_line .= " $f $iofiles->{$f}";
};
if ( $logfile =~ /^\s*>>/ ) { # logfile starts with '>>'
$cmd_line .= " <$infile $logfile";
} else {
$cmd_line .= " <$infile >$logfile";
};
my $DEBUG=$self->{'DEBUG'};
if ($DEBUG =~ /R/) {
print STDERR "occp4 object runnning - $ccp4_appli";
print STDERR " - id = $self->{'oid'}\n";
print STDERR "command line = $cmd_line\n";
print STDERR "keywords src = $self->{'input_src'}\n";
print STDERR "keywords = ";
open(INFILE,"$infile");
my $flg=0;
while (<INFILE>) {
print STDERR " " x15 if ($flg++);
print STDERR;
};
close (INFILE);
};
if ($DEBUG =~ /V/) {
foreach my $k (keys %$iofiles) {
my $f = $iofiles->{$k};
print STDERR "key $k, file $f ";
if (! -e $f) {
print STDERR "does not exist " unless ( -e $f);
} else {
print STDERR "cannot be read " unless ( -r $f);
print STDERR "cannot be written " unless (-w $f);
print STDERR "is not owned by you " unless (-o $f);
if (-z $f) {
print STDERR "has zero size";
} else {
my $size = -s $f;
print STDERR "is $size length";
};
};
print "\n";
};
};
if ($DEBUG =~ /R/) {
print STDERR "now running $ccp4_appli...";
};
my $status = system($cmd_line);
$status = $status / 256;
if ($DEBUG =~ /R/) {
print STDERR "status = $status\n";
};
return $status;
};
#
# _chana
#
# Choose a name.
#
# param1 = a pattern to include to the filename
# param2 = the oid
# param3 = a ref to the fid
# param4 = an extension (optional)
#
# GLOBAL VARIABLES USED:
#
# $PID
# $TMPDIR
#
# The fid is incremented, then the four parameters are used to build
# a file name.
#
sub _chana {
my $patt=shift;
my $oid=shift;
my $fid=shift;
my $ext=shift;
($$fid)++; # Increment the value pointed to by $fid
my $filename=$occp4::TMPDIR;
$filename .= "/${PID}_${patt}_${oid}_$${fid}";
if ($ext) {
$filename .= ".$ext";
};
return $filename;
};
#
# debug
#
# Set the debug level only for this object
#
sub debug {
my $self=shift;
my $debug=shift;
$self->{'DEBUG'}=$debug;
};
#
# date function
#
sub date {
my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
$mon++;
$year += 1900;
return "$mday-$mon-$year $hour:$min";
};
#
# cat function
# concatenates the N-1 arguments (= filenames) to the LAST argument.
#
sub cat {
my $to_file = pop;
$to_file = '>>'.$to_file
unless ( $to_file =~ /^\s*>>/ );
open (TOFILE,$to_file);
croak "occp4::cat bad number of parameters" if ($#_ == -1);
foreach my $f (@_) {
open (FROMFILE, $f) || croak "cannot open $f";
while (<FROMFILE>) {
print TOFILE;
};
close(FROMFILE);
};
close(TOFILE);
};
#
# pdb functions
#
%occp4::pdb_records =
(
'HEADER','1-6 11-50 51-59 63-66',
'REMARK','1-6 8-10 12-70',
'ATOM','1-6 7-11 13-16 17 18-20 22 23-26 27 31-38 39-46 47-54 55-60 61-66 73-76 77-78 79-80',
'HETATM','1-6 7-11 13-16 17 18-20 22 23-26 27 31-38 39-46 47-54 55-60 61-66 73-76 77-78 79-80',
'TITLE','1-6 9-10 11-70',
'CAVEAT','1-6 9-10 12-15 20-70',
'COMPND','1-6 9-10 11-70',
'SOURCE','1-6 9-10 11-70',
'KEYWDS','1-6 9-10 11-70',
'EXPDTA','1-6 9-10 11-70',
'AUTHOR','1-6 9-10 11-70',
'REVDAT','1-6 8-10 11-12 14-22 24-28 32-32 40-45 47-52 54-59 61-66',
'JRNL','1-6 13-70',
'HETNAM','1-6 9-10 12-14 16-70',
'HETSYN','1-6 9-10 12-14 16-70',
'FORMUL','1-6 9-10 13-15 17-18 19-19 20-70',
'HELIX','1-6 8-10 12-14 16-18 20-20 22-25 26 28-30 32 34-37 38 39-40 41-70 72-76',
'SHEET','1-6 8-10 12-14 15-16 18-20 22 23-26 27 29-31 33 34-37 38 39-40 42-45 46-48 50 51-54 55 57-60 61-63 65 66-69 70',
'TURN','1-6 8-10 12-14 16-18 20 21-24 25 27-29 31 32-35 36 41-70',
'MODEL','1-6 11-14',
'SIGATM','1-6 7-11 13-16 17 18-20 22 23-26 27 31-38 39-46 47-54 55-60 61-66 73-76 77-78 79-80',
'ANISOU','1-6 7-11 13-16 17 18-20 22 23-26 27 29-35 36-42 43-49 50-56 57-63 64-70 73-76 77-78 79-80',
'SIGULJ','1-6 7-11 13-16 17 18-20 22 23-26 27 29-35 36-42 43-49 50-56 57-63 64-70 73-76 77-78 79-80',
'TER','1-6 7-11 18-20 22 23-26 27',
'ENDMDL','1-6');
#
# sub
#
# split a pdb line (parameter) in fields, and returns the fields.
#
sub pdb_split {
my $line=shift;
my $recname=substr($line,0,6);
$recname =~ s/^(\w+)\s+/$1/;
confess("No such record in my tables")
unless (exists $occp4::pdb_records{$recname});
my @field_index = split(/ /,$occp4::pdb_records{$recname});
my @fields;
for my $f (@field_index) {
my $fs; # The Field Start
my $fl; # The Field Length
if ($f =~ /^(\d+)-(\d+)/) {
$fs=$1-1;
$fl=$2-$1+1;
} else {
$fs=$f-1;
$fl=1;
};
push(@fields,substr($line,$fs,$fl));
};
return @fields
};
1;
|
