############################################################### # Tag Cloud Generator for Wordpress.com by //engtech ############################################################### # # This is a program that connects to the Wordpress.com server # and creates a tag cloud of your blog that you can later # cut-and-paste where ever you like. # # Get more information here: # http://internetducttape.com/tools/wordpress/tag_cloud_generator_for_wordpress/ # # Visit my blog at http://internetducttape.com # ############################################################### # # This work is licensed under the Creative Commons # Attribution-Noncommercial-No Derivative Works 2.5 License. # # To view a copy of this license, visit # http://creativecommons.org/licenses/by-nc-nd/2.5/ or # send a letter to # Creative Commons, 543 Howard Street, 5th Floor, # San Francisco, California, 94105, USA. # ############################################################### # # WARNING: Contains some dirty, dirty hacks. This was a quick # one-off I wrote for myself and then bolted a GUI onto for # mass distribution. # ############################################################### # # WHAT'S NEW IN THIS VERSION # # Outputs all existing categories to the tagcloud.csv file # - This makes it a LOT easier to get started with exluding # and renaming categories # ############################################################### # perl2exe does a very bad job of auto-detecting module imports, # so I have to be explicit to a level of complete stupidity. use strict; use warnings; use WWW::Mechanize; use Tk; use Tk::Label; use Tk::DummyEncode; use Tk::Labelframe; use Tk::ROText; use Tk::Menu; use Tk::NoteBook; use Tk::Radiobutton; use Tk::NumEntryPlain; use Tk::HexEntryPlain; # NOTE: I hacked HexEntryPlain to display 6 digit values # for RGB HTML codes require YAML::Dumper::Base; use YAML::Dumper; require YAML::Loader::Base; use YAML::Loader; use YAML::Base; use YAML::Node; use YAML qw/LoadFile DumpFile/; use HTML::TagCloud; use Cwd; use Data::Dumper; use Text::CSV_XS; use Spreadsheet::Read; use HTML::Entities; use Getopt::Long; use FileHandle; #require Tk::ErrorDialog; #perl2exe_include utf8; #perl2exe_include "unicore/lib/gc_sc/Word.pl"; #perl2exe_include "unicore/lib/gc_sc/Digit.pl"; #perl2exe_include "unicore/lib/gc_sc/SpacePer.pl"; #perl2exe_include "unicore/lib/gc_sc/Uppercas.pl"; #perl2exe_include "unicore/To/Lower.pl"; # Constants use constant RELEASE_FILE => "release_notes.txt"; use constant CONFIG_FILE => "tagcloud.cfg"; use constant CSV_FILE => "tagcloud.csv"; use constant BUILD => "07/05/01"; # Main objects my $mech = WWW::Mechanize->new(autocheck =>0, onerror => undef); my $mw; my $yaml = new YAML; my $dir = ""; my $nogui = 0; my $status; my $cloud; my %exclude = (); my %rename = (); my %posts = (); my %posts_hash = (); my %parents_hash = (); my $ran_once = 0; my $very_first_time = 1; # Configuration Settings my %default_settings = ( 'bool_debug_mode'=>0, 'max_tags'=>0, 'min_tags_to_show'=>1, 'font__smallest_size_font'=>0, 'font__largest_size_font'=>6, 'font__smallest_size_css_px'=>6, 'font__largest_size_css_px'=>32, 'font__step_size'=>24, 'font__css_name_offset'=>0, 'bool_use_hierarchy'=>0, 'bool_display_count'=>0, 'bool_sort_alphabetically'=>0, 'bool_check_categories'=>0, 'bool_use_category_instead_of_tag'=>0, 'bool_dump_settings_to_output'=>0, 'bool_use_colors'=>0, 'bool_use_font_sizes'=>1, 'bool_css_use_line_height'=>1, 'bool_minimize_file_size'=>0, 'color__smallest_color'=>'DDDDDD', 'color__largest_color'=>'000000', ); my %settings = (); my %desc = ( 'bool_use_font_sizes'=>{ 'cat'=>'font','order'=>'0','type'=>'bool', 'desc'=>'[FONT,CSS] Should different font sizes be used in the tag cloud?','on'=>'Use different sizes','off'=>'All tags are the same size'}, 'font__smallest_size_font'=>{ 'cat'=>'font_font','order'=>'2','type'=>'num','min'=>0,'max'=>12, 'example'=>'This is the size used in an HTML .', 'desc'=>'[FONT] Font size of smallest tag. HTML font tag size between 0 to 7.'}, 'font__largest_size_font'=>{ 'cat'=>'font_font','order'=>'3','type'=>'num','min'=>1,'max'=>12, 'example'=>'This is the size used in an HTML .', 'desc'=>'[FONT] Font size of largest tag. HTML font tag size between 1 to 7.'}, 'font__smallest_size_css_px'=>{ 'cat'=>'font_css','order'=>'5','type'=>'num','min'=>0,'max'=>300, 'example'=>'This is the size used in a CSS {font-size: # px;}', 'desc'=>'[CSS] Font size of smallest tag, in px. Normal text is between 10 to 14 px.'}, 'font__largest_size_css_px'=>{ 'cat'=>'font_css','order'=>'6','type'=>'num','min'=>0,'max'=>300, 'example'=>'This is the size used in a CSS {font-size: # px;}', 'desc'=>'[CSS] Font size of largest tag, in px. Normal text is between 10 to 14 px.'}, 'font__step_size'=>{ 'cat'=>'styles','order'=>'1','type'=>'num','min'=>0,'max'=>1024, 'desc'=>'[CSS STYLES] The number of different CSS styles to create.', 'example'=>'10 would create CSS styles for tagcloud0 to tagcloud10.','example2'=>'0 will use largest CSS font size - smallest CSS font size.'}, 'font__css_name_offset'=>{ 'cat'=>'styles','order'=>'4','type'=>'num','min'=>0,'max'=>32000, 'desc'=>'[CSS STYLES] Add offset to generate CSS styles? (if have multiple clouds on one blog)'}, 'bool_css_use_line_height'=>{ 'cat'=>'styles','order'=>'1','type'=>'bool','on'=>'Use CSS line height','off'=>'Do not use CSS line height', 'desc'=>'[CSS STYLES] Should it use the CSS line-height property?'}, 'max_tags'=>{ 'cat'=>'tag_maxmin','order'=>'2','type'=>'num','min'=>0,'max'=>32000, 'desc'=>'[TAGS] Maximum number of category/tags to display.', 'example'=>'15 would create a cloud with the 15 largest tags. 0 will display all tags.'}, 'min_tags_to_show'=>{ 'cat'=>'tag_maxmin','order'=>'2','type'=>'num','min'=>0,'max'=>32000, 'desc'=>'[TAGS] Minimum number of posts in a category/tag before it displays.','example'=>'3 would ignore all tags with less than 3 posts.'}, 'bool_minimize_file_size'=>{ 'cat'=>'tag-adv','order'=>'4','type'=>'bool', 'desc'=>'[TAGS] Should the program try to minimize the generated file size as much as possible?.', 'on'=>'Minimize the file size','off'=>'Do not try to minimize file size'}, 'bool_use_hierarchy'=>{ 'cat'=>'tag-adv','order'=>'3','type'=>'bool', 'desc'=>'[TAGS] Should child counts be included in parent categories?','on'=>'Child counts added to parent','off'=>'Each category is counted separately'}, 'bool_display_count'=>{ 'cat'=>'tag','order'=>'1','type'=>'bool', 'desc'=>'[TAGS] Should post counts be displayed as part of the tag cloud?','on'=>'Display post count','off'=>'Do not display'}, 'bool_sort_alphabetically'=>{ 'cat'=>'sort','order'=>'0','type'=>'bool', 'desc'=>'[SORT] Should the tag cloud be sorted alphabetically or by the number of posts in a tag?','on'=>'Sort alphabetically','off'=>'Sort by post count'}, 'bool_use_category_instead_of_tag'=>{ 'cat'=>'url','order'=>'4','type'=>'bool', 'desc'=>'[URL] Should the tag cloud use BLOG/tag/blah or BLOG/category/blah?','on'=>'/category/','off'=>'/tag/'}, 'bool_check_categories'=>{ 'cat'=>'zdebug', 'order'=>2,'type'=>'bool', 'desc'=>'[DEBUG] Check that every category exists? (slows down program a LOT)','on'=>'Dump link report to tagcloud_report.html','off'=>'Do not dump'}, 'bool_debug_mode' => { 'cat'=>'zdebug', 'order'=>3,'type'=>'bool', 'desc'=>'[DEBUG] Dump debugging information to a file? (slows down program)', 'on'=>'Dump to tagcloud.dbg', 'off'=>'Do not dump'}, 'bool_dump_settings_to_output' => { 'cat'=>'zdebug', 'order'=>1,'type'=>'bool', 'desc'=> '[DEBUG] Dump settings (other than password) to the output HTML files? (useful for debugging/examples)'}, 'bool_use_colors' => { 'cat'=>'color', 'order'=>1,'type'=>'bool', 'desc'=>'[COLOR] Should different colors be used for the tag cloud?', 'on'=>'Use different colors','off'=>'All tags are the same color'}, 'color__smallest_color' => { 'cat'=>'color_type', 'order'=>2,'type'=>'rgb', 'desc'=>'[COLOR] Color to use for the smallest tags.', 'example'=>'Standard HTML colors. Black=000000, white=FFFFFF, red=FF0000, blue=0000FF'}, 'color__largest_color' => { 'cat'=>'color_type', 'order'=>2,'type'=>'rgb', 'desc'=>'[COLOR] Color to use for the largest tags.', 'example'=>'Standard HTML colors. Black=000000, white=FFFFFF, red=FF0000, blue=0000FF'}, ); my $create_notes = 0; my %release_notes = ( "07/05/01"=>{'bugs'=>'none', 'notes'=>qq{ * Special version for icanhascheezeburger.com * Switched to using relative links instead of absolute links. Instead of using "a span.tagcloud" it uses "a.tcg". - Original CSS cloud filesize was 98,567 bytes - New CSS cloud filesize is 42,937 bytes }}, "07/03/11"=>{'bugs'=>'some issues with accents', 'notes'=>qq{ Fixed bug with some CSS styles not being created unless you had a lot of categories. More configuration options: Can choose different colours, different sizes or both for the tag cloud. Can control the size of the smallest and largest fonts. Can control the number of different CSS styles that are created. Can display the settings used in tagcloud.html and tagcloud_css.html. Can check for new versions / known bugs from within the program. Tested with various self-hosted Wordpress installs -- it works. }}, "07/02/26"=>{'bugs'=>'Some CSS styles are not generated.', 'notes'=>qq{ Can control previously hidden options like sorting from within the program. }} ); my $url = "http://"; my $username = ""; my $password = ""; my %settings_fields = (); # Parse command line options. GetOptions ("dir=s" => \$dir, "nogui" => \$nogui, "notes"=>\$create_notes); my $log; # Call the main program main(); sub main { devChecks(); handleCmdLineArgs(); loadConfig(); if (!$nogui) { guiSettings(); MainLoop; } else { doRunFirstTime(); } print "Done.\n"; if ($log) { close($log); } exit 0; } # Make sure the data structure for the settings is correctly set up. sub devChecks { my $error_count = 0; foreach my $k (sort keys %release_notes) { if (not defined $release_notes{$k}{bugs}) { print STDERR "release_notes='$k' does not have a list of bugs\n"; $error_count++; } if (not defined $release_notes{$k}{notes}) { print STDERR "release_notes='$k' does not have any notes\n"; $error_count++; } } foreach my $k (sort keys %default_settings) { if (not defined $desc{$k}) { print STDERR "default_settings='$k' does not have a description\n"; $error_count++; } } foreach my $k (sort keys %desc) { if (not defined $default_settings{$k}) { print STDERR "desc='$k' does not have a setting\n"; $error_count++; } if (not defined $desc{$k}{desc}) { print STDERR "desc='$k' does not have an description\n"; $error_count++; } if (not defined $desc{$k}{order}) { print STDERR "desc='$k' does not have an order\n"; $error_count++; } if (not defined $desc{$k}{cat}) { print STDERR "desc='$k' does not have a category\n"; $error_count++; } if (not defined $desc{$k}{type}) { print STDERR "desc='$k' does not have a type\n"; $error_count++; } if ($desc{$k}{type} eq "num") { if (not defined $desc{$k}{min}) { print STDERR "desc='$k' does not have a min value\n"; $error_count++; } if (not defined $desc{$k}{max}) { print STDERR "desc='$k' does not have a max value\n"; $error_count++; } } } if ($error_count > 0) { die "encountered $error_count errors"; } } sub handleCmdLineArgs { # Should I display the gui or run in command line mode? if (! $nogui) { $mw = new MainWindow(-height=>600); } else { print "Running without gui\n"; } # Should I use a different directory? if ($dir ne "") { if (! -d $dir) { mkdir($dir); } chdir($dir); } $log = new FileHandle("tagcloud.log", "w") || doError("Cannot open logfile", "Could not write to tagcloud.log"); if ($dir ne "") { print $log "Changed directory to $dir\n"; } if ($create_notes) { createReleaseNotes(); print "Done.\n"; exit 0; } } sub checkVersion { my $base_url = "http://internetducttape.com/tools/wordpress/"; my $release_url = $base_url."tag_cloud_generator_for_wordpress/release-notes/"; addStatus("Checking version"); $mech = WWW::Mechanize->new(autocheck =>0, onerror => undef); $mech->get( $release_url ); if(!$mech->success) { addStatus("... could not connect to //engtech"); return 0; } my @lines = split(/\n/, $mech->content); my $capture = 0; my $notes = ""; foreach(@lines) { if (m/<\/pre>/) { $capture = 0; } if ($capture) { $notes .= $_ . "\n"; } if (m/
/) {
      $capture = 1;
    }
  }
  if ($notes ne "") {
    print $log "... got release notes\n";
    print $log $notes . "\n\n";
  }
  my $release = YAML::Load($notes);
  %release_notes = %{$release};
  my $version = BUILD;
  $version =~ s/^(\d\d\/\d\d\/\d\d).*?$/$1/;
  my $new_v_title = "";
  my $new_v = "";
  foreach my $v (sort {$b cmp $a} keys %release_notes) {
#    addStatus(sprintf("$version cmp $v == %d",$v cmp $version));
    if (($v cmp $version) > 0) {
      if ($new_v_title eq "") {
        $new_v_title = "Tag Cloud Generator $v is Available";
        addStatus($new_v_title);
        $new_v .= "What's New\n";
      }
      $new_v .= $release_notes{$v}{notes};
    }
  }
  if (defined $release_notes{$version}{bugs}) {
    if ($release_notes{$version}{bugs} ne "none") {
      addStatus("... this version has the following bugs:");
      addStatus($release_notes{$version}{bugs});
      if ($new_v_title eq "") {
        addStatus("... these bugs aren't fixed yet.");
      }
      addStatus("");
    }
  }
  if ($new_v_title ne "") {
    $new_v .= "\nGet the new version at http://internetducttape.com/tools/wordpress/\n";
    $mw -> messageBox(
                    -icon=>"info",
                    -type=>"ok",
                    -title=>$new_v_title,
                    -message=>$new_v);
  }
  else {
    addStatus("... you have the latest version.");
  }
  addStatus("Enter settings and click 'run' to get started");
}

