#!/usr/bin/perl 
#
# $Id: $
# vim: set expandtab tabstop=4 shiftwidth=4 softtabstop=4:
#
# This file is part of GNOPASTER
#
# @author Milan 't4c' Berger <t4c@ghcif.de>
# @author Thomas 'mosez' Boerger <mosez@ghcif.de>
# @since 30/07/2005
# @version $Revision $
#
# Copyright (C) 2005-2007 ghcif.de <devel@ghcif.de>
#
# Gnopaster is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# Gnopaster is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#

#
# CHANGELOG
#
# 0.0.1  initial release
#
# 0.0.2  cleaned ip code
#        new helpfile
#        set under GPL License
#        added UserAgent
#   
# 0.0.3  added http proxy support
#
# 0.0.4  added 3rd pasting option
#        changed name to gnopaster.pl
#
# 0.0.5  changed regexp for compatibility 
#        with further gnopaste versions (>0.5.2)
#        added UserAgent Versionstring
#
# 0.0.6  added support for configuration file
#        added option for the tab width
#        added support for mod_rewrite
#
# 0.0.7  fixed bug if .gnopasterrc does not exist
#
# 0.0.8  moved username defintion to config
#
# 0.0.9  small bugfix on error handling
#

#
# CREDITS (in alphabetic order)
#
# google    for giving our brains food         (google.ru)
# MacFly    for "Gimme a gnopaste.pl!"         (german-bash.org)
# Nermal    for nerves and kicking dt          (nermal => IRCNet)
# our moms  for teaching us reading            (home.b0x)
# sh0       for preventing from the dark side  (das.sho.org)
# tengri    for idea and exbase                (unixfreunde.de)
# zero      for gettin sum regexp help         (gpg: 0x857f10E0)
#

use strict;
use warnings;

use Getopt::Std;
use LWP;
use Config::Simple;

# help function
sub help { 
    printf <<EOHELP;
gnopaster:  
    a free wklej submitter

usage: 
    wklej [-h] [-l] [description]

options: 
    -h display usage information.
    -l scriptlanguage (C#, C++, C89, Java, PHP,
       PL, Pascal, Perl, Python, Ruby, SQL, Scheme, 
       VB, XML, mIRC)
    -t tab width
    -C force creating configuration file

examples:
    dog foobar.pl | wklej -l Perl my perlfile
    pastes foobar.pl with scriptinglanguage perl
    
    gnopaster My foobar.c you got it<foobar.c
    pastes foobar.c without language and comment
    My foobar.c
    
    grep ^[^#] foo.conf | wklej
    pastes foo.conf without comments

    You also can start wklej and then enter Input
    to paste, when you have done this you can send with
    ^d (ctrl+d)

configuration:
    You can change the submission url on the config file,
    to find on your home directory (~/.wklejrc)

see also:
    http://www.nopaste.info 
    http://gnopaste.ghcif.de
    http://gnopaste.sf.net
EOHELP
}

# configure function
sub configure {
    my $config = new Config::Simple(syntax=>'simple');
    $config->param("Username", $ENV{USER});
    $config->param("Url", "http://www.wklej.org/");
    $config->param("ModRewrite", "On");
    $config->write($_[0]);
}

# some definitions going here
my $version = '0.0.9';
my $proxy = $ENV{http_proxy}; # read proxy var
my $cfg_file = "$ENV{HOME}/.wklejrc"; # configuration file
my $nick;  # poster's name
my $url; # gnopaste submission url
my $desc; # description
my $sl; # scripting language
my $tw; # tab width
my $data; # gnopaste id output
my $modrewrite; # mod_rewrite option
my $config; # configuration read from file
my %options = (); # hash used for command line parsing
my $code = ''; # pasted code

# check command line options
die "Error parsing command line\n" unless getopts('Clht', \%options);

# option create config file
if(defined $options{C}) {
    configure($cfg_file); 
    exit(0);
}

# option display help
if(defined $options{h}) {
    help(); 
    exit(0);
}

# option set script language 
$sl = "Plain Text" unless defined $options{l};
$sl = shift (@ARGV) if defined $options{l};

# option set tab width
$tw = "4" unless defined $options{t};
$tw = shift (@ARGV) if defined $options{t};

# set description
foreach(@ARGV) { 
    $desc .= $_ . " "; 
}

# read stdin and set code
if(-t STDIN && -t STDOUT) { 
    print "Copy data you want to paste\n^d paste - ^c cancels\n\n"; 
}

while(<STDIN>) { 
    $code .= $_; 
}

# print error when we get no content
die "No data received from stdin\n" unless length $code;

# parse config file
$config = new Config::Simple();

# if config does not exist create it and parse it again
if(!$config->read($cfg_file)) {
    configure($cfg_file);
    
    $config = new Config::Simple();
    $config->read($cfg_file);
}

# get config values
$nick = $config->param("Username");
$url = $config->param("Url");
$modrewrite = $config->param("ModRewrite");

# send form data
my $req = LWP::UserAgent->new;

$req->agent('gnopaster/' . $version);
$req->proxy(['http'],$proxy);

my $res = $req->post(
    $url,
    [
        'name' => $nick,
        'code_lang' => $sl,
        'tab_length' => $tw,
        'description' => $desc,
        'code' => $code,
        'submit' => 'submit',
    ],
    'content_type' => 'multipart/form-data',
);

# fetch errors
die "$url error: ", $res->status_line unless $res->is_success;
die "Wrong content type at $url -- ", $res->content_type unless $res->content_type eq 'text/html';

# preparing output 
$data = $res->content; 

# get the resulting link
if($modrewrite eq "On") {
    if($data =~ s/^.*?<a href=.*?\/id\/([A-Fa-f0-9]{10}?)".+$/$1/s) {
        print "-> " . $url . 'id/' . $data . "\n"; exit(0);
    }
} else {
    if($data =~ s/^.*?<a href=.*?\/id\/(index\.php\?id=[A-Fa-f0-9]{10})".+$/$1/s) {
        print "-> " . $url . 'id/' . $data . "\n"; exit(0);
    }
}

# the server made a boo boo
print "Couldn't extract wklej url string, pastefile is too big?\n";

# uncomment for debugging
#print $res->content;
