WEE-Ching Reading

#! /usr/bin/perl ########################################################################### # WEEChing v1.0 # Perl I Ching Generator & Web Reading Parser # All readings are provided courtesy of Deoxy.org/iching # # (K) Kopyleft, all rights reversed # Joshua A. Cripe 2013 07 # # GOALS: # - Generate a random hexagram with changing lines # - Retrieve reading from deoxy.org/iching & parse from page # - Parse & display only relevant line readings # - Formulate resulting hexagram, retrieve, parse & display reading # # ISSUES: # - Maintain accuracy of hexagram & changing lines readings # - Add link or other means for generating a new hexagram # - Clean up code # # REVISIONS: ############################################################################ use strict; use warnings; use Switch; ########################################################################### # VARIABLES my @lines; # Used for storing numeral line indicators, 6 through 9 # 6 = old yin 7 = young yang # 8 = young yin 9 = old yang my $reading; # Used for storing text reading from deoxy my $firHex; # Used for first hexagram's binary value my $secHex; # Used for second hexagram's binary value my $hex; # Used for storing binary value of hexagram # 0 = yang, 1 = yin my %ch; # Used for storing binary value of hexagram changes # Key, Changing Line's Position (0-5) # Value, Changing Line's Original Value (6/9) ########################################################################### # PROCESSING # Generate new hexagram lines in 6-9 format @lines = genHex(); #print "Intial Lines: "; #foreach (@lines) { print "$_"; } #print "
\n"; # Translate Hex into binary value $firHex = readLines(@lines); #print "FIRST HEX: $firHex
\n"; # Read changing lines in Hex & update to new Hex @lines = readChanges(@lines); #print "CHANGES: \n"; #foreach (sort keys %ch) { print "$_ : $ch{$_}\n"; } #print "
\n"; # Translate new Hex into binary value $secHex = readLines(@lines); #print "SECOND HEX: $secHex
\n"; # Request page for generated reading my $URL = getURL($firHex); $reading = "$URL\n\n"; $reading .= `curl $URL`; # Parse page to remove all content prior to reading body @lines = split( ' ', $reading); $reading = getReading($firHex); # Add appropriate HTML header for reading $reading = "WEE-Ching Reading\n\n"; $reading .= "

Retrieved from: $URL

\n"; $reading .= "

New Reading | "; $reading .= "Save Reading

\n"; $reading .= "

"; $reading .= $lines[1]; # Parse reading to remove all content after reading body @lines = split('

Also see:', $reading); $reading = $lines[0]; # TODO Add methods for listing relevant lines in reading # Parse out line readings @lines = split('
THE LINES', $reading); $reading = $lines[0]; if((scalar keys %ch) > 0) { # Split the individual line readings @lines = split(/.*means:/, $lines[1]); # Add the prefix $reading .= " THE LINES
\n"; # Sort & iterate through the keys (changing lines) # Adding the missing line removed by split foreach (sort keys %ch) { # Verbosity... $reading .= "CHANGE $_: $ch{$_}
\n"; $reading .= "\t"; if($ch{$_} == 9) { $reading .= "Nine"; } elsif($ch{$_} == 6) { $reading .= "Six"; } else { $reading .= "ERROR!"; } $reading .= " at "; switch($_) { case 0 { $reading .= "the beginning"; } case 1 { $reading .= "the second place"; } case 2 { $reading .= "the third place"; } case 3 { $reading .= "the fourth place"; } case 4 { $reading .= "the fifth place"; } case 5 { $reading .= "the top"; } } $reading .= " means:"; $reading .= $lines[($_+1)]; } $reading .= "

\n
\n"; # TODO Add methods for appending second hexagram's reading $URL = getURL($secHex); $reading .= "

Second Reading Retrieved from: $URL

\n"; $reading .= "

New Reading | "; $reading .= "Save Reading

\n"; $reading .= "

"; my $tmp = getReading($secHex); @lines = split('

THE LINES', $tmp); $reading .= $lines[0]; } # Append Closing tags $reading .= "

"; $reading .= "

New Reading | "; $reading .= "Save Reading

