[Bio] / FigKernelPackages / gjolib.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/gjolib.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download) (as text)

1 : olson 1.3
2 :     # This is a SAS component.
3 :    
4 : olson 1.2 #
5 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
6 :     # for Interpretations of Genomes. All Rights Reserved.
7 :     #
8 :     # This file is part of the SEED Toolkit.
9 :     #
10 :     # The SEED Toolkit is free software. You can redistribute
11 :     # it and/or modify it under the terms of the SEED Toolkit
12 :     # Public License.
13 :     #
14 :     # You should have received a copy of the SEED Toolkit Public License
15 :     # along with this program; if not write to the University of Chicago
16 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
17 :     # Genomes at veronika@thefig.info or download a copy from
18 :     # http://www.theseed.org/LICENSE.TXT.
19 :     #
20 :    
21 : efrank 1.1 package gjolib;
22 :    
23 :     # Invoke with:
24 :     #
25 :     # use gjolib;
26 :    
27 :    
28 :     # Exported functions:
29 :     #
30 :     # file_root_name( $path )
31 :     # script_name( )
32 :     # wrap_text( $str [, $len [, $indent_1 [, $indent_n]]] )
33 :    
34 :     require Exporter;
35 :    
36 :     our @ISA = qw(Exporter);
37 :     our @EXPORT = qw(
38 :     file_root_name
39 :     script_name
40 :     wrap_text
41 :     );
42 :    
43 :     use strict;
44 :    
45 :    
46 :     #-----------------------------------------------------------------------------
47 :     # Return the base name of a file (no directory & remove 1 extension)
48 :     #
49 :     # $root_name = file_root_name( $path )
50 :     #-----------------------------------------------------------------------------
51 :     sub file_root_name {
52 :     $_ = shift;
53 :    
54 :     s/^.*\///; # remove all directory prefixes
55 :     s/\.[^.]*$//; # remove one dot something suffix
56 :     return $_;
57 :     }
58 :    
59 :    
60 :    
61 :     #-----------------------------------------------------------------------------
62 :     # Return the name of the invoked command
63 :     #
64 :     # $scriptname = script_name( )
65 :     #-----------------------------------------------------------------------------
66 :     sub script_name {
67 :     $_ = $0;
68 :     s/^.*\///; # remove all directory prefixes
69 :     return $_;
70 :     }
71 :    
72 :    
73 :    
74 :     #-----------------------------------------------------------------------------
75 :     # Return a string with text wrapped to defined line lengths:
76 :     #
77 :     # $wrapped_text = wrap_text( $str ) # default len = 80
78 :     # $wrapped_text = wrap_text( $str, $len ) # default ind = 0
79 :     # $wrapped_text = wrap_text( $str, $len, $indent ) # default ind_n = ind
80 :     # $wrapped_text = wrap_text( $str, $len, $indent_1, $indent_n )
81 :     #-----------------------------------------------------------------------------
82 :     sub wrap_text {
83 :     my ($str, $len, $ind, $indn) = @_;
84 :    
85 :     defined($str) || die "wrap_text called without a string\n";
86 :     defined($len) || ($len = 80);
87 :     defined($ind) || ($ind = 0);
88 :     ($ind < $len) || die "wrap error: indent greater than line length\n";
89 :     defined($indn) || ($indn = $ind);
90 :     ($indn < $len) || die "wrap error: indent_n greater than line length\n";
91 :    
92 :     $str =~ s/\s+$//;
93 :     $str =~ s/^\s+//;
94 :     my ($maxchr, $maxchr1);
95 :     my (@lines) = ();
96 :    
97 :     while ($str) {
98 :     $maxchr1 = ($maxchr = $len - $ind) - 1;
99 :     if ($maxchr >= length($str)) {
100 :     push @lines, (" " x $ind) . $str;
101 :     last;
102 :     }
103 :     elsif ($str =~ /^(.{0,$maxchr1}\S)\s+(\S.*)$/) { # no expr in {}
104 :     push @lines, (" " x $ind) . $1;
105 :     $str = $2;
106 :     }
107 :     elsif ($str =~ /^(.{0,$maxchr1}-)(.*)$/) {
108 :     push @lines, (" " x $ind) . $1;
109 :     $str = $2;
110 :     }
111 :     else {
112 :     push @lines, (" " x $ind) . substr($str, 0, $maxchr);
113 :     $str = substr($str, $maxchr);
114 :     }
115 :     $ind = $indn;
116 :     }
117 :    
118 :     return join("\n", @lines);
119 :     }
120 :    
121 :    
122 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3