Mercurial > laserkard

annotate echo.pl @ 38:07c19a58ba5a laserkard

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[svn r39] creating compatability with corel draw.
author rlm
date Sun, 24 Jan 2010 10:42:16 -0500
parents 021a9ab1ed5b
children 1ac1409ea68c
rev   line source
rlm@37 1 #!/usr/bin/perl
rlm@37 2
rlm@37 3
rlm@37 4 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
rlm@37 5 use Storable;
rlm@37 6 use CGI::Ajax;
rlm@37 7 use CGI qw(:standard);
rlm@37 8 use URI::Escape;
rlm@37 9 use MIME::QuotedPrint;
rlm@37 10 use MIME::Base64;
rlm@37 11 use Mail::Sendmail 0.75; # doesn't work with v. 0.74!
rlm@37 12 use XML::Simple;
rlm@37 13 use Data::Dumper;
rlm@37 14 $Data::Dumper::Indent = 1;
rlm@38 15 use Storable;
rlm@37 16
rlm@37 17
rlm@37 18 my $q = new CGI;
rlm@37 19
rlm@37 20
rlm@37 21
rlm@37 22 my %hash =
rlm@37 23 (
rlm@37 24 'echo' => \&echo
rlm@37 25 );
rlm@37 26
rlm@37 27
rlm@37 28
rlm@37 29 my $pjx = CGI::Ajax->new(%hash);
rlm@37 30
rlm@37 31 # this outputs the html for the page, and stops caching, so the fucker will work in IE.
rlm@37 32 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
rlm@37 33
rlm@37 34
rlm@37 35
rlm@37 36
rlm@37 37 sub gen
rlm@37 38 {
rlm@37 39 {
rlm@37 40 local( $/, *FH ) ;
rlm@37 41 open( FH, "<./echo.html" ) or die "sudden flaming death\n";
rlm@37 42 $a = <FH>;
rlm@37 43 }
rlm@37 44
rlm@37 45 {
rlm@37 46 local( $/, *FH ) ;
rlm@37 47 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
rlm@37 48 $b = <FH>;
rlm@37 49 }
rlm@37 50
rlm@37 51
rlm@37 52
rlm@37 53 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
rlm@37 54
rlm@37 55
rlm@37 56
rlm@37 57 return $a
rlm@37 58
rlm@37 59
rlm@37 60 }
rlm@37 61
rlm@37 62
rlm@37 63
rlm@37 64 sub echo
rlm@37 65 {
rlm@37 66
rlm@37 67
rlm@37 68 my $svg = $_[0];
rlm@37 69
rlm@37 70 my $destination = 'rlm@mit.edu';
rlm@38 71 #~ $svg =~ s/</\&lt\;/g;
rlm@38 72 #~ return $svg;
rlm@38 73
rlm@38 74
rlm@38 75 $svg = &repair_file($svg);
rlm@38 76
rlm@38 77
rlm@37 78
rlm@37 79
rlm@37 80 &mail($svg, $destination);
rlm@37 81
rlm@37 82
rlm@37 83
rlm@37 84
rlm@37 85 return "done.";
rlm@37 86
rlm@37 87 }
rlm@37 88
rlm@37 89
rlm@37 90 sub repair_file
rlm@37 91 {
rlm@37 92
rlm@37 93
rlm@38 94 $sss = $_[0];
rlm@37 95
rlm@37 96
rlm@37 97
rlm@38 98 $sss =~ s/^/\n\n\n/;
rlm@38 99 $sss =~ s/$/\n\n\n/;
rlm@38 100 # you fucking bitch.
rlm@38 101 $sss =~ s/Created wit........//;
rlm@37 102
rlm@37 103
rlm@38 104 store \$sss, 'file';
rlm@37 105
rlm@37 106 # read XML file
rlm@38 107 $xml = new XML::Simple;
rlm@37 108 $data = $xml->XMLin($sss, ForceArray => 1);
rlm@37 109
rlm@37 110
rlm@37 111 my %data = %$data;
rlm@37 112
rlm@37 113 my %juzz =
rlm@37 114 (
rlm@37 115
rlm@37 116 path => $data{'path'},
rlm@37 117 rect => $data{'rect'},
rlm@37 118 width =>"16in" ,
rlm@37 119 height =>"12in" ,
rlm@37 120 version =>"1.1",
rlm@37 121 xmlns =>"http://www.w3.org/2000/svg"
rlm@37 122
rlm@37 123 );
rlm@37 124
rlm@37 125
rlm@37 126 $out = $xml->XMLout(\%juzz , RootName=>'svg');
rlm@37 127
rlm@37 128
rlm@37 129 my $fixed = <<HERE;
rlm@37 130 <?xml version="1.0" standalone="no"?>
rlm@37 131 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
rlm@37 132 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
rlm@37 133 HERE
rlm@37 134
rlm@37 135
rlm@37 136
rlm@37 137 $fixed .= $out;
rlm@37 138
rlm@37 139 #print $fixed;
rlm@38 140 return $fixed;
rlm@37 141
rlm@37 142 }
rlm@37 143
rlm@37 144
rlm@37 145
rlm@37 146 sub mail
rlm@37 147 {
rlm@37 148
rlm@37 149
rlm@37 150
rlm@37 151 %mail =
rlm@37 152 (
rlm@37 153 from => 'rlm@mit.edu',
rlm@37 154 to => $_[1],
rlm@37 155 subject => 'Test attachment',
rlm@37 156 );
rlm@37 157
rlm@37 158
rlm@37 159 $boundary = "====" . time() . "====";
rlm@37 160 $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
rlm@37 161
rlm@37 162 $message = encode_qp( "email from your friend PERL." );
rlm@37 163
rlm@37 164 $attach1 = encode_base64($_[0]); # this part is so cool! I can e-mail a perl varible to anyone in the world!
rlm@37 165
rlm@37 166 $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");
rlm@37 167
rlm@37 168
rlm@37 169
rlm@37 170
rlm@37 171
rlm@37 172 $boundary = '--'.$boundary;
rlm@37 173 $mail{body} = <<END_OF_BODY;
rlm@37 174 $boundary
rlm@37 175 Content-Type: text/plain; charset="iso-8859-1"
rlm@37 176 Content-Transfer-Encoding: quoted-printable
rlm@37 177
rlm@37 178 $message
rlm@37 179 $boundary
rlm@37 180 Content-Type: application/octet-stream; name="test.svg"
rlm@37 181 Content-Transfer-Encoding: base64
rlm@37 182 Content-Disposition: attachment; filename="test.svg"
rlm@37 183
rlm@37 184 $attach1
rlm@37 185
rlm@37 186 $boundary
rlm@37 187 Content-Type: application/octet-stream; name="huh.txt"
rlm@37 188 Content-Transfer-Encoding: base64
rlm@37 189 Content-Disposition: attachment; filename="huh.txt"
rlm@37 190
rlm@37 191 $attach2
rlm@37 192 $boundary--
rlm@37 193
rlm@37 194 END_OF_BODY
rlm@37 195
rlm@37 196 sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";
rlm@37 197
rlm@37 198
rlm@37 199 }
rlm@37 200
rlm@37 201
rlm@37 202
rlm@37 203
rlm@37 204
rlm@37 205
rlm@37 206
rlm@37 207
rlm@37 208
rlm@37 209
rlm@37 210
rlm@37 211
rlm@37 212
rlm@37 213