\n"; $reading .= ""; #print "$reading\n"; # Write reading to iching.html file instead of returning on this page # NOTE: Added for browser compatibility with Windows systems open(my $OUTPUT, ">", "iching.html") || die "Couldn't open iching.html for writing because: ".$!; print $OUTPUT $reading; # Redirect to HTML file's location print "Location: iching.html\n\n"; ########################################################################### # SUB ROUTINES sub genHex { my @lines = (0, 0, 0, 0, 0, 0); foreach my $i (0 .. $#lines) { $lines[$i] = int(rand(4)) + 6; } return @lines if wantarray; my $hex = ""; foreach (@lines) { $hex .= $_; } return $hex; } sub readLines { my @lines = @_; my $hex = ""; foreach (@lines) { if($_ == "7" || $_ == "9") { $hex .= "1"; } else { $hex .= "0"; } } #print lookup($hex); #print "\n"; return $hex; } sub readChanges { my @changes = @_; foreach my $i (0 .. $#changes) { if($changes[$i] == 6) { $changes[$i] = 7; #push @ch, $i; $ch{$i} = 6; } elsif ($changes[$i] == 9) { $changes[$i] = 8; #push @ch, $i; $ch{$i} = 9; } } return @changes; } sub getReading { my $hex = pop; # Request page for generated reading my $URL = getURL($hex); my $reading = "$URL\n\n"; $reading .= `curl $URL`; # Parse page to remove all content prior to reading body my @lines = split(' ', $reading); $reading = $lines[1]; return wantarray ? @lines : $reading; } sub getURL { my $lines = shift @_; my $req = "http://deoxy.org/iching/"; if($lines == "000000") { $req .= "1"; } if($lines == "000001") { $req .= "43"; } if($lines == "000010") { $req .= "14"; } if($lines == "000011") { $req .= "34"; } if($lines == "000100") { $req .= "9"; } if($lines == "000101") { $req .= "5"; } if($lines == "000110") { $req .= "26"; } if($lines == "000111") { $req .= "11"; } if($lines == "001000") { $req .= "10"; } if($lines == "001001") { $req .= "58"; } if($lines == "001010") { $req .= "38"; } if($lines == "001011") { $req .= "54"; } if($lines == "001100") { $req .= "61"; } if($lines == "001101") { $req .= "60"; } if($lines == "001110") { $req .= "41"; } if($lines == "001111") { $req .= "19"; } if($lines == "010000") { $req .= "13"; } if($lines == "010001") { $req .= "49"; } if($lines == "010010") { $req .= "30"; } if($lines == "010011") { $req .= "55"; } if($lines == "010100") { $req .= "37"; } if($lines == "010101") { $req .= "63"; } if($lines == "010110") { $req .= "22"; } if($lines == "010111") { $req .= "36"; } if($lines == "011000") { $req .= "25"; } if($lines == "011001") { $req .= "17"; } if($lines == "011010") { $req .= "21"; } if($lines == "011011") { $req .= "51"; } if($lines == "011100") { $req .= "42"; } if($lines == "011101") { $req .= "3"; } if($lines == "011110") { $req .= "27"; } if($lines == "011111") { $req .= "24"; } if($lines == "100000") { $req .= "44"; } if($lines == "100001") { $req .= "28"; } if($lines == "100010") { $req .= "50"; } if($lines == "100011") { $req .= "32"; } if($lines == "100100") { $req .= "57"; } if($lines == "100101") { $req .= "48"; } if($lines == "100110") { $req .= "18"; } if($lines == "100111") { $req .= "46"; } if($lines == "101000") { $req .= "6"; } if($lines == "101001") { $req .= "47"; } if($lines == "101010") { $req .= "64"; } if($lines == "101011") { $req .= "40"; } if($lines == "101100") { $req .= "59"; } if($lines == "101101") { $req .= "29"; } if($lines == "101110") { $req .= "4"; } if($lines == "101111") { $req .= "7"; } if($lines == "110000") { $req .= "33"; } if($lines == "110001") { $req .= "31"; } if($lines == "110010") { $req .= "56"; } if($lines == "110011") { $req .= "62"; } if($lines == "110100") { $req .= "53"; } if($lines == "110101") { $req .= "39"; } if($lines == "110110") { $req .= "52"; } if($lines == "110111") { $req .= "15"; } if($lines == "111000") { $req .= "12"; } if($lines == "111001") { $req .= "45"; } if($lines == "111010") { $req .= "35"; } if($lines == "111011") { $req .= "16"; } if($lines == "111100") { $req .= "20"; } if($lines == "111101") { $req .= "8"; } if($lines == "111110") { $req .= "23"; } if($lines == "111111") { $req .= "2"; } return $req; }