sub createReleaseNotes {
  print "Creating release notes.\n";
  my $fields = \%release_notes;
  DumpFile(RELEASE_FILE, $fields);
}

# GUI: Add status
sub addStatus {
  my ($add) = @_;
  if (defined $status) {
    print $log "$add\n";
    print "$add\n";
    $status->idletasks;
#    my $text = $status->Contents();
#    $text .= "\n".$add;
#    $status->Contents($text);
  }
}

# GUI: open up the settings configuration
sub guiSettings {
  $mw->optionAdd('*BorderWidth' => 1);
  $mw->optionAdd('relief' => 'raised');
  $mw->optionAdd('geometry'=>'800x600');

  my $book = $mw->NoteBook()->pack( -fill=>'both', -expand=>1 );

  my $tab1 = $book->add( "Sheet 1", -label=>"Start");

  my $ws_l = $tab1->Label(-text => '')->pack;
  $tab1->Label(-borderwidth => 0,-text => 'Tag Cloud Generator for Blogs Hosted on Wordpress.com', -font=>'bold')->pack();
  $tab1->Label(-text => "[Version: ".BUILD."]")->pack();
  $ws_l = $tab1->Label(-text => '')->pack;

  my $frame_check_step = $tab1->Labelframe(-borderwidth => 0)->pack(qw/-side top -fill x -pady 0 -padx 0/);
  $frame_check_step->Label(-text => "           ")->pack(qw/-side left -pady 5 -padx 5/);
  $frame_check_step->Button(-text => 'Check for updates', -command => sub{checkVersion()} )
    ->pack(-side => 'right', -expand => 1, -fill => 'x', -pady => 1, -padx => 1);

  my $frame_settings_step = $tab1->Labelframe(-borderwidth => 0)->pack(qw/-side top -fill x -pady 0 -padx 0/);
  $frame_settings_step->Label(-text => "Step 1:")->pack(qw/-side left -pady 5 -padx 5/);

  my $frame_settings = $frame_settings_step->Labelframe(-borderwidth => 0)->pack(qw/-side top -fill x -pady 0 -padx 0/);
  my $frame = $frame_settings->Labelframe()->pack(qw/-side top -fill x/);
  my $url_l = $frame->Label(-text => 'Wordpress blog url (IE: http://engtech.wordpress.com)')->pack(-side=>'left', -padx=>5);
  my $url_w = $frame->Entry(-width => 40)->pack(-side=>'right');
  $url_w->insert(0, $url);
  $frame = $frame_settings->Labelframe()->pack(qw/-side top -fill x/);
  my $username_l = $frame->Label(-text => 'Wordpress account name (IE: engtech)')->pack(-side=>'left', -padx=>5);
  my $username_w = $frame->Entry(-width => 40)->pack(-side=>'right');
  $username_w->insert(0, $username);
  $frame = $frame_settings->Labelframe()->pack(qw/-side top -fill x/);
  my $password_l = $frame->Label(-text => 'Wordpress password')->pack(-side=>'left', -padx=>5);
  my $password_w = $frame->Entry(-width => 40)->pack(-side=>'right');
  $password_w->insert(0, $password);

  my $frame_run_step = $tab1->Labelframe(-borderwidth => 0)->pack(qw/-side top -fill x -pady 0 -padx 0/);
  $frame_run_step->Label(-text => "Step 2:")->pack(qw/-side left -pady 5 -padx 5/);
  $frame_run_step->Button(-text => 'Run (takes a while)', -command => sub{doRun($url_w, $username_w, $password_w)} )
    ->pack(-side => 'right', -expand => 1, -fill => 'x', -pady => 1, -padx => 1);

  my $frame_open_step = $tab1->Labelframe(-borderwidth => 0)->pack(qw/-side top -fill x -pady 0 -padx 0/);
  $frame_open_step->Label(-text => "Step 3:")->pack(qw/-side left -pady 5 -padx 5/);
    $frame_open_step->Button(-text => 'I have the CSS Upgrade', -command => sub{doSettingsOpen("tagcloud_css.html")} )
      ->pack(-side => 'right', -expand => 1, -fill => 'x', -pady => 1, -padx => 1);
    $frame_open_step->Button(-text => 'I do not have the CSS Upgrade', -command => sub{doSettingsOpen("tagcloud.html")} )
      ->pack(-side => 'right', -expand => 1, -fill => 'x', -pady => 1, -padx => 1);

  my $frame_close_step = $tab1->Labelframe(-borderwidth => 0)->pack(qw/-side top -fill x -pady 0 -padx 0/);
  $frame_close_step->Label(-text => "Step 4:")->pack(qw/-side left -pady 5 -padx 5/);
    $frame_close_step->Button(-text => 'Close', -command => sub{doClose()} )
      ->pack(-side => 'right', -expand => 1, -fill => 'x', -pady => 1, -padx => 1);

  my $frame_output = $tab1->Labelframe(-borderwidth=>0)->pack(qw/-side top -fill x -pady 0 -padx 0/);
  $frame_output->Label(-text => "", -borderwidth=>0)->pack(qw/-side top -pady 5 -padx 5/);
  $status = $frame_output->ROText(
                          -fg             => '#ffffff',
                          -bg             => '#000000',
                          -relief         => 'sunken',
                          -wrap           => 'none',
                          -bd             => 2,
                          -height         => 15,
)->pack(qw/-side left -fill x/);
  tie (*STDOUT, ref $status, $status);
  tie (*STDERR, ref $status, $status);

  my $tab2 = $book->add( "Sheet 2", -label=>"General Options");

  guiAdvancedSettings($tab2, ('sort','tag','tag_maxmin'));

  my $tab3 = $book->add( "Sheet 3", -label=>"Color Options");
  guiAdvancedSettings($tab3, ('color','color_type'));

  my $tab4 = $book->add( "Sheet 4", -label=>"Font Options");
  guiAdvancedSettings($tab4, ('font','font_font','font_css'));

  my $tab5 = $book->add( "Sheet 5", -label=>"Advanced Options");
  guiAdvancedSettings($tab5, ('styles','tag-adv','url','zdebug'));

  addStatus("Enter settings and click 'run' to get started");
}

