###############################################################
# Technorati Favorite Your Fans
###############################################################
#
# This is a program that connects to the Technorati.com service,
# finds everyone who has favorited your blog and automatically
# favorites them back.
#
# But Why Use This?
#
# The "Technorati Favorites" feature was collecting a lot of
# dust until recently when more and more people started exchanging
# favorites. "Technorati Favorites" is a pretty cool feature because
# it lets you search within your favorites and view the latest
# posts from your favorites like an RSS feed. It's a good way
# to track blogs you don't want to subscribe to the RSS feeds for.
#
# If someone has gone to the trouble of adding you to their
# favorites, this program will return the favor, without requiring
# you to go through all of the people who have favorited you and
# trying to find the ones you haven't favorites back. This is
# something people already do, and this program is intended to
# save them time by automating the process.
#
# How It Works
#
# It only favorites a blog once. If you log into the Technorati
# website and delete a blog from your favorites they will not
# be added again. I strongly suggest checking the latest posts
# from your favorites and deleting any blogs that you don't like.
# If any of the blogs look like spam you should report them to
# Technorati.
#
# It doesn't always grab everyone who favorited you on the first
# try because of issues with Technorati. Even if you look at the
# Favorited-By list on the web you'll see duplicates and missing
# names.
#
# The first time you use this program it will add my blog to your
# list of favorites, feel free to delete it and it won't be added
# again.
#
# Get more information here:
#  http://internetducttape.com/tools/technorati-favorite-your-fans/
#
# 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.
#
###############################################################
#
# NOTES
#
# It reuses all of the GUI code I built for Tag Cloud Generator,
# which is kind of overkill for this application because it
# doesn't have any settings.
#
###############################################################
#
# TESTING NOTES
#
# - check for updates with no updates
# - no username
# - no password
# - bad username
# - user with no claimed blogs
# - proper operation
# - skipping over "already favorited" blogs
#
###############################################################
#
# Tried using WebService::Technorati but it is a piece of junk that
# fails for no reason on perfectly good API calls (when tried manually).
# Interpreted the API calls by hand for a while but then they 
# started breaking as well for no reason.
#

###############################################################
# MODULE IMPORTS
###############################################################

# 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 Cwd;
use Data::Dumper;
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 NAME_SHORT => "Technorati Favorite Your Fans";
use constant NAME_LONG => "Technorati Favorite Your Fans";
use constant RELEASE_FILE => "release_notes.txt";
use constant RELEASE_URL => "http://internetducttape.com/tools/technorati-favorite-your-fans/release-notes/";
use constant CONFIG_FILE => "technoratiff.cfg";
use constant LOG_FILE => "technoratiff.log";
use constant BUILD => "07/05/31";

# Hash Keys
use constant FAVORITED_ALREADY => 'favorited_already';
use constant YOUR_BLOGS => 'your_blogs';

###############################################################
# GLOBALS - Simple
###############################################################

my $mech = WWW::Mechanize->new(autocheck =>0, onerror => undef);
my $yaml = new YAML;
my $mw;
my $dir = "";
my $nogui = 0;
my $status;
my $ran_once = 0;
my $very_first_time = 1;
my $log;
my $create_notes = 0;
my $username = "";
my $password = "";

###############################################################
# GLOBALS - Data Structures
###############################################################
# Configuration Settings
my @storage = ();
my %settings = ();

my %default_settings = (
                        'favorited_already' => \@storage,
                       );

my %desc = (
            'favorited_already'=>{
				  'cat'=>'data','order'=>'0','type'=>'array',
				  'desc'=>'List of Technorati usernames that have already been favorited'},
           );

my %release_notes = (
		     "07/04/26"=>{
				  'bugs'=>'Technorati changed and this version no longer works.', 
				  'notes'=>qq{
First version.
}},
		     "07/05/08"=>{
				  'bugs'=>'Technorati changed and this version no longer works.',
				  'notes'=>qq{
Technorati update.
}},
		     "07/05/23"=>{'bugs'=>'Technorati changed and this version no longer works.',
				  'notes'=>qq{
Added number of blogs added to final popup.
Major Technorati update -- changes login form.
}},
		     "07/05/31"=>{'bugs'=>'none',
				  'notes'=>qq{
Technorati update.
}}

                    );

