Mercurial > laserkard

annotate echo.pl @ 37:021a9ab1ed5b laserkard

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[svn r38] added echo.pl, a test program for the backend of the website
author rlm
date Sun, 24 Jan 2010 09:37:47 -0500
parents
children 07c19a58ba5a
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@37 15
rlm@37 16
rlm@37 17 my $q = new CGI;
rlm@37 18
rlm@37 19
rlm@37 20
rlm@37 21 my %hash =
rlm@37 22 (
rlm@37 23 'echo' => \&echo
rlm@37 24 );
rlm@37 25
rlm@37 26
rlm@37 27
rlm@37 28 my $pjx = CGI::Ajax->new(%hash);
rlm@37 29
rlm@37 30 # this outputs the html for the page, and stops caching, so the fucker will work in IE.
rlm@37 31 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
rlm@37 32
rlm@37 33
rlm@37 34
rlm@37 35
rlm@37 36 sub gen
rlm@37 37 {
rlm@37 38 {
rlm@37 39 local( $/, *FH ) ;
rlm@37 40 open( FH, "<./echo.html" ) or die "sudden flaming death\n";
rlm@37 41 $a = <FH>;
rlm@37 42 }
rlm@37 43
rlm@37 44 {
rlm@37 45 local( $/, *FH ) ;
rlm@37 46 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
rlm@37 47 $b = <FH>;
rlm@37 48 }
rlm@37 49
rlm@37 50
rlm@37 51
rlm@37 52 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
rlm@37 53
rlm@37 54
rlm@37 55
rlm@37 56 return $a
rlm@37 57
rlm@37 58
rlm@37 59 }
rlm@37 60
rlm@37 61
rlm@37 62
rlm@37 63 sub echo
rlm@37 64 {
rlm@37 65
rlm@37 66
rlm@37 67 my $svg = $_[0];
rlm@37 68
rlm@37 69 my $destination = 'rlm@mit.edu';
rlm@37 70
rlm@37 71
rlm@37 72 $svg = &repair_file($svg);
rlm@37 73 &mail($svg, $destination);
rlm@37 74
rlm@37 75
rlm@37 76
rlm@37 77
rlm@37 78 return "done.";
rlm@37 79
rlm@37 80 }
rlm@37 81
rlm@37 82
rlm@37 83 sub repair_file
rlm@37 84 {
rlm@37 85 my $svg = $_[0];
rlm@37 86
rlm@37 87 $xml = new XML::Simple;
rlm@37 88
rlm@37 89
rlm@37 90 $sss = <<HERE;
rlm@37 91
rlm@37 92 <svg height="318" width="515" version="1.1" xmlns="http://www.w3.org/2000/svg">
rlm@37 93 <desc>Created with Raphaël</desc>
rlm@37 94 <defs></defs>
rlm@37 95 <rect stroke="#0000ff" fill="none" ry="0" rx="0" r="0" height="317" width="514" y="0.5" x="0.5"></rect>
rlm@37 96 <path transform="" d="M30.9375,118.95833333333334L42.8125,118.95833333333334L38.2295,141.45833333333334L62.6045,118.95833333333334L78.2295,118.95833333333334L52.3955,141.04133333333334L68.8545,172.50033333333334L55.5205,172.50033333333334L43.4375,148.33333333333334L35.1045,155.62533333333334L31.5625,172.50033333333334L19.8955,172.50033333333334Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 97 <path transform="" d="M104.06249999999994,148.95833333333334C105.31249999999994,138.54133333333334,90.72949999999994,138.75033333333334,87.60449999999994,145.83333333333334C86.97949999999994,146.87533333333334,86.56249999999994,147.91633333333334,86.14549999999994,148.95833333333334L104.06249999999994,148.95833333333334ZM96.14549999999994,132.70833333333334C109.68749999999994,132.29133333333334,116.56249999999994,141.87533333333334,113.64549999999994,155.62533333333334L85.10449999999994,155.62533333333334C84.47949999999994,162.08333333333334,87.60449999999994,165.62533333333334,93.64549999999994,165.62533333333334C97.81249999999994,165.41633333333334,99.68749999999994,162.70833333333334,101.56249999999994,160.20833333333334L112.18749999999994,160.20833333333334C109.06249999999994,168.54133333333334,103.43749999999994,173.75033333333334,91.97949999999994,173.54133333333334C80.93749999999994,173.54133333333334,74.89549999999994,168.00033333333334,74.89549999999994,156.66633333333334C74.89549999999994,142.91633333333334,82.18749999999994,133.12533333333334,96.14549999999994,132.70833333333334Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 98 <path transform="" d="M136.56249999999994,173.5L124.27049999999994,173.5L119.27049999999994,133.75L130.10449999999994,133.75L132.81249999999994,161.25L146.35449999999994,133.75L157.60449999999994,133.75Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 99 <path transform="" d="M175.10416666666674,127.70833333333334L164.27116666666674,127.70833333333334L166.14616666666674,118.95833333333334L176.97916666666674,118.95833333333334ZM163.02116666666674,133.75033333333334L173.85416666666674,133.75033333333334L165.52116666666674,172.50033333333334L154.89616666666674,172.50033333333334Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 100 <path transform="" d="M204.47916666666652,149.79166666666669C208.22916666666652,141.04166666666669,196.97916666666652,138.3336666666667,192.60416666666652,144.37466666666668C187.39616666666652,151.24966666666668,187.60416666666652,163.12466666666668,184.89616666666652,172.49966666666668L174.27116666666652,172.49966666666668L182.39616666666652,133.74966666666668L192.60416666666652,133.74966666666668L191.35416666666652,139.16666666666669C198.02116666666652,128.54166666666669,219.0621666666665,131.04166666666669,215.9371666666665,146.4586666666667L210.52116666666652,172.49966666666668L199.6871666666665,172.49966666666668Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 101 <path transform="" d="M282.1875000000002,134.79166666666663C282.6045000000002,125.41666666666663,270.7295000000002,128.74966666666663,262.3955000000002,128.12466666666663L259.2705000000002,143.12466666666663C269.4795000000002,142.91666666666663,281.7705000000002,144.99966666666663,282.1875000000002,134.79166666666663ZM276.14550000000025,172.49966666666663C274.47950000000026,163.33366666666663,280.3125000000002,150.83366666666663,268.64550000000025,151.66666666666663L257.39550000000025,151.66666666666663L253.02050000000025,172.49966666666663L241.35450000000026,172.49966666666663L252.60450000000026,118.95866666666663C270.10450000000026,119.99966666666663,294.89550000000025,113.54166666666663,294.0625000000002,132.91666666666663C293.64550000000025,141.45866666666663,288.64550000000025,145.62466666666663,281.77050000000025,147.49966666666663C290.52050000000025,149.99966666666663,285.72950000000026,163.33366666666663,287.60450000000026,172.49966666666663L276.14550000000025,172.49966666666663Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 102 <path transform="" d="M309.27083333333303,156.45833333333334C305.937833333333,162.50033333333334,312.187833333333,167.50033333333334,317.812833333333,164.16633333333334C326.77083333333303,159.16633333333334,325.52083333333303,144.16633333333334,328.853833333333,133.75033333333334L339.478833333333,133.75033333333334L331.353833333333,173.00033333333334L321.145833333333,173.00033333333334C321.353833333333,170.83333333333334,322.395833333333,168.54133333333334,322.18783333333295,167.08333333333334C315.72883333333294,178.00033333333334,294.47883333333294,175.62533333333334,297.81283333333295,159.58333333333334L303.22883333333294,133.75033333333334L313.85383333333294,133.75033333333334Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 103 <path transform="" d="M349.2708333333335,153.54166666666669C337.81283333333346,146.04166666666669,348.6458333333335,130.41666666666669,361.56283333333346,132.7086666666667C370.93783333333346,132.49966666666668,377.3958333333335,135.62466666666668,377.3958333333335,144.99966666666668L367.6038333333335,144.99966666666668C367.6038333333335,141.4586666666667,365.3128333333335,140.2086666666667,361.5628333333335,139.79166666666669C357.1878333333335,139.37466666666668,353.02083333333354,142.49966666666668,356.14583333333354,145.8336666666667C363.02083333333354,149.79166666666669,375.52083333333354,149.37466666666668,375.52083333333354,160.41666666666669C375.52083333333354,177.49966666666668,340.9378333333335,178.54166666666669,340.52083333333354,161.4586666666667L340.52083333333354,159.99966666666668L350.3128333333335,159.99966666666668C350.1038333333335,164.79166666666669,353.8538333333335,165.8336666666667,358.02083333333354,166.4586666666667C364.47883333333357,167.49966666666668,367.39583333333354,159.5836666666667,360.9378333333335,157.49966666666668Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 104 <path transform="" d="M400.52083333333326,172.70833333333331C391.3538333333333,174.58333333333331,381.9788333333332,173.00033333333332,384.27083333333326,161.6663333333333L388.64583333333326,140.83333333333331L381.56283333333323,140.83333333333331L383.2288333333332,133.75033333333332L390.1038333333332,133.75033333333332L392.3958333333332,121.87533333333332L403.2288333333332,121.87533333333332L400.7288333333332,133.75033333333332L408.43783333333323,133.75033333333332L406.77083333333326,140.83333333333331L399.27083333333326,140.83333333333331L394.89583333333326,161.87533333333332C394.68783333333323,165.4163333333333,399.06283333333323,165.00033333333332,402.39583333333326,164.58333333333331Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 105 <path transform="" d="M436.7708333333337,144.58333333333334C436.7708333333337,137.08333333333334,422.3958333333337,138.95833333333334,421.97883333333374,145.41633333333334L412.18783333333374,145.41633333333334C413.43783333333374,136.25033333333334,420.31283333333374,132.91633333333334,430.5208333333337,132.70833333333334C441.35383333333374,132.50033333333334,448.6458333333337,137.29133333333334,445.72883333333374,149.37533333333334C443.85383333333374,156.87533333333334,441.56283333333374,164.79133333333334,442.18783333333374,172.50033333333334L431.56283333333374,172.50033333333334L431.56283333333374,168.75033333333334C425.72883333333374,176.04133333333334,406.97883333333374,175.20833333333334,406.97883333333374,163.33333333333334C406.97883333333374,150.62533333333334,421.56283333333374,150.20833333333334,433.0208333333337,148.75033333333334C435.3128333333337,147.91633333333334,436.7708333333337,147.29133333333334,436.7708333333337,144.58333333333334ZM434.6878333333337,153.95833333333334C429.4788333333337,157.50033333333334,417.6038333333337,153.33333333333334,417.8128333333337,162.08333333333334C417.8128333333337,168.12533333333334,428.2288333333337,167.08333333333334,430.5208333333337,163.54133333333334C433.0208333333337,161.25033333333334,433.6458333333337,158.00033333333334,434.6878333333337,153.95833333333334Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 106 <path transform="" d="M471.3541666666665,132.70833333333331C477.6041666666665,132.50033333333332,481.1461666666665,135.4163333333333,483.43716666666654,139.58333333333331L484.4791666666665,133.75033333333332L494.68716666666654,133.75033333333332C491.14616666666655,148.33333333333331,489.4791666666665,164.7913333333333,484.4791666666665,178.12533333333332C479.8961666666665,190.4163333333333,448.8541666666665,191.25033333333332,449.0621666666665,174.58333333333331L459.6871666666665,174.58333333333331C459.6871666666665,181.6663333333333,471.35416666666646,181.0413333333333,473.85416666666646,176.25033333333332C475.10416666666646,173.5413333333333,477.1871666666665,169.7913333333333,477.39616666666643,166.45833333333331C469.47916666666646,177.2913333333333,450.52116666666643,170.83333333333331,451.77116666666643,156.0413333333333C452.8121666666664,143.12533333333332,458.4371666666664,133.5413333333333,471.3541666666664,132.70833333333331ZM480.93716666666654,149.1663333333333C480.93716666666654,144.1663333333333,478.2291666666665,140.62533333333332,473.2291666666665,140.62533333333332C462.3961666666665,140.62533333333332,457.1871666666665,163.95833333333331,469.68716666666654,163.95833333333331C477.39616666666655,163.95833333333331,480.52116666666655,157.08333333333331,480.93716666666654,149.1663333333333Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 107 <path transform="" d="M515.5208333333335,127.70833333333334L504.68783333333346,127.70833333333334L506.56283333333346,118.95833333333334L517.3958333333335,118.95833333333334ZM503.43783333333346,133.75033333333334L514.2708333333335,133.75033333333334L505.93783333333346,172.50033333333334L495.31283333333346,172.50033333333334Z" stroke="#ff0000" fill="#ff0000"></path>
rlm@37 108 </svg>
rlm@37 109
rlm@37 110
rlm@37 111
rlm@37 112
rlm@37 113 HERE
rlm@37 114
rlm@37 115
rlm@37 116 # read XML file
rlm@37 117 $data = $xml->XMLin($sss, ForceArray => 1);
rlm@37 118
rlm@37 119
rlm@37 120 my %data = %$data;
rlm@37 121
rlm@37 122 my %juzz =
rlm@37 123 (
rlm@37 124
rlm@37 125 path => $data{'path'},
rlm@37 126 rect => $data{'rect'},
rlm@37 127 width =>"16in" ,
rlm@37 128 height =>"12in" ,
rlm@37 129 version =>"1.1",
rlm@37 130 xmlns =>"http://www.w3.org/2000/svg"
rlm@37 131
rlm@37 132 );
rlm@37 133
rlm@37 134
rlm@37 135 $out = $xml->XMLout(\%juzz , RootName=>'svg');
rlm@37 136
rlm@37 137
rlm@37 138 my $fixed = <<HERE;
rlm@37 139 <?xml version="1.0" standalone="no"?>
rlm@37 140 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
rlm@37 141 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
rlm@37 142 HERE
rlm@37 143
rlm@37 144
rlm@37 145
rlm@37 146 $fixed .= $out;
rlm@37 147
rlm@37 148 #print $fixed;
rlm@37 149
rlm@37 150 return $fixed;
rlm@37 151
rlm@37 152
rlm@37 153 }
rlm@37 154
rlm@37 155
rlm@37 156
rlm@37 157 sub mail
rlm@37 158 {
rlm@37 159
rlm@37 160
rlm@37 161
rlm@37 162 %mail =
rlm@37 163 (
rlm@37 164 from => 'rlm@mit.edu',
rlm@37 165 to => $_[1],
rlm@37 166 subject => 'Test attachment',
rlm@37 167 );
rlm@37 168
rlm@37 169
rlm@37 170 $boundary = "====" . time() . "====";
rlm@37 171 $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
rlm@37 172
rlm@37 173 $message = encode_qp( "email from your friend PERL." );
rlm@37 174
rlm@37 175 $attach1 = encode_base64($_[0]); # this part is so cool! I can e-mail a perl varible to anyone in the world!
rlm@37 176
rlm@37 177 $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");
rlm@37 178
rlm@37 179
rlm@37 180
rlm@37 181
rlm@37 182
rlm@37 183 $boundary = '--'.$boundary;
rlm@37 184 $mail{body} = <<END_OF_BODY;
rlm@37 185 $boundary
rlm@37 186 Content-Type: text/plain; charset="iso-8859-1"
rlm@37 187 Content-Transfer-Encoding: quoted-printable
rlm@37 188
rlm@37 189 $message
rlm@37 190 $boundary
rlm@37 191 Content-Type: application/octet-stream; name="test.svg"
rlm@37 192 Content-Transfer-Encoding: base64
rlm@37 193 Content-Disposition: attachment; filename="test.svg"
rlm@37 194
rlm@37 195 $attach1
rlm@37 196
rlm@37 197 $boundary
rlm@37 198 Content-Type: application/octet-stream; name="huh.txt"
rlm@37 199 Content-Transfer-Encoding: base64
rlm@37 200 Content-Disposition: attachment; filename="huh.txt"
rlm@37 201
rlm@37 202 $attach2
rlm@37 203 $boundary--
rlm@37 204
rlm@37 205 END_OF_BODY
rlm@37 206
rlm@37 207 sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";
rlm@37 208
rlm@37 209
rlm@37 210 }
rlm@37 211
rlm@37 212
rlm@37 213
rlm@37 214
rlm@37 215
rlm@37 216
rlm@37 217
rlm@37 218
rlm@37 219
rlm@37 220
rlm@37 221
rlm@37 222
rlm@37 223
rlm@37 224