# GUI: Sort the settings from least complicated to most complicated
sub sortSettings {
  my ($a, $b) = @_;
  my $cat_a = "";
  my $cat_b = "";
  my $order_a = -1;
  my $order_b = -1;
  if (defined $desc{$a}) {
    if (defined $desc{$a}{order}) {
      $order_a = $desc{$a}{order};
    }
    if (defined $desc{$a}{cat}) {
      $cat_a = $desc{$a}{cat};
    }
  }
  if (defined $desc{$b}) {
    if (defined $desc{$b}{order}) {
      $order_b = $desc{$b}{order};
    }
    if (defined $desc{$b}{cat}) {
      $cat_b = $desc{$b}{cat};
    }
  }
  if ($cat_a ne $cat_b) {
    return($cat_a cmp $cat_b);
  }
  else {
    return($order_a <=> $order_b);
  }
}

# GUI: Create a dialog for editting the advanced settings
sub guiAdvancedSettings {
  my ($tab, @cats) = @_;
  my $last_cat = '';
  my @keys = ();

  # Build a list of the keys that will be displayed on this page.
  foreach my $k (sort {sortSettings($a, $b)} keys %settings) {
    foreach my $c (@cats) {
      if ($desc{$k}{cat} eq $c) {
        push(@keys, $k);
      }
    }
  }

  my $frame = $tab->Labelframe(-borderwidth => 0)->pack(qw/-side top -fill x -fill y/);
  foreach my $k (@keys) {
    if ($last_cat ne $desc{$k}{cat}) {
      $last_cat = $desc{$k}{cat};
      $frame->Label(-text => '', -borderwidth => 0)->pack(qw/-side top -fill x -pady 0 -padx 0/);
    }
    if ($k =~ m/^bool/) {
      guiRadioEntry($frame, $k);
    }
    else {
      guiEditEntry($frame, $k);
    }
  }
#  my $frame = $tab->Labelframe()->pack(qw/-side top -fill x/);
#  $frame->Label(-text => "Debug options (you probably don't want to use these)")->pack(-side=>'left', -padx=>5, -pady=>5);
#  $frame = $tab->Labelframe()->pack(qw/-side top -fill x/);
}