my %settings_fields = ();

###############################################################
# MAIN PROGRAM
###############################################################

# Parse command line options.
GetOptions ("dir=s" => \$dir, "nogui" => \$nogui, "notes"=>\$create_notes);
# --nogui   run without a gui, useful for cron/scheduled jobs
# --notes   dump release notes as a text file so
# --dir     store config information and output files to this directory

#shortTest();

# Call the main program
main();

sub main {
  devChecks();
  handleCmdLineArgs();
  loadConfig();
  if (!$nogui) {
    guiSettings();
    MainLoop;
  } else {
    doRunFirstTime();
  }
  if ($log) {
    close($log);
  }
  exit 0;
}

###############################################################
# FUNCTION TESTING
###############################################################

sub shortTest {
  $nogui = 1;
  handleCmdLineArgs();
}

###############################################################
# ARGUMENT PARSING AND DATA STRUCTURE CHECKS
###############################################################

# 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";
  }
}

# Test command line arguments
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(LOG_FILE, "w") || doError("Cannot open ".LOG_FILE, "Could not write to ".LOG_FILE);
  if ($dir ne "") {
    print $log "Changed directory to $dir\n";
  }
  if ($create_notes) {
    createReleaseNotes();
    print "Done.\n";
    exit 0;
  }
}

# Connect to //engtech and see if there is a new version
sub checkVersion {
  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/<pre>/) {
      $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 = NAME_SHORT." $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/\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");
}

# Dump the release notes structure to a file
sub createReleaseNotes {
  print "Creating release notes.\n";
  my $fields = \%release_notes;
  DumpFile(RELEASE_FILE, $fields);
}

###############################################################
# SUBROUTINES - GUI
###############################################################

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

sub addLog {
  my ($add) = @_;
  print $log "$add\n";
}

# 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 => +NAME_LONG, -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/);
  $frame = $frame_settings->Labelframe()->pack(qw/-side top -fill x/);
  my $username_l = $frame->Label(-text => 'Technorati 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 => 'Technorati 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($username_w, $password_w)} )
    ->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 3:")->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'));

  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\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);
}

# GUI: Create an edit box setting
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;
}

# GUI: Create a radio box setting
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 ($username_w, $password_w) = @_;

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

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

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

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

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

Please your Technorati password.
});
    return;
  }

  # Have the settings changed? If so we need to recheck them.
  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 (login()) {
    generateFavorites();
    $ran_once = 1;
  }
}

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

# GUI: This is what happens when the CLOSE button is pressed.
sub doClose {
  saveConfig();
  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, $ln) = @_;
  doError("Internal Error", "engtech screwed up and you're seeing an error message you should never see.\nError is from line $ln in version: ".BUILD."\n$error");
}


###############################################################
# SUBROUTINES - Functionality
###############################################################

# Test login
sub login {
  my $login_url = "http://technorati.com";
  addStatus("Connecting to $login_url");

  # Reset cookies
  $mech = WWW::Mechanize->new(autocheck =>0, onerror => undef);
  $mech->get( $login_url );
  if (!$mech->success) {
    addStatus("-> Login failed");
    doError("Error Logging In to Technorati", qq{
Could not connect to $login_url with your username and password.

Troubleshooting:

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

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

 3. Do you have the correct username/password?
    Try logging in to technorati.com with your web browser.

 4. Did Technorati change their page structure?
    Click on the "Check for Updates" button to see if there
    is a new version of this program available.
});
    return 0;
  }
  # 2007/05/23 - Technorati changed the order of this form.
  $mech->submit_form(
		     form_number => 2,
		     fields      => {
				     username    => $username,
				     password    => $password,
				    }
		    );
  my $failed = 1;
  if ($mech->success) {
    # FIXME: This will give false passes if they change the user screen.
    if ($mech->content !~ m/signinform/) {
      $failed = 0;
    }
  }
  if ($failed) {
    addStatus("-> Login failed");
    doError("Error Logging In to Technorati", qq{
Could not log in to Technorati.

Troubleshooting:

 1. Do you have the correct username/password?
    Try logging in to technorati.com with your web browser.

 2. Did Technorati change their page structure?
    Click on the "Check for Updates" button to see if there
    is a new version of this program available.
});
    return 0;
  }
  addStatus("-> Login success");
  return 1;
}


