Mercurial > laserkard
view echo.pl @ 38:07c19a58ba5a laserkard
[svn r39] creating compatability with corel draw.
author | rlm |
---|---|
date | Sun, 24 Jan 2010 10:42:16 -0500 |
parents | 021a9ab1ed5b |
children | 1ac1409ea68c |
line wrap: on
line source
1 #!/usr/bin/perl4 use List::Util qw(first max maxstr min minstr reduce shuffle sum);5 use Storable;6 use CGI::Ajax;7 use CGI qw(:standard);8 use URI::Escape;9 use MIME::QuotedPrint;10 use MIME::Base64;11 use Mail::Sendmail 0.75; # doesn't work with v. 0.74!12 use XML::Simple;13 use Data::Dumper;14 $Data::Dumper::Indent = 1;15 use Storable;18 my $q = new CGI;22 my %hash =23 (24 'echo' => \&echo25 );29 my $pjx = CGI::Ajax->new(%hash);31 # this outputs the html for the page, and stops caching, so the fucker will work in IE.32 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});37 sub gen38 {39 {40 local( $/, *FH ) ;41 open( FH, "<./echo.html" ) or die "sudden flaming death\n";42 $a = <FH>;43 }45 {46 local( $/, *FH ) ;47 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";48 $b = <FH>;49 }53 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)57 return $a60 }64 sub echo65 {68 my $svg = $_[0];70 my $destination = 'rlm@mit.edu';71 #~ $svg =~ s/</\<\;/g;72 #~ return $svg;75 $svg = &repair_file($svg);80 &mail($svg, $destination);85 return "done.";87 }90 sub repair_file91 {94 $sss = $_[0];98 $sss =~ s/^/\n\n\n/;99 $sss =~ s/$/\n\n\n/;100 # you fucking bitch.101 $sss =~ s/Created wit........//;104 store \$sss, 'file';106 # read XML file107 $xml = new XML::Simple;108 $data = $xml->XMLin($sss, ForceArray => 1);111 my %data = %$data;113 my %juzz =114 (116 path => $data{'path'},117 rect => $data{'rect'},118 width =>"16in" ,119 height =>"12in" ,120 version =>"1.1",121 xmlns =>"http://www.w3.org/2000/svg"123 );126 $out = $xml->XMLout(\%juzz , RootName=>'svg');129 my $fixed = <<HERE;130 <?xml version="1.0" standalone="no"?>131 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"132 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">133 HERE137 $fixed .= $out;139 #print $fixed;140 return $fixed;142 }146 sub mail147 {151 %mail =152 (153 from => 'rlm@mit.edu',154 to => $_[1],155 subject => 'Test attachment',156 );159 $boundary = "====" . time() . "====";160 $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";162 $message = encode_qp( "email from your friend PERL." );164 $attach1 = encode_base64($_[0]); # this part is so cool! I can e-mail a perl varible to anyone in the world!166 $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");172 $boundary = '--'.$boundary;173 $mail{body} = <<END_OF_BODY;174 $boundary175 Content-Type: text/plain; charset="iso-8859-1"176 Content-Transfer-Encoding: quoted-printable178 $message179 $boundary180 Content-Type: application/octet-stream; name="test.svg"181 Content-Transfer-Encoding: base64182 Content-Disposition: attachment; filename="test.svg"184 $attach1186 $boundary187 Content-Type: application/octet-stream; name="huh.txt"188 Content-Transfer-Encoding: base64189 Content-Disposition: attachment; filename="huh.txt"191 $attach2192 $boundary--194 END_OF_BODY196 sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";199 }