# Settings: Get a human readable list of the settings.
sub getSettings {
  my $text = "";
  $text .= "$username @ $url\n";
  foreach my $k (sort {sortSettings($a, $b)} keys %settings) {
    if ($settings{$k} eq $default_settings{$k}) {
      next;
    }
    my $label = $k;
    if (defined $desc{$k}{desc}) {
      $label = $desc{$k}{desc};
    }
    my $text_on = "on";
    if (defined $desc{$k}{on}) {
      $text_on = $desc{$k}{on};
    }
    my $text_off = "off";
    if (defined $desc{$k}{off}) {
      $text_off = $desc{$k}{off};
    }
    if ($k =~ m/^bool/) {
      if ($settings{$k}) {
        $text .= "$label = $text_on\n";
      }
      else {
        $text .= "$label = $text_off\n";
      }
    }
    else {
      $text .= "$label = $settings{$k}\n";
    }
  }
  return ($text);
}

sub guiEditEntry {
  my ($parent, $key) = @_;
  my $top = $parent->Labelframe(qw/-borderwidth 2/)->pack(qw/-side top -fill x/);
  my $label = $key;
  if (defined $desc{$key}{desc}) {
    $label = $desc{$key}{desc};
  }
  my $frame = $top->Labelframe(qw/-borderwidth 0/)->pack(qw/-side top -fill x/);
  my $edit_l = $frame->Label(-text => $label)->pack(-side=>'left', -padx=>5);
  if (defined $desc{$key}{example}) {
    $frame = $top->Labelframe(qw/-borderwidth 0/)->pack(qw/-side top -fill x/);
    $frame->Label(-text => "\t$desc{$key}{example}")->pack(-side=>'left', -padx=>5);
  }
  if (defined $desc{$key}{example2}) {
    $frame = $top->Labelframe(qw/-borderwidth 0/)->pack(qw/-side top -fill x/);
    $frame->Label(-text => "\t$desc{$key}{example2}")->pack(-side=>'left', -padx=>5);
  }
  $frame = $top->Labelframe(qw/-borderwidth 0/)->pack(qw/-side top -fill x/);
  my $edit_w;
  if ($desc{$key}{type} eq "num") {
    $edit_w = $frame->NumEntryPlain(-width => 40, -minvalue=>$desc{$key}{min}, -maxvalue=>$desc{$key}{max}, -value=>$settings{$key})->pack(-side=>'right');
  }
  elsif ($desc{$key}{type} eq "rgb") {
    $edit_w = $frame->HexEntryPlain(-width => 40, -minvalue=>0x0, -maxvalue=>0xFFFFFF,-value=>$settings{$key})->pack(-side=>'right');
  }
  else {
    $edit_w = $frame->Entry(-width => 40, -value=>$settings{$key})->pack(-side=>'right');
  }
  $settings_fields{$key} = $edit_w;
}

sub guiRadioEntry {
  my ($parent, $key) = @_;
  my $top = $parent->Labelframe(qw/-borderwidth 2/)->pack(qw/-side top -fill x/);
  my $label = $key;
  if (defined $desc{$key}{desc}) {
    $label = $desc{$key}{desc};
  }
  my $text_on = "on";
  if (defined $desc{$key}{on}) {
    $text_on = $desc{$key}{on};
  }
  my $text_off = "off";
  if (defined $desc{$key}{off}) {
    $text_off = $desc{$key}{off};
  }
  my $frame = $top->Labelframe(qw/-borderwidth 0/)->pack(qw/-side top -fill x/);
  my $edit_l = $frame->Label(-text => $label)->pack(-side=>'left', -padx=>5);
  $frame = $top->Labelframe(qw/-borderwidth 0/)->pack(qw/-side top -fill x/);
  my $edit_w_off = $frame->Radiobutton(-variable => \$settings{$key}, -value => 0, -text => $text_off)->pack(-side=>'right', -expand=>0);
  my $edit_w_on = $frame->Radiobutton(-variable => \$settings{$key}, -value => 1, -text => $text_on)->pack(-side=>'right', -expand=>0);
}