# Save the settings to a configuration file
sub saveConfig {
  foreach my $k (sort keys %settings_fields) {
    $settings{$k} = $settings_fields{$k}->get;
  }
  # 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?", __LINE__);
    }
  }
  my $fields = {
		'username'=>$username,
		'password'=>rot13($password),
		'settings'=>\%settings
	       };
  DumpFile(CONFIG_FILE, $fields);
  addStatus("Saved configuration");
#  my $s = getSettings();
#  foreach my $line (split(/\n/, $s)) {
#    print $log "\t$line\n";
#  }
}

# Poor man's password encryption
sub rot13 {
  my ($text) = @_;
  $text =~ tr/[a-zA-Z]/[n-za-mN-ZA-M]/;
  return($text);
}

# 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});
    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 (defined $settings{+FAVORITED_ALREADY}) {
    addStatus("-> Loaded ".scalar @{$settings{+FAVORITED_ALREADY}}. " Technorati users already favorited.");
  }
}

# Successfully ran
sub generateSuccess {
  my ($added_blogs) = @_;
  my $title = "Favorited Your Technorati Fans";
  my $dir = getcwd;
  addStatus("-> Finished favoriting your Technorati fans");
  my $message = $title.qq{

Added another $added_blogs to your Technorati Favorites.

Everyone who has favorited you on Technorati has been added
as one of your favorites!

You should go to http://technorati.com/faves and browse through
the latest posts in your favorite blogs. If you do not like the
blog then clicking on the red X to remove it permanently.

It is a good idea to check your Technorati faves and remove
spammers/adult content/hateful content.
};
  if (!$nogui) {
    $mw -> messageBox(
		      -icon=>"info",
		      -type=>"ok",
		      -title=>$title,
		      -message=>$message);
  } else {
    print "\n$title\n";
    print "$message\n";
  }
}

# Main program routine
sub generateFavorites {
  saveConfig();
  my ($error, @blogs) = findBlogs($username);
  if (($error) || (0 == (scalar @blogs))) {
    doError("Could not find your blogs", qq{
Could not find your list of blogs on Technorati.
http://technorati.com/profile/$username

Troubleshooting:

 1. Did Technorati change their page structure?
    Click on the "Check for Updates" button to see if there
    is a new version of this program available.
});
    return;
  }
  my %skip_list = ();
  findAlreadyFaved(\%skip_list);
  my $added_blogs = 0;
  foreach my $b (@blogs) {
    my @favs = findFavs($b);
    $added_blogs += addFavs($b, \@favs, \%skip_list);
  }
  addStatus("\nDone.");
  generateSuccess($added_blogs);
}

sub findAlreadyFaved {
  my ($skip_ref) = @_;
  addStatus("Getting list of blogs you have already favorited (this can take a while)");
  my $fav_url = "http://technorati.com/faves/$username?show=blogs";
  $mech->get( $fav_url );
  if (!$mech->success) {
    addStatus("-> could not get already fav'd for '$username'");
    addLog("could not connected to:\n".$fav_url);
  }
  my $count = 0;
  foreach my $link ($mech->links()) {
    if ($link->url() =~ m/\/blogs\/http%3A%2F%2F(.*?)$/) {
      $skip_ref->{"http://$1"} = 1;
      $count++;
    }
  }
  addStatus("-> You already have $count favorites");
}


