Mercurial > laserkard
view sex_again.pl @ 52:375225442677 laserkard
[svn r53] changed the success message for echo.pl
author | rlm |
---|---|
date | Wed, 03 Feb 2010 03:32:49 -0500 |
parents | 8b3b5753ad41 |
children |
line wrap: on
line source
1 #!/usr/bin/perl7 use List::Util qw(first max maxstr min minstr reduce shuffle sum);8 use Storable;9 use CGI::Ajax;10 use CGI qw(:standard);11 use URI::Escape;12 use MIME::QuotedPrint;13 use MIME::Base64;14 use Mail::Sendmail 0.75; # doesn't work with v. 0.74!15 use XML::Simple;16 use Data::Dumper;17 $Data::Dumper::Indent = 1;18 use Storable;19 use SVG;22 $ref = retrieve('file');24 #print Dumper $$ref;25 &echo($$ref);26 #&impose($$ref);31 sub impose32 {34 #here $svg is a string which contains the properly formatted svg data for one card35 #out purpose here is to take that one card, size it correctly, and make appropiate copies36 #so that our supplier can simply import the file and print.38 $sss = $_[0];39 $sss =~ s/^/\n\n\n/;40 $sss =~ s/$/\n\n\n/;41 # you fucking bitch!42 $sss =~ s/Created wit........//;45 # read XML file46 my $xml = new XML::Simple;47 my $data = $xml->XMLin($sss, ForceArray => 1);50 my %data = %$data;52 my %juzz =53 (55 path => $data{'path'},56 rect => $data{'rect'},57 width =>"16in" ,58 height =>"12in" ,59 version =>"1.1",60 xmlns =>"http://www.w3.org/2000/svg"62 );67 #print Dumper(%juzz);70 my $svg= SVG->new(width=>"18in",height=>"12in");72 #print Dumper($juzz{'path'}[2]);73 print "\n***************************\n";74 #print Dumper($pathData);79 my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";82 my @cardCollection;84 for $name(0..21) #22 letters for 22 cards85 {87 #calcuate the thing's place in the grid:89 $cardsToARow = 5;90 $cardsToAColumn = 5;92 my $row = int($name/$cardsToARow); # cards to a row93 my $column = int($name % $cardsToAColumn);95 $margin = 25;96 $cardWidth = 514*0.6057;97 $cardHeight = 317*0.6057;100 $transX = 40 + ($margin + $cardWidth ) * $column;101 $transY = 40 + ($margin + $cardHeight) * $row;105 ${"group_".$name} =106 $svg->group(107 id => "group_".$name,108 transform => "translate($transX,$transY),"."$base"109 );111 push @cardCollection, ${"group_".$name};112 }117 #my $y=$svg->group(118 # id => 'group_y' );119 #120 #my $f=$svg->group(121 # id => 'group_f' ,122 # transform => "$base"123 #124 # );125 #126 #133 for ($i = 0; $i <= $#cardCollection; $i++)134 {136 for $pathData(@{$juzz{'path'}})137 {138 $cardCollection[$i]->tag('path', %{$pathData});139 }141 for $pathData(@{$juzz{'rect'}})142 {143 $cardCollection[$i]->tag('rect', %{$pathData});144 }147 }151 #my $tag = $svg->tag('path', $juzz{'path'});154 #$tag = $svg->group(%attributes);157 $output = $svg->xmlify;160 $killCopyrigt = <<HERE;161 <!--162 Generated using the Perl SVG Module V2.49163 by Ronan Oger164 Info: http://www.roitsystems.com/165 -->166 HERE168 $output =~ s/$killCopyrigt/\n/;170 return $output;174 }187 sub echo188 {191 my $svg = $_[0];193 my $destination = 'rlm@mit.edu';194 #~ $svg =~ s/</\<\;/g;195 #~ return $svg;198 #$svg = &repair_file($svg);200 $svg = &impose($svg);203 #print $svg;204 open OUT, '>C:/Documents and Settings/Robert McIntyre/Desktop/perlOut.svg';205 select OUT;206 print $svg;207 close OUT;209 #&mail($svg, $destination);211 return "done.";213 }220 sub repair_file221 {224 $sss = $_[0];228 $sss =~ s/^/\n\n\n/;229 $sss =~ s/$/\n\n\n/;230 # you fucking bitch.231 $sss =~ s/Created wit........//;234 store \$sss, 'file';236 # read XML file237 my $xml = new XML::Simple;238 my $data = $xml->XMLin($sss, ForceArray => 1);241 my %data = %$data;243 my %juzz =244 (246 path => $data{'path'},247 rect => $data{'rect'},248 width =>"16in" ,249 height =>"12in" ,250 version =>"1.1",251 xmlns =>"http://www.w3.org/2000/svg"253 );256 $out = $xml->XMLout(\%juzz , RootName=>'svg');259 my $fixed = <<HERE;260 <?xml version="1.0" standalone="no"?>261 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"262 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">263 HERE267 $fixed .= $out;269 #print $fixed;270 return $fixed;272 }