Mercurial > laserkard
view echo.pl @ 48:b2a11435a89b laserkard
[svn r49] implemented resizing text :)
author | rlm |
---|---|
date | Sun, 31 Jan 2010 20:26:16 -0500 |
parents | 1ac1409ea68c |
children | 95fa4bcc5d67 |
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;16 use SVG;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';75 $svg = &impose($svg);81 &mail($svg, $destination);86 return "done.";88 }92 sub impose93 {95 #here $svg is a string which contains the properly formatted svg data for one card96 #out purpose here is to take that one card, size it correctly, and make appropiate copies97 #so that our supplier can simply import the file and print.99 $sss = $_[0];100 $sss =~ s/^/\n\n\n/;101 $sss =~ s/$/\n\n\n/;102 # you fucking bitch!103 $sss =~ s/Created wit........//;106 # read XML file107 my $xml = new XML::Simple;108 my $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 );128 #print Dumper(%juzz);131 my $svg= SVG->new(width=>"18in",height=>"12in");133 #print Dumper($juzz{'path'}[2]);134 #print "\n***************************\n";135 #print Dumper($pathData);140 my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";143 my @cardCollection;145 for $name(0..21) #22 letters for 22 cards146 {148 #calcuate the thing's place in the grid:150 $cardsToARow = 5;151 $cardsToAColumn = 5;153 my $row = int($name/$cardsToARow); # cards to a row154 my $column = int($name % $cardsToAColumn);156 $margin = 25;157 $cardWidth = 514*0.6057;158 $cardHeight = 317*0.6057;161 $transX = 40 + ($margin + $cardWidth ) * $column;162 $transY = 40 + ($margin + $cardHeight) * $row;166 ${"group_".$name} =167 $svg->group(168 id => "group_".$name,169 transform => "translate($transX,$transY),"."$base"170 );172 push @cardCollection, ${"group_".$name};173 }182 for ($i = 0; $i <= $#cardCollection; $i++)183 {185 for $pathData(@{$juzz{'path'}})186 {187 $cardCollection[$i]->tag('path', %{$pathData});188 }190 for $pathData(@{$juzz{'rect'}})191 {192 $cardCollection[$i]->tag('rect', %{$pathData});193 }196 }200 #my $tag = $svg->tag('path', $juzz{'path'});203 #$tag = $svg->group(%attributes);206 $output = $svg->xmlify;209 $killCopyrigt = <<HERE;210 <!--211 Generated using the Perl SVG Module V2.49212 by Ronan Oger213 Info: http://www.roitsystems.com/214 -->215 HERE217 $output =~ s/$killCopyrigt/\n/;219 return $output;223 }226 sub repair_file227 {230 $sss = $_[0];234 $sss =~ s/^/\n\n\n/;235 $sss =~ s/$/\n\n\n/;236 # you fucking bitch.237 $sss =~ s/Created wit........//;240 store \$sss, 'file';242 # read XML file243 $xml = new XML::Simple;244 $data = $xml->XMLin($sss, ForceArray => 1);247 my %data = %$data;249 my %juzz =250 (252 path => $data{'path'},253 rect => $data{'rect'},254 width =>"16in" ,255 height =>"12in" ,256 version =>"1.1",257 xmlns =>"http://www.w3.org/2000/svg"259 );262 $out = $xml->XMLout(\%juzz , RootName=>'svg');265 my $fixed = <<HERE;266 <?xml version="1.0" standalone="no"?>267 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"268 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">269 HERE273 $fixed .= $out;275 #print $fixed;276 return $fixed;278 }282 sub mail283 {287 %mail =288 (289 from => 'rlm@mit.edu',290 to => $_[1],291 subject => 'Test attachment',292 );295 $boundary = "====" . time() . "====";296 $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";298 $message = encode_qp( "email from your friend PERL." );300 $attach1 = encode_base64($_[0]); # this part is so cool! I can e-mail a perl varible to anyone in the world!302 $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");308 $boundary = '--'.$boundary;309 $mail{body} = <<END_OF_BODY;310 $boundary311 Content-Type: text/plain; charset="iso-8859-1"312 Content-Transfer-Encoding: quoted-printable314 $message315 $boundary316 Content-Type: application/octet-stream; name="test.svg"317 Content-Transfer-Encoding: base64318 Content-Disposition: attachment; filename="test.svg"320 $attach1322 $boundary323 Content-Type: application/octet-stream; name="huh.txt"324 Content-Transfer-Encoding: base64325 Content-Disposition: attachment; filename="huh.txt"327 $attach2328 $boundary--330 END_OF_BODY332 sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";335 }