# GUI: Wrapper for when the RUN button is pressed.
sub doRun {
  my ($url_w, $username_w, $password_w) = @_;

  my $url_tmp = $url_w->get;
  my $username_tmp = $username_w->get;
  my $password_tmp = $password_w->get;

  addStatus("URL is '$url_tmp'");
  addStatus("username is '$username_tmp'");

  # Clean up user input because it can never be trusted.
  chomp($url_tmp);
  chomp($username_tmp);
  chomp($password_tmp);
  $url_tmp =~ s/\r//;
  $username_tmp =~ s/\r//;
  $password_tmp =~ s/\r//;
  $url_tmp =~ s/^\s+//;
  $username_tmp =~ s/^\s+//;
  $password_tmp =~ s/^\s+//;
  $url_tmp =~ s/\s+$//;
  $username_tmp =~ s/\s+$//;
  $password_tmp =~ s/\s+$//;

  # Get rid of trailing slash on url
  $url_tmp =~ s/\/$//g;

  # Test that users entered the fields
  if (0 == length($url_tmp)) {
    doError("Please enter the URL", qq{
The URL field is still empty.

Please enter the URL for your Wordpress.com blog.
});
    return;
  } elsif (0 == length($username_tmp)) {
    doError("Please enter your username", qq{
The username field is still empty.

Please enter your Wordpress username.
});
    return;
  } elsif (0 == length($password_tmp)) {
    doError("Please enter your password", qq{
The password field is still empty.

Please your Wordpress password.
});
    return;
  }

  # Have the settings changed? If so we need to recheck them.
  if ($url ne $url_tmp) {
    $ran_once = 0;
    $url = $url_tmp;
  }
  if ($username ne $username_tmp) {
    $ran_once = 0;
    $username = $username_tmp;
  }
  if ($password ne $password_tmp) {
    $ran_once = 0;
    $password = $password_tmp;
  }

  if (not $ran_once) {
    doRunFirstTime();
  } else {
    doRunAgain();
  }
}

# GUI: This is what happens when the RUN button is pressed the first time.
sub doRunFirstTime {
    # Log in
    if (testURL()) {
      if (login()) {
        generateTagCloud();
        $ran_once = 1;
      }
    }
}

# GUI: This is what happens when the RUN button is pressed AFTER the first time.
sub doRunAgain {
  generateTagCloud();
}


# GUI: This is what happens when the OPEN button is pressed.
sub doSettingsOpen {
  my ($file) = @_;
  if (-f $file) {
    if ($^O eq "MSWin32") {
      addStatus("Opening $file");
      system("notepad $file");
      addStatus("Closed $file");
    }
    else {
      if (defined $ENV{EDITOR}) {
        addStatus("Opening $file");
        system("$ENV{EDITOR} $file");
        addStatus("Closed $file");
      }
      else {
        doError("I do not know how to open a file", qq{
This program does not how to open a file on $^O

You can find the file it was trying to open at:
$file

(Will use the EDITOR environment variable if it is set)
});
        return;
      }
    }
  }
  else {
    doError("Missing $file", qq{
Could not find $file

Troubleshooting:

1. Has the file been created?
   Press the 'run' button to generate the file.

});
    return;
  }
}


# GUI: This is what happens when the CLOSE button is pressed.
sub doClose {
  addStatus("Goodbye");
  exit 0;
}

# GUI: Display an error message
sub doError {
  my ($title, $error) = @_;
  if (!$nogui) {
    $mw -> messageBox(
                    -icon=>"error",
                    -type=>"ok",
                    -title=>$title,
                    -message=>$error);
  }
  else {
    print "\n$title\n";
    print "$error\n";
  }
}

# GUI: Display an internal error message (these should never happen)
sub doInternalError {
  my ($error) = @_;
  doError("Internal Error", "engtech screwed up and you're seeing an error message you should never see.\n\n$error");
}


# Test login
sub login {
  my $login_url = $url . "/wp-login.php";
  addStatus("Connecting to $login_url");
  if ($login_url =~ m/(edublogs.org|learnerblogs.org|uniblogs.org|eslblogs.org)/) {
    $settings{bool_use_category_instead_of_tag} = 1;
  }

  # Reset cookies
  $mech = WWW::Mechanize->new(autocheck =>0, onerror => undef);
  $mech->get( $login_url );
  if(!$mech->success) {
    doError("Error Connecting to $login_url", qq{
Could not connect to $login_url.

Troubleshooting:

 1. Do you have internet access?
    Try connecting to wordpress.com with your web browser.

 2. Do you have a firewall running?
    Check that the firewall isn't blocking the program.

});
    return;
  }
  $mech->submit_form(
                     form_number => 1,
                     fields      => {
                                     log    => $username,
                                     pwd    => $password
                                    }
                    );
  my $failed = 1;
  if ($mech->success) {
    # FIXME: This will give false passes if they change the user screen.
    if ($mech->content !~ m/login_error/) {
      $failed = 0;
    }
  }
  if ($failed) {
    addStatus("-> Login failed");
    doError("Error Logging In", qq{
Could not log in to http://wordpress.com with your username and password.

 1. Do you have internet access?
    Try connecting with your web browser.

 2. Did you use the correct username and password?
    Open your web browser and try logging in.

 3. Did wordpress.com change their login form?
    Go to http://engtech.wordpress.com and get a new version of this program.
});
    return 0;
  }
  addStatus("-> Login success");
  return 1;
}

# Test website url
sub testURL {
  addStatus("Testing $url");
  $mech->get( $url );
  if(!$mech->success) {
    doError("Error Connecting to Blog", qq{
Could not connect to '$url'

Troubleshooting:

 1. Do you have internet access?
    Try connecting with your web browser.

 2. Do you have a firewall running?
    Check that the firewall isn't blocking the program.

 3. Did you use the correct URL?
    It should something like 'http://blog.wordpress.com'
});
    return 0;
  }
  addStatus("-> Can connect to blog");
  return 1;
}

# Save the settings to a configuration file
sub saveConfig {
  foreach my $k (sort keys %settings_fields) {
    $settings{$k} = $settings_fields{$k}->get;
  }
  # Prevent bad input. If the users frig with these settings in a bad way, then
  # normalize them to prevent min/max, divide by zero errors.
  if ($settings{font__largest_size_css_px} < $settings{font__smallest_size_css_px}) {
    my $tmp = $settings{font__largest_size_css_px};
    $settings{font__largest_size_css_px} = $settings{font__smallest_size_css_px};
    $settings{font__smallest_size_css_px} = $tmp;
  }
  if ($settings{font__largest_size_css_px} == $settings{font__smallest_size_css_px}) {
    $settings{font__largest_size_css_px} += 1;
  }
  if ($settings{font__largest_size_font} < $settings{font__smallest_size_font}) {
    my $tmp = $settings{font__largest_size_font};
    $settings{font__largest_size_font} = $settings{font__smallest_size_font};
    $settings{font__smallest_size_font} = $tmp;
  }
  if ($settings{font__largest_size_font} == $settings{font__smallest_size_font}) {
    $settings{font__largest_size_font} += 1;
  }

  # FIXME: I should use contants instead of text for the settings keys to avoid
  # typos.
  # But until it's fixed just make sure no weird settings were created.
  foreach my $k (keys %settings) {
    if (not defined $default_settings{$k}) {
      doInternalError("Somehow the setting '$k' was created?");
    }
  }
  my $fields = {
                'username'=>$username,
                'password'=>rot13($password),
                'url'=>$url,
                'settings'=>\%settings
               };
  DumpFile(CONFIG_FILE, $fields);
  addStatus("Saved configuration");
  my $s = getSettings();
  foreach my $line (split(/\n/, $s)) {
    print $log "\t$line\n";
  }
}

