Profile of String/ShellQuote.pm

← 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:22:36 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/String/ShellQuote.pm
Statements | Executed 11 statements in 471µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 10µs | 12µs | String::ShellQuote::::BEGIN@28String::ShellQuote::BEGIN@28
1 | 1 | 1 | 6µs | 40µs | String::ShellQuote::::BEGIN@29String::ShellQuote::BEGIN@29
0 | 0 | 0 | 0s | 0s | String::ShellQuote::::_shell_quote_backendString::ShellQuote::_shell_quote_backend
0 | 0 | 0 | 0s | 0s | String::ShellQuote::::croakString::ShellQuote::croak
0 | 0 | 0 | 0s | 0s | String::ShellQuote::::shell_comment_quoteString::ShellQuote::shell_comment_quote
0 | 0 | 0 | 0s | 0s | String::ShellQuote::::shell_quoteString::ShellQuote::shell_quote
0 | 0 | 0 | 0s | 0s | String::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 |  |  |  |  |
9 |  |  |  |  | String::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 |  |  |  |  |
19 |  |  |  |  | This module contains some functions which are useful for quoting strings
20 |  |  |  |  | which are going to pass through the shell or a shell-like object.
21 |  |  |  |  |
22 |  |  |  |  | =over
23 |  |  |  |  |
24 |  |  |  |  | =cut
25 |  |  |  |  |
26 |  |  |  |  | package String::ShellQuote;
27 |  |  |  |  |
28 | 3 | 19µs | 2 | 14µ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
29 | 3 | 440µs | 2 | 74µ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 |  |  |  |  |
31 | 1 | 400ns |  |  | require Exporter;
32 |  |  |  |  |
33 | 1 | 400ns |  |  | $VERSION = '1.04';
34 | 1 | 6µs |  |  | @ISA = qw(Exporter);
35 | 1 | 1µs |  |  | @EXPORT = qw(shell_quote shell_quote_best_effort shell_comment_quote);
36 |  |  |  |  |
37 |  |  |  |  | sub croak {
38 |  |  |  |  | require Carp;
39 |  |  |  |  | goto &Carp::croak;
40 |  |  |  |  | }
41 |  |  |  |  |
42 |  |  |  |  | sub _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 |  |  |  |  |
109 |  |  |  |  | B<shell_quote> quotes strings so they can be passed through the shell.
110 |  |  |  |  | Each I<string> is quoted so that the shell will pass it along as a
111 |  |  |  |  | single argument and without further interpretation. If no I<string>s
112 |  |  |  |  | are given an empty string is returned.
113 |  |  |  |  |
114 |  |  |  |  | If any I<string> can't be safely quoted B<shell_quote> will B<croak>.
115 |  |  |  |  |
116 |  |  |  |  | =cut
117 |  |  |  |  |
118 |  |  |  |  | sub 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 |  |  |  |  |
133 |  |  |  |  | This is like B<shell_quote>, excpet if the string can't be safely quoted
134 |  |  |  |  | it does the best it can and returns the result, instead of dying.
135 |  |  |  |  |
136 |  |  |  |  | =cut
137 |  |  |  |  |
138 |  |  |  |  | sub 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 |  |  |  |  |
146 |  |  |  |  | B<shell_comment_quote> quotes the I<string> so that it can safely be
147 |  |  |  |  | included in a shell-style comment (the current algorithm is that a sharp
148 |  |  |  |  | character is placed after any newlines in the string).
149 |  |  |  |  |
150 |  |  |  |  | This routine might be changed to accept multiple I<string> arguments
151 |  |  |  |  | in the future. I haven't done this yet because I'm not sure if the
152 |  |  |  |  | I<string>s should be joined with blanks ($") or nothing ($,). Cast
153 |  |  |  |  | your vote today! Be sure to justify your answer.
154 |  |  |  |  |
155 |  |  |  |  | =cut
156 |  |  |  |  |
157 |  |  |  |  | sub 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 |  |  |  |  |
168 | 1 | 4µs |  |  | 1;
169 |  |  |  |  |
170 |  |  |  |  | __END__