#!/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 <