User:Noosphere/Mediation Cabal evidence template generator

Here's a little perl script that will create a Wikipedia:Mediation Cabal/Evidence template based on your input.

#!/usr/bin/perl
#
# Mediation Cabal evidence template generator
#
# This program will prompt the user to input data that will be used
# to fill in the appropriate fields for the Mediation Cabal evidence template.
#
###############################################################################
# Author: Noosphere  -  http://en.wikipedia.org/wiki/User:Noosphere
# Version: 1.1
# License: This script is dual-licensed under the GPL version 2 or any later
#          version, at your option. See http://www.gnu.org/licenses/gpl.txt for
#          more details.
###############################################################################

$EOL = "\n" ;

# Wikipedia Mediation Cabal template page
$URL = "http://en.wikipedia.org/wiki/Wikipedia:Mediation_Cabal/Evidence" ;

# First half of evidence URL
$EVIDENCE_URL_FIRST = "{{Wikipedia:Mediation Cabal/Evidence" ;
$EVIDENCE_URL_LAST  = "}}" ;

$SEPERATOR = "|" ;


sub get_input { #{{{1
    $input = <> ;
    chomp $input ;
    return $input ;
} #}}}

sub print_instructions { #{{{1
    print "This program is to be used in conjunction with:" . $EOL ;
    print $EOL ;
    print "$URL" . $EOL ;
    print $EOL ;
    print "INSTRUCTIONS: Please fill in the prompted fields with " . $EOL ;
    print "              the following information." . $EOL ;
    print $EOL ;
    print "URL: Paste URL of the history diff you found using"          . $EOL ;
    print "     'compare selected versions' in the page history,"       . $EOL ;
    print "     and this program will automatically fill in"            . $EOL ;
    print "     the 'diff' and 'oldid' fields for you."                 . $EOL ;
    print "     Otherwise just leave it blank and you'll be promted"    . $EOL ;
    print "     for them" . $EOL ;
    print $EOL ;
    print "title: e.g. Vandalism" ;
    print $EOL . $EOL ;
    print "who: e.g. [[User:Example|Example]]" ;
    print $EOL . $EOL ;
    print "page: e.g. Talk:America" ;
    print $EOL . $EOL ;
    print "diff: " ;
    print "The diff as found in the URL of the history diff " . $EOL ;
    print "      after using 'compare selected versions' in the page history." ;
    print $EOL . $EOL ;
    print "oldid: " ;
    print "The oldid as found in the URL of the history diff" . $EOL ;
    print "       after using 'compare selected versions' in the page history.";
    print $EOL . $EOL ;
    print "comment: Please describe the incident." . $EOL ;
    print $EOL . $EOL ;
    print "Please sign outside the template, signatures inside the " ;
    print "template can get mangled" . $EOL ;
    return ;
} #}}}

sub get_page_diff_oldid { #{{{1
    my ( $diff_URL, $IGNORED ) = @_ ;
    my ( $page, $diff, $oldid, $IGNORED ) = split( /&/, $diff_URL ) ;
    ( $IGNORED, $diff, $IGNORED ) = split( /=/, $diff ) ;
    ( $IGNORED, $oldid, $IGNORED ) = split( /=/, $oldid ) ;
    ( $IGNORED, $page, $IGNORED ) = split( /=/, $page ) ;
    # Decoding colon, per template requirements
    $page =~ s/%3A/:/g ;
    # Sanity check - make sure diff and oldid are all digits, and page exists
    die( "ERROR: Invalid URL.  Exiting" ) unless ( $page  =~ /^.+$/ ) ;
    die( "ERROR: Invalid URL.  Exiting" ) unless ( $diff  =~ /^\d+$/ ) ;
    die( "ERROR: Invalid URL.  Exiting" ) unless ( $oldid =~ /^\d+$/ ) ;
    return( $page, $diff, $oldid ) ;
} #}}}

sub get_evidence { #{{{1
    my $diff  = "" ;
    my $oldid = "" ;
    my $page = "" ;
    print "Please input diff URL: " ;
    my $diff_URL = get_input ;
    if ( $diff_URL ne "" ) {
        ( $page, $diff, $oldid ) = get_page_diff_oldid( $diff_URL ) ;
    }
    print "Please input title: " ;
    my $title = get_input ;
    print "Please input who: " ;
    my $who   = get_input ;
    if ( $page eq "" ) {
        print "Please input page: " ;
        $page  = get_input ;
    } ;
    if ( $diff eq "" ) {
        print "Please input diff: " ;
        $diff  = get_input
    } ;
    if ( $oldid eq "" ) {
        print "Please input oldid: " ;
        $oldid = get_input
    } ;
    print "Please input comment: " ;
    my $comment = get_input ;
    return ( $diff_URL, $title, $who, $page, $diff, $oldid, $comment ) ;
} #}}}

sub print_evidence { #{{{1
    my ( $title, $who, $page, $diff, $oldid, $comment, $IGNORED ) = @_ ;
    print $EVIDENCE_URL_FIRST ;
    print $SEPERATOR ;
    print $title ;
    print $SEPERATOR ;
    print $who ;
    print $SEPERATOR ;
    print $page ;
    print $SEPERATOR ;
    print $diff ;
    print $SEPERATOR ;
    print $oldid ;
    print $SEPERATOR ;
    print $comment ;
    print $EVIDENCE_URL_LAST ;
    print $EOL ;
    return ;
} #}}}

sub main { #{{{1
    print_instructions ;
    while () {
        print $EOL . $EOL . $EOL ;
        my ( $diff_URL, $title, $who, $page, $diff, $oldid, $comment )
            = get_evidence ;
        print $EOL ;
        print_evidence ( $title, $who, $page, $diff, $oldid, $comment ) ;
    }
    return ;
} #}}}

main ;