# Load the settings from the configuration file
sub loadConfig {
  addStatus("Loading configuration");
  # Copy default settings.
  foreach my $k (keys %default_settings) {
    $settings{$k} = $default_settings{$k};
  }
  if (-f CONFIG_FILE) {
    my $fields = LoadFile(CONFIG_FILE);
    $username = $fields->{username};
    $password = rot13($fields->{password});
    $url = $fields->{url};
    my %tmp = %{$fields->{settings}};
    foreach my $k (keys %tmp) {
      # Lose any settings that the program doesn't understand.
      if (defined $default_settings{$k}) {
        $settings{$k} = $tmp{$k};
      }
    }
  }
  if (! -f CSV_FILE) {
    open (OUT, ">".CSV_FILE) || doError("Could not create file", $@);
    print OUT qq{exclude; category to exclude from final list}."\n";
    print OUT qq{rename; category to changed the name of; new category name}."\n";
    close OUT;
  }
  else {
     my $cvs = ReadData(CSV_FILE, sep => ";");
     my $maxrow = $cvs->[1]{maxrow};
     for (my $i=1; $i<$maxrow; $i++) {
        my $type = $cvs->[1]{cell}[1][$i];
        my $cat = $cvs->[1]{cell}[2][$i];
        my $arg = $cvs->[1]{cell}[3][$i];
        if (not defined $type) {
           next;
        }
        if (not defined $arg) {
           $arg = "";
        }
        $type =~ s/^\s+//;
        $cat =~ s/^\s+//;
        $arg =~ s/^\s+//;
        $type =~ s/\s+$//;
        $cat =~ s/\s+$//;
        $arg =~ s/\s+$//;

        if ($type eq "exclude") {
           $exclude{$cat} = 1;
        }
        elsif ($type eq "rename") {
           $rename{$cat} = $arg;
        }
        elsif ($type eq "include") {
           # do nothing
        }
        else {
           addStatus("tagcloud.dbg did not understand line: $type;$cat;$arg");
        }
     }
  }
}

