rlm@37: #!/usr/bin/perl
rlm@37: 
rlm@37: 
rlm@37: use List::Util qw(first max maxstr min minstr reduce shuffle sum);
rlm@37: use Storable;
rlm@37: use CGI::Ajax;
rlm@37: use CGI qw(:standard);
rlm@37: use URI::Escape;
rlm@37: use MIME::QuotedPrint;
rlm@37: use MIME::Base64;
rlm@37: use Mail::Sendmail 0.75; # doesn't work with v. 0.74!
rlm@37: use XML::Simple;
rlm@37: use Data::Dumper;
rlm@37: $Data::Dumper::Indent = 1;
rlm@38: use Storable;
rlm@40: use SVG;
rlm@37: 
rlm@37: my $q = new CGI;
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: my %hash = 
rlm@37: ( 
rlm@37: 'echo' => \&echo
rlm@37: );
rlm@37: 
rlm@37:  
rlm@37: 
rlm@37: my $pjx = CGI::Ajax->new(%hash);
rlm@37: 
rlm@37: # this outputs the html for the page, and stops caching, so the fucker will work in IE.
rlm@37: print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'}); 
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: sub gen
rlm@37: {
rlm@37:   {
rlm@37:     local( $/, *FH ) ;
rlm@37:     open( FH, "<./echo.html" ) or die "sudden flaming death\n";
rlm@37:     $a = <FH>;
rlm@37:    }
rlm@37: 
rlm@37:   {
rlm@37:     local( $/, *FH ) ;
rlm@37:     open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
rlm@37:     $b = <FH>;
rlm@37:    }
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: return $a
rlm@37: 
rlm@37: 
rlm@37: }
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: sub echo 
rlm@37: {
rlm@37: 	
rlm@37: 	
rlm@37: my $svg = $_[0];
rlm@37: 
rlm@37: my $destination = 'rlm@mit.edu';	
rlm@38: 
rlm@38: 
rlm@40: 
rlm@40: 
rlm@40: $svg = &impose($svg);
rlm@40: 
rlm@38: 
rlm@38: 
rlm@37: 
rlm@37: 	
rlm@37: &mail($svg, $destination);
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: return "done.";	
rlm@37: 	
rlm@37: }
rlm@37: 
rlm@37: 
rlm@40: 
rlm@40: sub impose
rlm@40: {
rlm@40: 
rlm@40: #here $svg is a string which contains the properly formatted svg data for one card
rlm@40: #out purpose here is to take that one card, size it correctly, and make appropiate copies 
rlm@40: #so that our supplier can simply import the file and print.
rlm@40: 
rlm@40: $sss =  $_[0];
rlm@40: $sss =~ s/^/\n\n\n/;
rlm@40: $sss =~ s/$/\n\n\n/;
rlm@40: # you fucking bitch!
rlm@40: $sss =~ s/Created wit........//;
rlm@40: 
rlm@40: 
rlm@40: # read XML file
rlm@40: my $xml = new XML::Simple;
rlm@40: my $data = $xml->XMLin($sss, ForceArray => 1);
rlm@40: 
rlm@40: 
rlm@40: my %data = %$data;
rlm@40: 
rlm@40: my %juzz  = 
rlm@40: (
rlm@40: 
rlm@40: path	=> $data{'path'},
rlm@40: rect 	=> $data{'rect'},
rlm@40: width	=>"16in" ,
rlm@40: height	=>"12in" ,
rlm@40: version	=>"1.1",
rlm@40: xmlns	=>"http://www.w3.org/2000/svg"
rlm@40: 
rlm@40: );
rlm@40: 
rlm@40: 
rlm@40: 
rlm@40: 
rlm@40: #print Dumper(%juzz);
rlm@40: 
rlm@40: 
rlm@40: my $svg= SVG->new(width=>"18in",height=>"12in");
rlm@40: 
rlm@40: #print Dumper($juzz{'path'}[2]);
rlm@40: #print "\n***************************\n";
rlm@40: #print Dumper($pathData);
rlm@40: 
rlm@40: 
rlm@40: 
rlm@40: 
rlm@40: my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";
rlm@40: 
rlm@40: 
rlm@40: my @cardCollection;
rlm@40: 
rlm@40: for $name(0..21)  #22 letters for 22 cards
rlm@40: {
rlm@40: 	
rlm@40: 	#calcuate the thing's place in the grid:
rlm@40: 	
rlm@40: 	$cardsToARow = 5;
rlm@40: 	$cardsToAColumn =  5;
rlm@40: 	
rlm@40: 	my $row = int($name/$cardsToARow);  #  cards to a row 
rlm@40: 	my $column = int($name %  $cardsToAColumn);
rlm@40: 	
rlm@40: 	$margin = 25;
rlm@40: 	$cardWidth   =  514*0.6057;
rlm@40: 	$cardHeight  = 	317*0.6057;
rlm@40: 	
rlm@40: 	
rlm@40: 	$transX = 40 + ($margin + $cardWidth ) * $column;
rlm@40: 	$transY = 40 + ($margin + $cardHeight) * $row;
rlm@40: 	
rlm@40: 	
rlm@40: 	
rlm@40: 	${"group_".$name} = 
rlm@40: 	$svg->group(
rlm@40:     id    => "group_".$name,    
rlm@40: 	transform => "translate($transX,$transY),"."$base"
rlm@40: 	);
rlm@40: 	
rlm@40: 	push @cardCollection, ${"group_".$name};
rlm@40: }
rlm@40: 
rlm@40: 
rlm@40: 
rlm@40:       
rlm@40:   
rlm@40:         
rlm@40:         
rlm@40:         
rlm@40: for ($i = 0; $i <= $#cardCollection; $i++)
rlm@40: {
rlm@40: 
rlm@40: for $pathData(@{$juzz{'path'}})
rlm@40: {
rlm@40: $cardCollection[$i]->tag('path', %{$pathData});
rlm@40: }
rlm@40: 
rlm@40: for $pathData(@{$juzz{'rect'}})
rlm@40: {
rlm@40: $cardCollection[$i]->tag('rect', %{$pathData});
rlm@40: }
rlm@40: 
rlm@40: 
rlm@40: }
rlm@40: 
rlm@40: 
rlm@40: 
rlm@40: #my $tag = $svg->tag('path', $juzz{'path'});
rlm@40: 
rlm@40: 
rlm@40: #$tag = $svg->group(%attributes);
rlm@40: 
rlm@40: 
rlm@40: $output =  $svg->xmlify;
rlm@40: 
rlm@40: 
rlm@40: $killCopyrigt = <<HERE;
rlm@40: <!-- 
rlm@40: 	Generated using the Perl SVG Module V2.49
rlm@40: 	by Ronan Oger
rlm@40: 	Info: http://www.roitsystems.com/
rlm@40:  -->
rlm@40: HERE
rlm@40: 
rlm@40: $output =~ s/$killCopyrigt/\n/;
rlm@40: 
rlm@40: return $output;
rlm@40: 
rlm@40: 	
rlm@40: 	
rlm@40: }
rlm@40: 
rlm@40: 
rlm@37: sub repair_file
rlm@37: {
rlm@37: 
rlm@37: 
rlm@38: $sss =  $_[0];
rlm@37: 
rlm@37: 
rlm@37: 
rlm@38: $sss =~ s/^/\n\n\n/;
rlm@38: $sss =~ s/$/\n\n\n/;
rlm@38: # you fucking bitch.
rlm@38: $sss =~ s/Created wit........//;
rlm@37: 
rlm@37: 
rlm@38: store \$sss, 'file';
rlm@37: 
rlm@37: # read XML file
rlm@38: $xml = new XML::Simple;
rlm@37: $data = $xml->XMLin($sss, ForceArray => 1);
rlm@37: 
rlm@37: 
rlm@37: my %data = %$data;
rlm@37: 
rlm@37: my %juzz  = 
rlm@37: (
rlm@37: 
rlm@37: path	=> $data{'path'},
rlm@37: rect 	=> $data{'rect'},
rlm@37: width	=>"16in" ,
rlm@37: height	=>"12in" ,
rlm@37: version	=>"1.1",
rlm@37: xmlns	=>"http://www.w3.org/2000/svg"
rlm@37: 
rlm@37: );
rlm@37: 
rlm@37: 
rlm@37: $out = $xml->XMLout(\%juzz , RootName=>'svg');
rlm@37: 
rlm@37: 
rlm@37: my $fixed = <<HERE;
rlm@37: <?xml version="1.0" standalone="no"?>
rlm@37: <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" 
rlm@37:   "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
rlm@37: HERE
rlm@37:  
rlm@37: 
rlm@37: 
rlm@37: $fixed .= $out;
rlm@37: 
rlm@37: #print $fixed;
rlm@38: return $fixed;
rlm@37: 	
rlm@37: }	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: sub mail
rlm@37: {
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: %mail = 
rlm@37: (
rlm@37: from => 'rlm@mit.edu',
rlm@37: to => $_[1],
rlm@37: subject => 'Test attachment',
rlm@37: );
rlm@37: 
rlm@37: 
rlm@37: $boundary = "====" . time() . "====";
rlm@37: $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
rlm@37: 
rlm@37: $message = encode_qp( "email from your friend PERL." );
rlm@37: 
rlm@37: $attach1 = encode_base64($_[0]);  # this part is so cool!  I can e-mail a perl varible to anyone in the world!
rlm@37: 
rlm@37: $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: 
rlm@37: $boundary = '--'.$boundary;
rlm@37: $mail{body} = <<END_OF_BODY;
rlm@37: $boundary
rlm@37: Content-Type: text/plain; charset="iso-8859-1"
rlm@37: Content-Transfer-Encoding: quoted-printable
rlm@37: 
rlm@37: $message
rlm@37: $boundary
rlm@37: Content-Type: application/octet-stream; name="test.svg"
rlm@37: Content-Transfer-Encoding: base64
rlm@37: Content-Disposition: attachment; filename="test.svg"
rlm@37: 
rlm@37: $attach1
rlm@37: 
rlm@37: $boundary
rlm@37: Content-Type: application/octet-stream; name="huh.txt"
rlm@37: Content-Transfer-Encoding: base64
rlm@37: Content-Disposition: attachment; filename="huh.txt"
rlm@37: 
rlm@37: $attach2
rlm@37: $boundary--
rlm@37: 
rlm@37: END_OF_BODY
rlm@37: 
rlm@37: sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";
rlm@37: 
rlm@37: 	
rlm@37: }
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: 	
rlm@37: