paster

#!/usr/bin/perl

package BlogPeer;

use strict;
use warnings;

use Text::Unaccent;
use Data::Dumper;    # debug
use WWW::Mechanize;
use Net::POP3;       # aktivace

use constant BLOG_TITLE  => 'Můj blog';

use constant LOGIN 		 => 'http://blog.cz';
use constant NEW_POST    => 'http://admin.blog.cz/clanky/edit';
use constant RUBRIKY     => 'http://admin.blog.cz/rubriky';
use constant ODKAZY		 => 'http://admin.blog.cz/odkazy/novy?status=oblibene';
use constant LAYOUT		 => 'http://admin.blog.cz/nastaveni/sablona';
use constant SIDEBAR	 => 'http://admin.blog.cz/nastaveni/polozky';


use constant EMAIL       => 'hah@seznam.cz';
use constant EMAIL_POP   => 'pop3.seznam.cz';
use constant EMAIL_LOGIN => '****';
use constant EMAIL_PASS  => '****';

#
# konstruktor
#
sub new {

	my $self = {
		login    => undef,
		password => undef,
		email    => undef,
		_bot     => undef
	};
	bless $self, 'BlogPeer';

	$self->{_bot} = $self->newBot();

	return $self;
}

#
# zaregistruje novy blog
#
sub newBlog {
	my ( $self, $login, $password ) = @_;

	$self->{login}    = $login;       # login.blog.cz
	$self->{password} = $password;    # heslo

	my $bot = $self->{_bot};

	$bot->get(LOGIN);
	$bot->follow_link( url_regex => qr/registration/i );

	print '- registruji novy blog '
	  . $login
	  . '.blog.cz pres '
	  . $bot->uri() . "\n";

	# prvni formular
	$bot->field( 'username',       $self->{login} );
	$bot->field( 'password',       $self->{password} );
	$bot->field( 'password_again', $self->{password} );
	$bot->field( 'email',          EMAIL );
	$bot->field( 'license',        '1' );

	print "- odesilam\n";
	$bot->submit();

	# kontrola
	if ( $bot->content =~ /Chyba: ([^<]*)/i ) {
		print "- Chyba: ".unac_string( 'UTF-8', $1 )."\n";
		return 0;
	}

	# -----------------------------------------------------
	# 1/4 Nazev blogu
	# -----------------------------------------------------
	print "- 1/4 -----------------------------\n";
	$bot->field( 'blog_title', BLOG_TITLE);
	$bot->click();

	# -----------------------------------------------------
	# 2/4 Layout
	# -----------------------------------------------------
	print "- 2/4 -----------------------------\n";
	$bot->field( 'blog_layout', int(rand(3)+1) );
	$bot->click();

	# -----------------------------------------------------
	# 3/4 Skin
	# -----------------------------------------------------
	print "- 3/4 -----------------------------\n";
	$bot->field( 'blog_skin', int(rand(5)+1) );
	$bot->click();

	return 1;
}

#
# potvrdi emaily pres pop
#
sub mailConfirm() {
	my ($self) = @_;
	print "- kontroluju email - " . EMAIL_POP . "\n";

	my $pop = Net::POP3->new( EMAIL_POP, Timeout => 60 );

	if ( $pop->login( EMAIL_LOGIN, EMAIL_PASS ) > 0 ) {

		my $msgnums = $pop->list;    # hashref of msgnum => size
		my $msg;
		foreach my $msgnum ( keys %$msgnums ) {
			$msg = $pop->get($msgnum);

			#    $pop->delete($msgnum);
			$msg = join( " ", @$msg );

#http://blog.cz/account/confirmation/id/1736188ec996ca6ed21f7acef5214c5c0baf6
#http://blog.cz/account/confirmation/id/1736020d2aa64365a9d9db55a670d0d0e941606
#http://blog.cz/account/confirmation/id/1736188ec996ca6ed21f7acef5214c5c0ba93f
#http://blog.cz/account/confirmation/id/1736188ec996ca6ed21f7acef5214c5c0ba93f6=20

#			$msg =~ s/\n//g;
			my $old = $msg;

			$msg =~ s/=\n\s*//g;
			$msg =~ s/=20//g;
#			print $msg;
#			return 0;
			if ( $msg =~ /([^\s]*confirmation[^\s]*)/ ) {

				my $url = $1;

				print "- potvrzeni -> $url\n";
				my $bot = $self->newBot();
				#$bot->_reset_page;
				$bot->get($url);

				# kontrola
				if ( $bot->content =~ /(\: Potvrzen[^<]*)/is ) {
					print "- $1\n";
					$pop->delete($msgnum);
				} elsif ($bot->content =~ /(Chyba: Zadan[^<]*)/si) {
					print "- $1\n";
					$pop->delete($msgnum);
				} else {
					print "- uh ?! err\n";
					print $old;
					print $msg;
					print $bot->content;
					return 0;
				}
			}
			else {

				#print Dumper($msg);
				$pop->delete($msgnum);
			}
		}
		$pop->quit;
	}
	return 1;

}

#
# prihlaseni
#
sub login {
	my ( $self, $login, $password ) = @_;

	$self->{login}    = $login;       # login.blog.cz
	$self->{password} = $password;    # heslo

	my $bot = $self->{_bot};
#	my $bot = WWW::Mechanize->new();
	# prihlaseni
	$bot->get(LOGIN);

	$bot->form_number(2);
	$bot->field( 'username', $self->{login} );
	$bot->field( 'password', $self->{password} );
	$bot->submit();

	print "- prihlasen " . $self->{login} . "\n";
}

#
# vytvori rubriku
#
sub newCategory {
	my ( $self, $title ) = @_;
	my $bot = $self->{_bot}->clone();
	$bot->get(RUBRIKY);

	print "- zakladam kategorii $title\n";

	$bot->field( 'folder_name', $title );
	$bot->submit();
}

#
# vytvori novy oblibeny odkaz
#
sub newLink {
	my ( $self, $title, $url ) = @_;
	my $bot = $self->{_bot}->clone();
	$bot->get(ODKAZY);

	print "- novy odkaz $title - $url\n";

	$bot->field( 'link_title', $title );
	$bot->field( 'link_url',   $url );
	$bot->click_button( name => 'but_submit' );
}

sub setLayout {
	my ( $self, $layout ) = @_;

	my $bot = $self->{_bot}->clone();
	$bot->get(LAYOUT);

	$bot->field( 'blog_layout', 1);
	$bot->submit();

	$bot->get(SIDEBAR);

	$bot->field( 'column_item', '4,3,2,6' );

	$bot->submit();
}

sub delete {
	my ( $self, $layout ) = @_;

	my $bot = $self->{_bot}->clone();
	$bot->get('http://admin.blog.cz/nastaveni/zrusit');
	$bot->field( 'passwordVerify', $self->{password});
	$bot->field( 'blog_delete', 1);

	$bot->submit;
}

#
# publikuje ihned clanek
#
sub publish {
	my ( $self, $title, $article_text, $category, $red) = @_;

	my $bot = $self->{_bot};
	$bot->get(NEW_POST);

	# [pre]
	my @tmp = $bot->find_all_inputs( name => 'article_title' );
	if ( @tmp == 0 ) {
		print "- nejsme prihlaseni :-/\n";
		return 0;
	}

	# [fill]
	$bot->field( 'article_title', $title );
	$bot->field( 'article_text',  $article_text );

	if($category) {
		# select rubriku
		my $c = $bot->content;
		my $escc = $category;
		$escc =~ s/(\W)/\\$1/g;
		if($c =~ /<option value="([^"]+)"\s*>\s*$escc/s) { #"
			$bot->select('article_folder', $1);
		} elsif(!$red) {
			$self->newCategory($category);
			return $self->publish($title, $article_text, $category, 1);
		}
	}

	#Data::Dumper->Dump([$bot->find_all_submits()]);

	#$bot->click_button( number => 4 );
	eval {
		$bot->click_button( name => 'article_publish' );
	};
	#$bot->submit();

	print "- hotovo !\n";
}


#
# Vytvori noveho robota
#
sub newBot {
	my ($self) = @_;

	my $bot = WWW::Mechanize->new();

	$bot->_reset_page;
	$bot->cookie_jar( HTTP::Cookies->new( file => "cookies.dat" ) );
	$bot->agent_alias('Windows IE 6');

	return $bot;
}

#
# nahodny retezec
#
sub random_string {
	my $length_of_randomstring = shift;

	my @chars = ( 'a' .. 'z', 'A' .. 'Z', '0' .. '9' );
	my $random_string;
	foreach ( 1 .. $length_of_randomstring ) {
		$random_string .= $chars[ rand @chars ];
	}
	return $random_string;
}

1;