Mercurial > laserkard

annotate echo.pl @ 49:5eb11cf654de laserkard

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[svn r50] implemented max text length
author rlm
date Sun, 31 Jan 2010 21:37:24 -0500
parents 1ac1409ea68c
children 95fa4bcc5d67
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@40 16 use SVG;
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
rlm@38 72
rlm@40 73
rlm@40 74
rlm@40 75 $svg = &impose($svg);
rlm@40 76
rlm@38 77
rlm@38 78
rlm@37 79
rlm@37 80
rlm@37 81 &mail($svg, $destination);
rlm@37 82
rlm@37 83
rlm@37 84
rlm@37 85
rlm@37 86 return "done.";
rlm@37 87
rlm@37 88 }
rlm@37 89
rlm@37 90
rlm@40 91
rlm@40 92 sub impose
rlm@40 93 {
rlm@40 94
rlm@40 95 #here $svg is a string which contains the properly formatted svg data for one card
rlm@40 96 #out purpose here is to take that one card, size it correctly, and make appropiate copies
rlm@40 97 #so that our supplier can simply import the file and print.
rlm@40 98
rlm@40 99 $sss = $_[0];
rlm@40 100 $sss =~ s/^/\n\n\n/;
rlm@40 101 $sss =~ s/$/\n\n\n/;
rlm@40 102 # you fucking bitch!
rlm@40 103 $sss =~ s/Created wit........//;
rlm@40 104
rlm@40 105
rlm@40 106 # read XML file
rlm@40 107 my $xml = new XML::Simple;
rlm@40 108 my $data = $xml->XMLin($sss, ForceArray => 1);
rlm@40 109
rlm@40 110
rlm@40 111 my %data = %$data;
rlm@40 112
rlm@40 113 my %juzz =
rlm@40 114 (
rlm@40 115
rlm@40 116 path => $data{'path'},
rlm@40 117 rect => $data{'rect'},
rlm@40 118 width =>"16in" ,
rlm@40 119 height =>"12in" ,
rlm@40 120 version =>"1.1",
rlm@40 121 xmlns =>"http://www.w3.org/2000/svg"
rlm@40 122
rlm@40 123 );
rlm@40 124
rlm@40 125
rlm@40 126
rlm@40 127
rlm@40 128 #print Dumper(%juzz);
rlm@40 129
rlm@40 130
rlm@40 131 my $svg= SVG->new(width=>"18in",height=>"12in");
rlm@40 132
rlm@40 133 #print Dumper($juzz{'path'}[2]);
rlm@40 134 #print "\n***************************\n";
rlm@40 135 #print Dumper($pathData);
rlm@40 136
rlm@40 137
rlm@40 138
rlm@40 139
rlm@40 140 my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";
rlm@40 141
rlm@40 142
rlm@40 143 my @cardCollection;
rlm@40 144
rlm@40 145 for $name(0..21) #22 letters for 22 cards
rlm@40 146 {
rlm@40 147
rlm@40 148 #calcuate the thing's place in the grid:
rlm@40 149
rlm@40 150 $cardsToARow = 5;
rlm@40 151 $cardsToAColumn = 5;
rlm@40 152
rlm@40 153 my $row = int($name/$cardsToARow); # cards to a row
rlm@40 154 my $column = int($name % $cardsToAColumn);
rlm@40 155
rlm@40 156 $margin = 25;
rlm@40 157 $cardWidth = 514*0.6057;
rlm@40 158 $cardHeight = 317*0.6057;
rlm@40 159
rlm@40 160
rlm@40 161 $transX = 40 + ($margin + $cardWidth ) * $column;
rlm@40 162 $transY = 40 + ($margin + $cardHeight) * $row;
rlm@40 163
rlm@40 164
rlm@40 165
rlm@40 166 ${"group_".$name} =
rlm@40 167 $svg->group(
rlm@40 168 id => "group_".$name,
rlm@40 169 transform => "translate($transX,$transY),"."$base"
rlm@40 170 );
rlm@40 171
rlm@40 172 push @cardCollection, ${"group_".$name};
rlm@40 173 }
rlm@40 174
rlm@40 175
rlm@40 176
rlm@40 177
rlm@40 178
rlm@40 179
rlm@40 180
rlm@40 181
rlm@40 182 for ($i = 0; $i <= $#cardCollection; $i++)
rlm@40 183 {
rlm@40 184
rlm@40 185 for $pathData(@{$juzz{'path'}})
rlm@40 186 {
rlm@40 187 $cardCollection[$i]->tag('path', %{$pathData});
rlm@40 188 }
rlm@40 189
rlm@40 190 for $pathData(@{$juzz{'rect'}})
rlm@40 191 {
rlm@40 192 $cardCollection[$i]->tag('rect', %{$pathData});
rlm@40 193 }
rlm@40 194
rlm@40 195
rlm@40 196 }
rlm@40 197
rlm@40 198
rlm@40 199
rlm@40 200 #my $tag = $svg->tag('path', $juzz{'path'});
rlm@40 201
rlm@40 202
rlm@40 203 #$tag = $svg->group(%attributes);
rlm@40 204
rlm@40 205
rlm@40 206 $output = $svg->xmlify;
rlm@40 207
rlm@40 208
rlm@40 209 $killCopyrigt = <<HERE;
rlm@40 210 <!--
rlm@40 211 Generated using the Perl SVG Module V2.49
rlm@40 212 by Ronan Oger
rlm@40 213 Info: http://www.roitsystems.com/
rlm@40 214 -->
rlm@40 215 HERE
rlm@40 216
rlm@40 217 $output =~ s/$killCopyrigt/\n/;
rlm@40 218
rlm@40 219 return $output;
rlm@40 220
rlm@40 221
rlm@40 222
rlm@40 223 }
rlm@40 224
rlm@40 225
rlm@37 226 sub repair_file
rlm@37 227 {
rlm@37 228
rlm@37 229
rlm@38 230 $sss = $_[0];
rlm@37 231
rlm@37 232
rlm@37 233
rlm@38 234 $sss =~ s/^/\n\n\n/;
rlm@38 235 $sss =~ s/$/\n\n\n/;
rlm@38 236 # you fucking bitch.
rlm@38 237 $sss =~ s/Created wit........//;
rlm@37 238
rlm@37 239
rlm@38 240 store \$sss, 'file';
rlm@37 241
rlm@37 242 # read XML file
rlm@38 243 $xml = new XML::Simple;
rlm@37 244 $data = $xml->XMLin($sss, ForceArray => 1);
rlm@37 245
rlm@37 246
rlm@37 247 my %data = %$data;
rlm@37 248
rlm@37 249 my %juzz =
rlm@37 250 (
rlm@37 251
rlm@37 252 path => $data{'path'},
rlm@37 253 rect => $data{'rect'},
rlm@37 254 width =>"16in" ,
rlm@37 255 height =>"12in" ,
rlm@37 256 version =>"1.1",
rlm@37 257 xmlns =>"http://www.w3.org/2000/svg"
rlm@37 258
rlm@37 259 );
rlm@37 260
rlm@37 261
rlm@37 262 $out = $xml->XMLout(\%juzz , RootName=>'svg');
rlm@37 263
rlm@37 264
rlm@37 265 my $fixed = <<HERE;
rlm@37 266 <?xml version="1.0" standalone="no"?>
rlm@37 267 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
rlm@37 268 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
rlm@37 269 HERE
rlm@37 270
rlm@37 271
rlm@37 272
rlm@37 273 $fixed .= $out;
rlm@37 274
rlm@37 275 #print $fixed;
rlm@38 276 return $fixed;
rlm@37 277
rlm@37 278 }
rlm@37 279
rlm@37 280
rlm@37 281
rlm@37 282 sub mail
rlm@37 283 {
rlm@37 284
rlm@37 285
rlm@37 286
rlm@37 287 %mail =
rlm@37 288 (
rlm@37 289 from => 'rlm@mit.edu',
rlm@37 290 to => $_[1],
rlm@37 291 subject => 'Test attachment',
rlm@37 292 );
rlm@37 293
rlm@37 294
rlm@37 295 $boundary = "====" . time() . "====";
rlm@37 296 $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
rlm@37 297
rlm@37 298 $message = encode_qp( "email from your friend PERL." );
rlm@37 299
rlm@37 300 $attach1 = encode_base64($_[0]); # this part is so cool! I can e-mail a perl varible to anyone in the world!
rlm@37 301
rlm@37 302 $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");
rlm@37 303
rlm@37 304
rlm@37 305
rlm@37 306
rlm@37 307
rlm@37 308 $boundary = '--'.$boundary;
rlm@37 309 $mail{body} = <<END_OF_BODY;
rlm@37 310 $boundary
rlm@37 311 Content-Type: text/plain; charset="iso-8859-1"
rlm@37 312 Content-Transfer-Encoding: quoted-printable
rlm@37 313
rlm@37 314 $message
rlm@37 315 $boundary
rlm@37 316 Content-Type: application/octet-stream; name="test.svg"
rlm@37 317 Content-Transfer-Encoding: base64
rlm@37 318 Content-Disposition: attachment; filename="test.svg"
rlm@37 319
rlm@37 320 $attach1
rlm@37 321
rlm@37 322 $boundary
rlm@37 323 Content-Type: application/octet-stream; name="huh.txt"
rlm@37 324 Content-Transfer-Encoding: base64
rlm@37 325 Content-Disposition: attachment; filename="huh.txt"
rlm@37 326
rlm@37 327 $attach2
rlm@37 328 $boundary--
rlm@37 329
rlm@37 330 END_OF_BODY
rlm@37 331
rlm@37 332 sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";
rlm@37 333
rlm@37 334
rlm@37 335 }
rlm@37 336
rlm@37 337
rlm@37 338
rlm@37 339
rlm@37 340
rlm@37 341
rlm@37 342
rlm@37 343
rlm@37 344
rlm@37 345
rlm@37 346
rlm@37 347
rlm@37 348
rlm@37 349