The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;
use WWW::Plurk;
use Getopt::Long;

use constant CONFIG     => glob '~/.plurk';
use constant QUALIFIERS => qw(
  asks feels gives has hates is likes loves says shares thinks wants was
  will wishes
);

my %is_qualifier = map { $_ => 1 } QUALIFIERS;

my %config = (
    user       => undef,
    pass       => undef,
    nocomments => 0,
    lang       => undef,
    replyto    => undef,
    quiet      => 0,
);

my $help = 0;

read_config( \%config, CONFIG ) if -f CONFIG;

if (
    !GetOptions(
        'user=s'     => \$config{user},
        'pass=s'     => \$config{pass},
        'nocomments' => \$config{nocomments},
        'lang=s'     => \$config{lang},
        'replyto=i'  => \$config{replyto},
        'quiet'      => \$config{quiet},
        'help'       => \$help,
    )
    || $help
  ) {
    help();
    exit 1;
}

unless ( @ARGV ) {
    help();
    exit 1;
}

my ( $qualifier, $content ) = strip_qualifier( @ARGV );

for my $need ( qw( user pass ) ) {
    die "Please supply a value for '$need'\n"
      unless defined $config{$need};
}

my $plurk = WWW::Plurk->new;
$plurk->login( $config{user}, $config{pass} );
if ( defined( my $replyto = $config{replyto} ) ) {
    my $msg = $plurk->respond_to_plurk(
        $replyto,
        content   => $content,
        qualifier => $qualifier,
        lang      => $config{lang},
    );
    print "Posted reply\n"
      unless $config{quiet};
}
else {
    my $msg = $plurk->add_plurk(
        content     => $content,
        qualifier   => $qualifier,
        lang        => $config{lang},
        no_comments => $config{nocomments}
    );
    print "Posted plurk ", $msg->plurk_id, "\n"
      unless $config{quiet};
}

sub read_config {
    my ( $hash, $file ) = @_;
    open my $fh, '<', $file or die "Can't read $file ($!)\n";
    LINE: while ( <$fh> ) {
        chomp;
        s/#.*$//g;    # Strip comments
        next LINE if /^\s*$/;    # Ignore blank lines
        die "Bad config directive: $_ ($file, line $.)\n"
          unless /^(\w+)\s*[:=]\s*(.*)$/;
        my ( $name, $value ) = ( $1, $2 );
        $value =~ s/\s+$//;
        die "Unknown config option: $name ($file, line $.)\n"
          unless exists $hash->{$name};
        $hash->{$name} = $value;
    }
}

sub strip_qualifier {
    my $content = join ' ', @_;
    if ( $content =~ /^(\S+)\s+(.+)$/ ) {
        my ( $head, $tail ) = ( lc $1, $2 );
        return ( $head, $tail ) if $is_qualifier{$head};
    }
    return ( ':', $content );
}

sub help {
    print <<EOH;
Syntax: plurk [options] msg

Options:
    -h, --help      Show this text
    --user=foo      Username
    --pass=sekrit   Password  
    --nocomments    Disable comments
    --lang          Language for Plurk
    --replyto=id    Post a reply to an exising Plurk
    --quiet         Shhhh...

EOH
}