"Fossies" - the Fresh Open Source Software Archive 
Member "xterm-379/vttests/paste64.pl" (20 Nov 2018, 4848 Bytes) of package /linux/misc/xterm-379.tgz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "paste64.pl" see the
Fossies "Dox" file reference documentation.
1 #!/usr/bin/env perl
2 # $XTermId: paste64.pl,v 1.14 2018/11/20 01:05:55 tom Exp $
3 # -----------------------------------------------------------------------------
4 # this file is part of xterm
5 #
6 # Copyright 2006-2014,2018 by Thomas E. Dickey
7 #
8 # All Rights Reserved
9 #
10 # Permission is hereby granted, free of charge, to any person obtaining a
11 # copy of this software and associated documentation files (the
12 # "Software"), to deal in the Software without restriction, including
13 # without limitation the rights to use, copy, modify, merge, publish,
14 # distribute, sublicense, and/or sell copies of the Software, and to
15 # permit persons to whom the Software is furnished to do so, subject to
16 # the following conditions:
17 #
18 # The above copyright notice and this permission notice shall be included
19 # in all copies or substantial portions of the Software.
20 #
21 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
22 # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
23 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
24 # IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
25 # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
26 # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
27 # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
28 #
29 # Except as contained in this notice, the name(s) of the above copyright
30 # holders shall not be used in advertising or otherwise to promote the
31 # sale, use or other dealings in this Software without prior written
32 # authorization.
33 # -----------------------------------------------------------------------------
34 # Test the paste64 option of xterm.
35
36 use strict;
37 use warnings;
38
39 use Term::ReadKey;
40 use IO::Handle;
41 use MIME::Base64;
42
43 our $target = "";
44
45 sub to_hex($) {
46 my $value = $_[0];
47 my $result = "";
48 my $n;
49
50 for ( $n = 0 ; $n < length($value) ; ++$n ) {
51 $result .= sprintf( "%02X", ord substr( $value, $n, 1 ) );
52 }
53 return $result;
54 }
55
56 sub show_string($) {
57 my $value = $_[0];
58 my $n;
59
60 my $result = "";
61 for ( $n = 0 ; $n < length($value) ; $n += 1 ) {
62 my $c = ord substr( $value, $n, 1 );
63 if ( $c == ord '\\' ) {
64 $result .= "\\\\";
65 }
66 elsif ( $c == 0x1b ) {
67 $result .= "\\E";
68 }
69 elsif ( $c == 0x7f ) {
70 $result .= "^?";
71 }
72 elsif ( $c == 32 ) {
73 $result .= "\\s";
74 }
75 elsif ( $c < 32 ) {
76 $result .= sprintf( "^%c", $c + 64 );
77 }
78 elsif ( $c > 128 ) {
79 $result .= sprintf( "\\%03o", $c );
80 }
81 else {
82 $result .= chr($c);
83 }
84 }
85
86 printf "%s\r\n", $result;
87 }
88
89 sub get_reply($) {
90 my $command = $_[0];
91 my $reply = "";
92
93 printf "send: ";
94 show_string($command);
95
96 print STDOUT $command;
97 autoflush STDOUT 1;
98 while (1) {
99 my $test = ReadKey 1;
100 last if not defined $test;
101
102 #printf "%d:%s\r\n", length($reply), to_hex($test);
103 $reply .= $test;
104 }
105 return $reply;
106 }
107
108 sub get_paste() {
109 my $reply = get_reply( "\x1b]52;" . $target . ";?\x1b\\" );
110
111 printf "read: ";
112 show_string($reply);
113
114 my $data = $reply;
115 $data =~ s/^\x1b]52;[[:alnum:]]*;//;
116 $data =~ s/\x1b\\$//;
117 printf "chop: ";
118 show_string($data);
119
120 $data = decode_base64($data);
121 printf "data: ";
122 show_string($data);
123 }
124
125 sub put_paste() {
126 ReadMode 1;
127
128 printf "data: ";
129 my $data = ReadLine 0;
130 chomp $data;
131 ReadMode 5;
132
133 $data = encode_base64($data);
134 chomp $data;
135 printf "data: ";
136 show_string($data);
137
138 my $send = "\x1b]52;" . $target . ";" . $data . "\x1b\\";
139
140 printf "send: ";
141 show_string($send);
142 print STDOUT $send;
143 autoflush STDOUT 1;
144 }
145
146 sub set_target() {
147 ReadMode 1;
148
149 printf "target: ";
150 $target = ReadLine 0;
151 $target =~ s/[^cps01234567]//g;
152 ReadMode 5;
153 printf "result: %s\r\n", $target;
154 }
155
156 ReadMode 5, 'STDIN'; # allow single-character inputs
157 while (1) {
158 my $cmd;
159
160 printf "\r\nCommand (? for help):";
161 $cmd = ReadKey 0;
162 if ( $cmd eq "?" ) {
163 printf "\r\np=put selection,"
164 . " g=get selection,"
165 . " q=quit,"
166 . " r=reset target,"
167 . " s=set target\r\n";
168 }
169 elsif ( $cmd eq "p" ) {
170 printf " ...put selection\r\n";
171 put_paste();
172 }
173 elsif ( $cmd eq "g" ) {
174 printf " ...get selection\r\n";
175 get_paste();
176 }
177 elsif ( $cmd eq "q" ) {
178 printf " ...quit\r\n";
179 last;
180 }
181 elsif ( $cmd eq "r" ) {
182 printf " ...reset\r\n";
183 $target = "";
184 }
185 elsif ( $cmd eq "s" ) {
186 printf " ...set target\r\n";
187 set_target();
188 }
189 }
190 ReadMode 0, 'STDIN'; # Reset tty mode before exiting