sub generateCSV {
   open (OUT, ">".CSV_FILE) || doError("Could not create file", $@);
   print OUT qq{include; doesn't do anything -- used as a placeholder}."\n";
   print OUT qq{exclude; category to exclude from final list}."\n";
   print OUT qq{rename; category to changed the name of; new category name}."\n";

   foreach my $cat (sort {lc($a) cmp lc($b)}keys %posts_hash) {
      $cat =~ s/^\s+//;
      $cat =~ s/\s+$//;
      if (defined $exclude{$cat}) {
         print OUT "exclude;".$cat."\n";
      }
      elsif (defined $rename{$cat}) {
         print OUT "rename;".$cat.";".$rename{$cat}."\n";
      }
      else {
         print OUT "include;".$cat."\n";
      }
   }
   close OUT;
}

# Successfully ran
sub generateSuccess {
  my $title = "Tag Cloud Generated";
  my $dir = getcwd;
  addStatus("Generated tag cloud");
  my $message = qq{
Tag Cloud Generated

You can find the files 'tagcloud.html' and 'tagcloud_css.html'
in this directory:

   $dir

tagcloud.html - Uses the  tag for tag cloud sizes.
tagcloud_css.html - Uses CSS for tag cloud sizes.

Now you will have to cut-and-paste the contents of one of
those files somewhere on your blog.
};
  if (!$nogui) {
    $mw -> messageBox(
                    -icon=>"info",
                    -type=>"ok",
                    -title=>$title,
                    -message=>$message);
  }
  else {
    print "\n$title\n";
    print "$message\n";
  }
}


sub generateTagCloud {
  saveConfig();
  addStatus("Getting categories");
  my $cat_url = "$url/wp-admin/categories.php";
  $mech->get( $cat_url );
  if(!$mech->success) {
    doError("Error Connecting to Blog Categories", qq{
Could not connect to '$cat_url'

Troubleshooting:

 1. Did you use the correct URL?
    You used '$url'
    It should something like 'http://blog.wordpress.com'

 2. Did wordpress.com change the their category admin panel?
    Go to http://engtech.wordpress.com and get a new version of this program.
});
    return 0;
  }
  addStatus("-> Success");
  my $html = $mech->content;
  parseHTML($html);
  printCloud();
  generateCSV();
  printCategories();
  generateSuccess();
}

sub parseHTML {
  my ($html) = @_;

  addStatus("Parsing categories");
  # Clean up
  $html =~ s/[\r\n]*//g;
  $html =~ s//<\/tr>\n/ig;

  if ($settings{bool_debug_mode}) {
    open (OUT, ">tagcloud.dbg") || doError("Could not create file", $@);
    print OUT "\n\n\n\n\n##############################################################\n";
    print OUT "# Columns\n";
    print OUT "##############################################################\n";
  }

  # May have to change these values if the interface changes
  my $col_name = 8;
  my $col_posts = 16;
  my @lines = split(/\n/, $html);
  my $first = 1;

  my @names_array = ();
  foreach my $line (@lines) {
    if ($line !~ m/^/) {
      last;
    }
    # Split based on HTML tag.
    my @cols = split(/<(\/|)t.*?>/, $line);
    if ($first) {
      $first = 0;

      # Fix that only works for english blogs
      for(my $i=0; $i<=$#cols; $i++) {
        # Find the name row
        if ($cols[$i] eq "Name") {
          $col_name = $i;
        }
        if ($cols[$i] eq "Posts") {
          $col_posts = $i;
        }
      }

      if ($settings{bool_debug_mode}) {
        if (($col_name != 8) || ($col_posts != 16)) {
          doError("Contact //engtech", qq{
Internal error.

The categories form has changed and this program should be updated.
});
        }

        print OUT "$line\n";
        print OUT Dumper(@cols);
        print OUT "\n";
        print OUT "col_name = $col_name\n";
        print OUT "col_posts = $col_posts\n";
      }
    }
    else {
      my $name = $cols[$col_name];
      if ($name eq "") {
        next;
      }
      my $posts = 0;
      $posts = $cols[$col_posts];
      if ((not defined $posts) || ($posts eq "")) {
        next;
      }
      # Remove any tags from the post
      $posts =~ s/<.*?>//g;
      if ($settings{bool_debug_mode}) {
        print OUT "$name: $line\n";
        print OUT Dumper(@cols) . "\n";
        print OUT "$name has $posts posts\n";
      }
      # Clean up the hierarchy
      $name =~ s/—\s*/\-/g;
      $name =~ s/—\s*/\-/g;
      $name =~ s/^\s+//;
      $name =~ s/\s+$//;
      $name = decode_entities($name);
      if ($name =~ m/^([-]*)(.*?)$/) {
        my ($hierarchy_string, $tag) = ($1, $2);
        $posts_hash{$tag} = $posts;
        push(@names_array, $name);
      }
      else {
        print "Could not display hierarchy string for $name\n";
      }
    }
  }

  my @parents = @_;
  for (my $i=0; $i<100; $i++) {
     push(@parents, "");
  }
  foreach my $name (@names_array) {
     if ($name =~ m/^([-]*)(.*?)$/) {
        my ($hierarchy_string, $tag) = ($1, $2);
        my $hierarchy = length($hierarchy_string);
        $parents[$hierarchy] = $tag;
        if ($hierarchy > 0) {
           my $parent_tag = $parents[$hierarchy-1];
           $parents_hash{$tag} = $parent_tag;
           if ($settings{bool_use_hierarchy}) {
              $posts_hash{$parent_tag} += $posts_hash{$tag};
           }
        }
     }
  }
  my $levels = sprintf("%d", $settings{font__largest_size_css_px} - $settings{font__smallest_size_css_px});
  if ($settings{font__step_size} > 0) {
    $levels = $settings{font__step_size};
  }
  print $log "... levels = $levels\n";
  $cloud = HTML::TagCloud->new(levels=>$levels);
  my $num_categories = 0;
  foreach my $name (sort {lc($a) cmp lc($b)}keys %posts_hash) {
    $num_categories++;
    my $posts = $posts_hash{$name};
    if (($name ne "") && ($posts != 0)) {
      my $tag_url = makeUrl($name);
      if (not defined $exclude{$name}) {
        $cloud->add(tagTransform($name), $tag_url, $posts);
      }
      $posts{makeKey($tag_url)} = $posts;
    }
  }
  print $log "... categories = $num_categories\n";

  if ($settings{bool_debug_mode}) {
    print OUT "\n\n\n\n\n##############################################################\n";
    print OUT "# Exclude List\n";
    print OUT "##############################################################\n";
    print OUT Dumper(%exclude);

    print OUT "\n\n\n\n\n##############################################################\n";
    print OUT "# Rename List\n";
    print OUT "##############################################################\n";
    print OUT Dumper(%rename);

    print OUT "\n\n\n\n\n##############################################################\n";
    print OUT "# Posts Hash\n";
    print OUT "##############################################################\n";
    print OUT Dumper(%posts_hash);

    print OUT "\n\n\n\n\n##############################################################\n";
    print OUT "# Categories HTML from Wordpress.com\n";
    print OUT "##############################################################\n";
    print OUT $html;
  }
  close(OUT);
  addStatus("-> Success");
}


sub makeTag {
  my ($tag) = @_;
  my $copy = $tag;
#   
#ÝÜÛÚÙØÖÕÔÓÒÑ ÐÏÎÍÌË ÊÉÈÇ ÆÅÄÃ
  $copy =~ s/Ý/Y/g;
  $copy =~ s/(Ü|Û|Ú|Ù)/U/g;
  $copy =~ s/Ø/%c3%98/g;
  $copy =~ s/(Ö|Õ|Ô|Ó|Ò)/O/g;
  $copy =~ s/Ñ/N/g;
  $copy =~ s/Ð/%c3%90/g;
  $copy =~ s/(Ï|Î|Í|Ì)/I/g;
  $copy =~ s/(Ë|Ê|É|È)/E/g;
  $copy =~ s/Ç/C/g;
  $copy =~ s/Æ/%c3%86/g;
  $copy =~ s/(Å|Ä|Ã)/A/g;

#http://wptheme.wordpress.com/tag/yuuuu%c3%98ooooon-%c3%90iiiie-eeec-%c3%86aaa/
#http://wptheme.wordpress.com/tag/yuuuu%c3%98ooooon-%c3%90iiiie-eeec-%c3%86aaa

#olnea "hi"    
  $copy =~ s/(ö|õ|ô|ó|ò)/o/g;
  $copy =~ s/(í|ï|î)/i/g;
  $copy =~ s/(é)/e/g;
  $copy =~ s/(á|ä)/a/g;
  $copy =~ s/(ÿ|ý)/y/g;
  $copy =~ s/(ü|û|ú|ù)/u/g;
  $copy =~ s/ñ/n/g;

#http://wptheme.wordpress.com/tag/oieoloanea-hi-yyuuuu-ooooo-nii/
#http://wptheme.wordpress.com/tag/oieoloanea-hi-yyuuuu-ooooo-
#http://infostudies.blogsome.com/category/vitost-kohti
#http://infostudies.blogsome.com/category/vaitosta-kohti/

# icanhascheezeburger, http://wordpress.com/tag/%e2%88%91p/
  $copy =~ s/∑/%e2%88%91/g;

  $copy = lc($copy);
  $copy =~ s/[^a-z\d\s%]//g;
  $copy =~ s/\s+/-/g;
  return ($copy);
}

sub makeUrl {
  my ($tag) = @_;
  my $url_keyword = "tag";
  if ($settings{bool_use_category_instead_of_tag}) {
    $url_keyword = "category";
  }
  if (0 == $settings{'bool_minimize_file_size'}) {
     return("$url/$url_keyword/".makeTag($tag) );
  }
  else {
     return("/$url_keyword/".makeTag($tag) );
  }
}

sub makeKey {
  my ($url) = @_;
  my $key = $url;
  $key =~ s/^.*?\/(category|tag)\///;
  return($key);
}

sub tagTransform {
  my ($tag) = @_;
  if (defined $rename{$tag}) {
    return ($rename{$tag});
  }
  return($tag);
}

sub buildHeader {
   my $header = "";
  if ($settings{bool_dump_settings_to_output}) {
    my $s = getSettings();
    $header .= "
\n"; $header .= "\tversion = ".BUILD."
\n"; foreach my $line (split(/\n/, $s)) { $line =~ s/= (.*?)$/= $1<\/strong>/; $header .= "\t$line
\n"; } $header .= "
\n\n"; } return $header; } sub printCloud { my $header = buildHeader(); my $author = qq{

Created by Wordpress.com Tag Cloud Generator by Internet Duct Tape

}; addStatus("Writing tagcloud_css.html"); my $diff_font = sprintf("%d", $settings{font__largest_size_font} - $settings{font__smallest_size_font}); my $diff_css = sprintf("%d", $settings{font__largest_size_css_px} - $settings{font__smallest_size_css_px}); my $levels = sprintf("%d", $settings{font__largest_size_css_px} - $settings{font__smallest_size_css_px}); if ($settings{font__step_size} > 0) { $levels = $settings{font__step_size}; } my @tags = cleanCloud($settings{max_tags}); my @color_sm = split(//, $settings{color__smallest_color}); my @color_lg = split(//, $settings{color__largest_color}); # Make sure there are at least 6 entries for (my $i=0; $i<6; $i++) { push(@color_sm, 0); push(@color_lg, 0); } #print $log "color_sm=".Dumper(@color_sm)."\n"; #print $log "color_lg=".Dumper(@color_lg)."\n"; my $red_sm = int(hex($color_sm[0].$color_sm[1])); my $green_sm = int(hex($color_sm[2].$color_sm[3])); my $blue_sm = int(hex($color_sm[4].$color_sm[5])); my $red_lg = int(hex($color_lg[0].$color_lg[1])); my $green_lg = int(hex($color_lg[2].$color_lg[3])); my $blue_lg = int(hex($color_lg[4].$color_lg[5])); my $red_diff = $red_lg - $red_sm; my $green_diff = $green_lg - $green_sm; my $blue_diff = $blue_lg - $blue_sm; print $log "... ".$settings{color__smallest_color} . " = $red_sm,$green_sm,$blue_sm\n"; print $log "... ".$settings{color__largest_color} . " = $red_lg,$green_lg,$blue_lg\n"; #################################################################### # GENERATE THE CODE FOR CSS USERS open (OUT, ">tagcloud_css.html") || doError("Could not create file", $@); print OUT qq{ }; print OUT $header; print OUT qq{ }; print OUT "

"; print OUT "\n"; foreach my $a (@tags) { my ($tag, $size, $link, $count) = @{$a}; my $count_str = ""; if ($settings{bool_display_count}) { $count_str = " ($count)"; } $link =~ s/https?:\/\/.*?\//\//; # make relative links my $rel_title = ""; if (0 == $settings{'bool_minimize_file_size'}) { $rel_title = " rel=\"tag\" title=\"$tag - $count posts\""; } printf OUT "%s$count_str ", $size + $offset, $link, $tag; } print OUT ""; print OUT "

\n"; print OUT "$author\n"; print OUT "\n"; close(OUT); #################################################################### # GENERATE THE CODE FOR NON-CSS USERS addStatus("Writing tagcloud.html"); open (OUT, ">tagcloud.html") || doError("Could not create file", $@); print OUT $header; print OUT qq{ }; print OUT "

"; foreach my $a (@tags) { my ($tag, $size, $link, $count) = @{$a}; my $new_size = sprintf("%d", (($size / $levels) * $diff_font) + $settings{font__smallest_size_font}); #print $log "count $count => $new_size = (($size / $levels) * $diff_font)=".(($size / $levels) * $diff_font)." + ".$settings{font__smallest_size_font}."\n"; my $font_str = ""; my $count_str = ""; my $color_str = ""; if ($settings{bool_display_count}) { $count_str = " ($count)"; } if ($settings{bool_use_font_sizes}) { $font_str = "size=\"$new_size\""; } if ($settings{bool_use_colors}) { $color_str = "color=\"".$colors[$size]."\""; } my $rel_title = ""; if (0 == $settings{'bool_minimize_file_size'}) { $rel_title = " rel=\"tag\" title=\"$tag - $count posts\""; } printf OUT "$tag$count_str   ", $link; } print OUT "

