← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:05 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/String/ShellQuote.pm
StatementsExecuted 11 statements in 471µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11110µs12µsString::ShellQuote::::BEGIN@28String::ShellQuote::BEGIN@28
1116µs40µsString::ShellQuote::::BEGIN@29String::ShellQuote::BEGIN@29
0000s0sString::ShellQuote::::_shell_quote_backendString::ShellQuote::_shell_quote_backend
0000s0sString::ShellQuote::::croakString::ShellQuote::croak
0000s0sString::ShellQuote::::shell_comment_quoteString::ShellQuote::shell_comment_quote
0000s0sString::ShellQuote::::shell_quoteString::ShellQuote::shell_quote
0000s0sString::ShellQuote::::shell_quote_best_effortString::ShellQuote::shell_quote_best_effort
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# $Id: ShellQuote.pm,v 1.11 2010-06-11 20:08:57 roderick Exp $
2#
3# Copyright (c) 1997 Roderick Schertler. All rights reserved. This
4# program is free software; you can redistribute it and/or modify it
5# under the same terms as Perl itself.
6
7=head1 NAME
8
9String::ShellQuote - quote strings for passing through the shell
10
11=head1 SYNOPSIS
12
13 $string = shell_quote @list;
14 $string = shell_quote_best_effort @list;
15 $string = shell_comment_quote $string;
16
17=head1 DESCRIPTION
18
19This module contains some functions which are useful for quoting strings
20which are going to pass through the shell or a shell-like object.
21
22=over
23
24=cut
25
26package String::ShellQuote;
27
28319µs214µs
# spent 12µs (10+2) within String::ShellQuote::BEGIN@28 which was called: # once (10µs+2µs) by Net::SCP::BEGIN@8 at line 28
use strict;
# spent 12µs making 1 call to String::ShellQuote::BEGIN@28 # spent 2µs making 1 call to strict::import
293440µs274µs
# spent 40µs (6+34) within String::ShellQuote::BEGIN@29 which was called: # once (6µs+34µs) by Net::SCP::BEGIN@8 at line 29
use vars qw($VERSION @ISA @EXPORT);
# spent 40µs making 1 call to String::ShellQuote::BEGIN@29 # spent 34µs making 1 call to vars::import
30
311400nsrequire Exporter;
32
331400ns$VERSION = '1.04';
3416µs@ISA = qw(Exporter);
3511µs@EXPORT = qw(shell_quote shell_quote_best_effort shell_comment_quote);
36
37sub croak {
38 require Carp;
39 goto &Carp::croak;
40}
41
42sub _shell_quote_backend {
43 my @in = @_;
44 my @err = ();
45
46 if (0) {
47 require RS::Handy;
48 print RS::Handy::data_dump(\@in);
49 }
50
51 return \@err, '' unless @in;
52
53 my $ret = '';
54 my $saw_non_equal = 0;
55 foreach (@in) {
56 if (!defined $_ or $_ eq '') {
57 $_ = "''";
58 next;
59 }
60
61 if (s/\x00//g) {
62 push @err, "No way to quote string containing null (\\000) bytes";
63 }
64
65 my $escape = 0;
66
67 # = needs quoting when it's the first element (or part of a
68 # series of such elements), as in command position it's a
69 # program-local environment setting
70
71 if (/=/) {
72 if (!$saw_non_equal) {
73 $escape = 1;
74 }
75 }
76 else {
77 $saw_non_equal = 1;
78 }
79
80 if (m|[^\w!%+,\-./:=@^]|) {
81 $escape = 1;
82 }
83
84 if ($escape
85 || (!$saw_non_equal && /=/)) {
86
87 # ' -> '\''
88 s/'/'\\''/g;
89
90 # make multiple ' in a row look simpler
91 # '\'''\'''\'' -> '"'''"'
92 s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;
93
94 $_ = "'$_'";
95 s/^''//;
96 s/''$//;
97 }
98 }
99 continue {
100 $ret .= "$_ ";
101 }
102
103 chop $ret;
104 return \@err, $ret;
105}
106
107=item B<shell_quote> [I<string>]...
108
109B<shell_quote> quotes strings so they can be passed through the shell.
110Each I<string> is quoted so that the shell will pass it along as a
111single argument and without further interpretation. If no I<string>s
112are given an empty string is returned.
113
114If any I<string> can't be safely quoted B<shell_quote> will B<croak>.
115
116=cut
117
118sub shell_quote {
119 my ($rerr, $s) = _shell_quote_backend @_;
120
121 if (@$rerr) {
122 my %seen;
123 @$rerr = grep { !$seen{$_}++ } @$rerr;
124 my $s = join '', map { "shell_quote(): $_\n" } @$rerr;
125 chomp $s;
126 croak $s;
127 }
128 return $s;
129}
130
131=item B<shell_quote_best_effort> [I<string>]...
132
133This is like B<shell_quote>, excpet if the string can't be safely quoted
134it does the best it can and returns the result, instead of dying.
135
136=cut
137
138sub shell_quote_best_effort {
139 my ($rerr, $s) = _shell_quote_backend @_;
140
141 return $s;
142}
143
144=item B<shell_comment_quote> [I<string>]
145
146B<shell_comment_quote> quotes the I<string> so that it can safely be
147included in a shell-style comment (the current algorithm is that a sharp
148character is placed after any newlines in the string).
149
150This routine might be changed to accept multiple I<string> arguments
151in the future. I haven't done this yet because I'm not sure if the
152I<string>s should be joined with blanks ($") or nothing ($,). Cast
153your vote today! Be sure to justify your answer.
154
155=cut
156
157sub shell_comment_quote {
158 return '' unless @_;
159 unless (@_ == 1) {
160 croak "Too many arguments to shell_comment_quote "
161 . "(got " . @_ . " expected 1)";
162 }
163 local $_ = shift;
164 s/\n/\n#/g;
165 return $_;
166}
167
16814µs1;
169
170__END__