# Find all of the blogs belonging to a username. Not using the Technorati API
# because it breaks down *all* the time.
sub findBlogs {
  my ($t_user) = @_;
  my @result = ();
  addStatus("Finding blogs for $t_user");
  my $profile_url = "http://technorati.com/people/technorati/$t_user";
  $mech->get( $profile_url );
  if (!$mech->success) {
    addStatus("-> could not get blogs for '$t_user");
    addLog("could not connected to:\n".$profile_url);
    return(1, @result);
  }
#  foreach my $link ($mech->links()) {
#    if ($link->url() =~ m/\/blogs\/(http%3A%2F%2F|)(.*?)$/) {
#      push(@result, "http://$2");
#    }
#  }
  # Need to parse the page because they got rid of the ?fans argument.
  my @list = split(/<\/li>/, $mech->content);
  foreach (@list) {
    if (m/li class="blog">(.*)/is) {
      my $blog = $1;
#      print "\n\ntrying to match on:\n$blog\n";
      if ($blog =~ m/<a href="(.*?)" class="url">/) {
	push(@result, $1);
      }
    }
  }
  addStatus(" -> found ".scalar @result." blogs");
  if (0 == scalar @result) {
    addStatus($profile_url);
  }
  return(0, @result);
}

# Technorati doesn't have an API call for Favorites, so
# we have to do it by brute force scraping.
sub findFavs {
  my ($blog_url) = @_;
  my $fav_url = "http://technorati.com/blogs/${blog_url}?show=faves";
  $mech->get( $fav_url );
  my $fav_count = 0;
  if ($mech->content =~ m/(\d+) fans/) {
    addStatus("Favorited by $1 fans: $blog_url");
    $fav_count = int($1 / 10);
  }
  my @result = ();
  for (my $i=0; $i <= $fav_count; $i++) {
    foreach my $link ($mech->links()) {
      if ($link->url() =~ m/\/people\/technorati\/(.*?)$/) {
	#         print "matched ".$link->url()."\n";
	push(@result, $1);
      }
    }
    #      print "debug: page $i gives ".scalar @result." favorited-bys\n";
    $mech->get ( $fav_url."&fans&page=".($i + 1) );
  }
  # The results may have a lot of dupes. This is a normal
  # issue that you'd see even when you view the Technorati
  # favorites using a web browser.
  return(@result);
}

# Transform the Technorati favorited-by into a list of real
# usernames to favorite.
sub usersFromFavoritedBy {
  my ($favs_ref) = @_;
  my %to_check = ('engtech'=>1);
  foreach my $f (@{$favs_ref}) {
    # Don't favorite yourself.
    if ($f eq $username) {
      next;
    }
    $to_check{$f} = 1;
  }
  # Filter out the results that have already been saved.
  foreach my $f (@{$settings{+FAVORITED_ALREADY}}) {
    if (defined $to_check{$f}) {
      addStatus("Skipping $f because already favorited");
      delete($to_check{$f});
    }
  }
  return(keys %to_check);
}

# Go through everyone who favorited you and favorite them in return.
sub addFavs {
  my ($blog_url, $favs_ref, $skip_ref) = @_;
  addStatus("\nAdding people who favorited $blog_url");
  my @users = usersFromFavoritedBy($favs_ref);

  my $added_blogs = 0;

  # Find and favorite blogs for all users
  my $user_count = 0;
  foreach my $u (@users) {
    $user_count++;
    my ($error, @blogs) = findBlogs($u);
    if ($error) {
      # Skipping this user for now, will try them another time.
      next;
    }
    my $success = 1;
    foreach my $b (@blogs) {
      if (defined $skip_ref->{$b}) {
	addStatus(" -> skipping $b (already fav'd)");
	next;
      }
      my $fav_url = "http://technorati.com/faves/?add=$b";
      $mech->get( $fav_url );
      if ($mech->success) {
	$added_blogs++;
      } else {
	$success = 0;
      }
    }
    if ($success) {
      # Add username to the list of favorited blogs
#      push( @{$settings{+FAVORITED_ALREADY}}, $u);
#      saveConfig();
      addStatus( sprintf("%d%% complete (%d/%d)", 
			 100 * $user_count / scalar(@users),
			$user_count, scalar(@users)) );
    }
  }
  addStatus("Done with $blog_url");
  return($added_blogs);
}