\n"; print OUT "$author\n"; print OUT "\n"; close(OUT); #################################################################### # CHECK ALL OF THE CATEGORY LINKS if ($settings{bool_check_categories}) { addStatus("Writing tagcloud_report.html"); open (OUT, ">tagcloud_report.html") || doError("Could not create file", $@); print OUT "\n"; my $i = 1; foreach my $a (@tags) { my ($tag, $size, $link, $count) = @{$a}; if (($i % 5) == 0) { addStatus(sprintf(" %d/%d", $i, scalar(@tags))); } my $rel_title = ""; if (0 == $settings{'bool_minimize_file_size'}) { $rel_title = " rel=\"tag\" title=\"$tag - $count posts\""; } printf OUT "\n", $link, $size; $mech->get($link); if ($mech->success()) { if ($mech->content =~ m/Not found/i) { print OUT "\n"; } else { print OUT "\n"; } } else { print OUT "\n"; } $i++; } print OUT "
$tagBAD LINK
OK
BAD LINK
\n"; close(OUT); } } sub printCategories { my $header = buildHeader(); # First build up a data structure that accurately represents the category hierarchy. # At each point in the hierarchy, skip over the excluded categories. # If a parent category is excluded then all of the children categories will be excluded, # this is different than how the tag cloud is built. my %struct = (); my $max_depth = 0; # Initialize structure my $cat_index = 0; foreach my $p (keys %posts_hash) { if (defined $exclude{$p}) { next; } my @children = (); my %allchildren = (); my @siblings = (); my %r = ('parent'=>$parents_hash{$p}, 'depth'=>0, 'siblings'=>\@siblings, 'children'=>\@children, 'allchildren'=>\%allchildren, 'index'=>$cat_index); $struct{$p} = \%r; $cat_index++; } # Build a list of children, link children to parent foreach my $p (sort {lc($a) cmp lc($b)} keys %posts_hash) { if (defined $exclude{$p}) { next; } if (defined $parents_hash{$p}) { if (defined $exclude{$parents_hash{$p}}) { next; } push( @{ $struct{$parents_hash{$p}} {children} }, $p); } } # Build a list of siblings foreach my $p (sort {lc($a) cmp lc($b)} keys %posts_hash) { if (defined $exclude{$p}) { next; } if (defined $parents_hash{$p}) { if (defined $exclude{$parents_hash{$p}}) { next; } $struct{$p}{siblings} = $struct{$parents_hash{$p}} {children}; } } # Calculate the depth of each child, give each parent a list of ALL children underneath foreach my $p (keys %posts_hash) { if (defined $exclude{$p}) { next; } my $search = $p; while (defined $parents_hash{$search}) { if (defined $exclude{$parents_hash{$search}}) { last; } $struct{$p}{depth} += 1; $struct{$parents_hash{$search}}{allchildren}{$p} = 1; $search = $parents_hash{$search}; } } print Dumper(%struct); #################################################################### # GENERATE THE CSS CODE addStatus("Writing categories_css.html"); open (OUT, ">categories_css.html") || doError("Could not create file", $@); print OUT qq{ }; print OUT $header; print OUT qq{ }; print OUT "
    \n"; foreach my $cat (sort {lc($a) cmp lc($b)} keys %struct) { if (not defined $struct{$cat}{parent}) { print OUT getLI($cat, \%struct); } } print OUT "
\n"; print OUT "\n"; close(OUT); } sub getLI { my ($cat, $ref) = @_; my $class = ""; # Class with the tag name if you want to target something exactly $class .= "tcg-".makeTag($cat); # Class with depth if you want to do it by depth of your category list $class .= " tcg-d".$ref->{$cat}{depth}; # Class is selected $class .= " tcg-s".$ref->{$cat}{index}; foreach my $child (@{$ref->{$cat}{children}}) { # Class is a parent of the current class $class .= " tcg-p".$ref->{$child}{index}; } foreach my $sibling (@{$ref->{$cat}{siblings}}) { if ($sibling eq $cat) { next; } # Class is a parent of the current class $class .= " tcg-p".$ref->{$sibling}{index}; } my $output = "
  • $cat"; if (scalar @{$ref->{$cat}{children}} > 0) { $output .= "\n
      "; foreach my $child (@{$ref->{$cat}{children}}) { $output .= getLI($child, $ref); } $output .= "
    "; } $output .= "
  • \n"; return $output; } sub cleanCloud { my ($max) = @_; my $html; if ($max == 0) { $html = $cloud->html; # open RAW, ">raw.html" || doError("Could not create file", $@); # print RAW $cloud->html_and_css; # close RAW; } else { $html = $cloud->html($max); } $html =~ s/