diff variant_effect_predictor/Bio/Root/Global.pm @ 0:2bc9b66ada89 draft default tip

Uploaded
author mahtabm
date Thu, 11 Apr 2013 06:29:17 -0400
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/Root/Global.pm	Thu Apr 11 06:29:17 2013 -0400
@@ -0,0 +1,261 @@
+#--------------------------------------------------------------------------------
+# PACKAGE : Bio::Root::Global.pm
+# PURPOSE : Provides global data, objects, and methods potentially useful to 
+#           many different modules and scripts.
+# AUTHOR  : Steve Chervitz (sac@bioperl.org)
+# CREATED : 3 Sep 1996
+# REVISION: $Id: Global.pm,v 1.8 2002/01/11 08:05:31 sac Exp $
+#
+# INSTALLATION:
+#   This module is included with the central Bioperl distribution:
+#   http://bio.perl.org/Core/Latest
+#   ftp://bio.perl.org/pub/DIST
+#   Follow the installation instructions included in the README file.
+#
+# COMMENTS: Edit the $AUTHORITY string to a desired e-mail address.
+#
+#           STRICTNESS, VERBOSITY, and variables containing the words WARN and FATAL
+#           are considered experimental. The purpose & usage of these is explained 
+#           in Bio::Root::Object.pm.
+#             
+# MODIFIED: 
+#    sac --- Fri Jan  8 00:04:28 1999
+#      * Added BEGIN block to set $CGI if script is running as a cgi.
+#    sac --- Tue Dec 1 1998
+#      * Added $STRICTNESS and $VERBOSITY.
+#      * Deprecated WARN_ON_FATAL, FATAL_ON_WARN, DONT_WARN and related methods.
+#        These will eventually be removed.
+#    sac --- Fri 5 Jun 1998: Added @DAYS.
+#    sac --- Sun Aug 16 1998: Added $RECORD_ERR and &record_err().
+#--------------------------------------------------------------------------------
+
+### POD Documentation:
+
+=head1 NAME
+
+Bio::Root::Global - Global variables and utility functions
+
+=head1 SYNOPSIS
+
+    # no real synopsis - see Bio::Root::Object
+
+=head1 DESCRIPTION
+
+The Bio::Root::Global file contains all the global flags
+about erro warning etc, and also utility functions, eg
+to map numbers to roman numerals.
+
+These functions are generally called by Bio::Root::Object
+or somewhere similar, and not directly
+
+
+=head1 INSTALLATION
+
+This module is included with the central Bioperl distribution:
+
+   http://bio.perl.org/Core/Latest
+   ftp://bio.perl.org/pub/DIST
+
+Follow the installation instructions included in the README file.
+
+=cut
+
+package	 Bio::Root::Global;
+use strict;
+
+BEGIN {
+    use vars qw($CGI $TIMEOUT_SECS);
+
+    # $CGI is a boolean to indicate if the script is running as a CGI.
+    # Useful for conditionally producing HTML-formatted messages
+    # or suppressing messages appropriate only for interactive sessions.
+
+    $CGI = 1 if $ENV{REMOTE_ADDR} || $ENV{REMOTE_HOST};
+}
+
+use Exporter ();
+use vars qw($BASE_YEAR @DAYS @MONTHS);
+
+use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
+@ISA       = qw( Exporter );
+@EXPORT_OK = qw($AUTHORITY $NEWLINE
+		$DEBUG $MONITOR $TESTING 
+		$DONT_WARN $WARN_ON_FATAL $FATAL_ON_WARN $RECORD_ERR
+		$STRICTNESS $VERBOSITY $TIMEOUT_SECS
+		$CGI $GLOBAL 
+		$BASE_YEAR %ROMAN_NUMS @MONTHS @DAYS 
+		&roman2int &debug &monitor &testing &dont_warn &record_err
+		&warn_on_fatal &fatal_on_warn &strictness &verbosity
+		);
+
+%EXPORT_TAGS = (
+		
+		std   =>[qw($DEBUG $MONITOR $TESTING $NEWLINE
+			    $DONT_WARN $WARN_ON_FATAL $FATAL_ON_WARN $RECORD_ERR
+			    $STRICTNESS $VERBOSITY 
+			    &debug &monitor &testing &dont_warn 
+			    &warn_on_fatal &fatal_on_warn &record_err
+			    &strictness &verbosity
+			    &roman2int $AUTHORITY $CGI $GLOBAL)],
+
+		obj   =>[qw($GLOBAL)],
+
+		devel =>[qw($DEBUG $MONITOR $TESTING $DONT_WARN 
+			    $WARN_ON_FATAL $FATAL_ON_WARN $RECORD_ERR
+			    $STRICTNESS $VERBOSITY $NEWLINE		    
+			    &debug &monitor &testing &dont_warn 
+			    &strictness &verbosity
+			    &warn_on_fatal &fatal_on_warn)], 
+
+		data  =>[qw($BASE_YEAR %ROMAN_NUMS @MONTHS @DAYS)],
+
+		);
+
+# Note: record_err() is not included in the devel tag to allow Bio::Root:Object.pm
+#       to define it without a name clash.
+
+######################################
+##             Data                 ##
+######################################
+
+use vars qw($AUTHORITY $DEBUG $MONITOR $TESTING $DONT_WARN $WARN_ON_FATAL
+            $FATAL_ON_WARN $RECORD_ERR $STRICTNESS $VERBOSITY $NEWLINE
+            %ROMAN_NUMS $GLOBAL);
+
+# Who should receive feedback from users and possibly automatic error messages.
+$AUTHORITY     = 'sac@bioperl.org';
+ 
+$DEBUG         = 0;
+$MONITOR       = 0;
+$TESTING       = 0;
+$DONT_WARN     = 0;
+$WARN_ON_FATAL = 0; 
+$FATAL_ON_WARN = 0; 
+$RECORD_ERR    = 0;
+$STRICTNESS    = 0;
+$VERBOSITY     = 0;
+$TIMEOUT_SECS  = 30;  # Number of seconds to wait for input in I/O functions.
+
+$BASE_YEAR = 1900;
+$NEWLINE   = $ENV{'NEWLINE'} || undef;
+
+%ROMAN_NUMS  = ('1'=>'I',    '2'=>'II',    '3'=>'III',    '4'=>'IV',    '5'=>'V',
+		'6'=>'VI',   '7'=>'VII',   '8'=>'VIII',   '9'=>'IX',   '10'=>'X',
+               '11'=>'XI',  '12'=>'XII',  '13'=>'XIII',  '14'=>'XIV',  '15'=>'XV',
+               '16'=>'XVI', '17'=>'XVII', '18'=>'XVIII', '19'=>'XIX',  '20'=>'XX',
+               '21'=>'XXI', '22'=>'XXII', 
+		);
+
+@MONTHS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+@DAYS   = qw(Sun Mon Tue Wed Thu Fri Sat);
+
+# The implicit global object. Used for trapping miscellaneous errors/exceptions.
+# Created without using or requiring Bio::Root::Object.pm, because Object.pm uses Global.pm.
+# Just be sure to use Bio::Root::Object.pm, or a module that uses it.
+
+$GLOBAL = {};
+bless $GLOBAL, 'Bio::Root::Object';
+$GLOBAL->{'_name'} = 'Global object';
+
+
+######################################
+##         Methods                  ##
+######################################
+
+sub roman2int {
+    my $roman = uc(shift);
+    foreach (keys %ROMAN_NUMS) {
+	return $_ if $ROMAN_NUMS{$_} eq $roman;
+    }
+# Alternatively:
+#    my @int = grep $ROMAN_NUMS{$_} eq $roman, keys %ROMAN_NUMS;
+#    return $int[0];
+    undef;
+}
+
+sub debug {
+    my $level = shift;
+    if( defined $level) { $DEBUG = $level }
+    else { $DEBUG = 0 }
+#    $MONITOR and do{ print STDERR $DEBUG ? "Debug on ($DEBUG).\n\n" : "Debug off.\n\n"; };
+    $MONITOR and do{ print STDERR $DEBUG ? "Debug on ($DEBUG).\n\n" : ""; };
+    $DEBUG;
+}
+
+sub monitor {
+    my $level = shift;
+    if( defined $level) { $MONITOR = $level }
+    else { $MONITOR = 0 }
+    $DEBUG and (print STDERR "Monitor on ($MONITOR).\n\n");
+    $MONITOR;
+}
+
+sub testing {
+    my $level = shift;
+    if( defined $level) { $TESTING = $level }
+    else { $TESTING = 0 }
+    $TESTING ? ($MONITOR && print STDERR "Testing on ($TESTING).\n\n") : ($MONITOR && print STDERR "Testing off.\n\n");
+    $TESTING;
+}
+
+sub strictness {
+# Values can integers from -2 to 2
+# See Bio::Root::Object::strict() for more explanation.
+    my $arg = shift;
+    if( defined $arg) { $STRICTNESS = $arg}
+    $DEBUG && print STDERR "\n*** STRICTNESS: $arg ***\n\n";
+    $STRICTNESS;
+}
+
+sub verbosity {
+# Values can integers from -1 to 1
+# See Bio::Root::Object::verbose() for more explanation.
+    my $arg = shift;
+    if( defined $arg) { $VERBOSITY = $arg}
+    $DEBUG && print STDERR "\n*** VERBOSITY: $arg ***\n\n";
+    $VERBOSITY;
+}
+
+sub record_err {
+    if( defined shift) { $RECORD_ERR = 1}
+    else { $RECORD_ERR = 0 }
+    $RECORD_ERR ? ($DEBUG && print STDERR "\n*** RECORD_ERR on. ***\n\n") : ($DEBUG && print STDERR "RECORD_ERR off.\n\n");
+    $RECORD_ERR;
+}
+
+##
+## The following methods are deprecated and will eventually be removed.
+##
+
+sub dont_warn {
+    my $arg = shift;
+    !$CGI and print STDERR "\n$0: Deprecated method dont_warn() called. Use verbosity(-1) instead\n";
+    if( $arg) { verbosity(-1)}
+    else { verbosity(0); }
+}
+
+sub warn_on_fatal {
+    my $arg = shift;
+    !$CGI and print STDERR "\n$0: Deprecated method warn_on_fatal() called. Use strictness(-2) instead\n";
+    if( $arg) { strictness(-2)}
+    else { strictness(0); }
+}
+
+sub fatal_on_warn {
+    my $arg = shift;
+    !$CGI and print STDERR "\n$0: Deprecated method fatal_on_warn() called. Use strictness(2) instead\n";
+    if( $arg) { strictness(2)}
+    else { strictness(0); }
+}
+
+#####################################################################################
+#                            END OF PACKAGE 
+#####################################################################################
+
+1;
+
+
+
+
+
+