#!/usr/bin/perl -w
#
#
# Simple program to connect to http://www.pagemart.com/cgi-bin/rbox/pglpage-cgi
# and send a page.
#
# Modified 10/21/99 Will O'Brien willo@savvis.net 
# Originally Written by David Allen s2mdalle@titan.vcu.edu
# http://opop.nols.com/
#
# This file is released under the terms of the GNU General Public License.
# Please see http://www.gnu.org for more details.
#
# This program is STILL beta, error checking and verification don't work!
# REQUIRES MODULES:  strict and IO::Socket
#
# USAGE:  wpage.pl PAGER_PIN MESSAGE
# Where PAGER_PIN is the PIN of the pager you want to send MESSAGE to.
# You don't need to put quotes around MESSAGE.
#
# This program will send the page using 
# www.pagemart.com/cgi-bin/rbox/pglpage-cgi
# and will store the response in LASTRESPONSE.html when the server replies.
#
# If you are looking at this program for examples of code to make it work,
# check out the page{} subroutine below - it is the meat of this program.
##############################################################################

# use Socket;                   # INET
use strict;
use IO::Socket;               # Socket work

my $pagerid = shift;
my $MESSAGE = join ' ', @ARGV;

die "Usage:  mpage.pl PAGER_ID words in message\n\n" unless $pagerid;
die "Usage:  mpage.pl PAGER_ID words in message\n\n" unless $MESSAGE;

page($pagerid, $MESSAGE);
print "Done.\n";
exit(0);

############################################################################

sub page{
    my ($name, $text) = @_;
    my $TRUNCATED = 0;
    my $PAGE = "";  # The text sent to www.mobilecomm.com - appended later.
    
    $pagerid = $name;

    print STDERR "Processing pager ID...\n";
    # Eliminate everything but numbers from the pager id
    $pagerid =~ s/[^0-9]//g;
    
    # Check the pager id length and so on.
    if(not $pagerid || (length($pagerid) < 7) )
    {
	die "Bad pager ID number.  A pager id number is 7 or 10 numbers.\n";
    }

    die "No message specified.\n" unless $text;

    # This is the format of the message we're going to send via the TCP
    # socket
    # POST /cgi-bin/rbox/pglpage-cgi HTTP/1.0
    # User-Agent: Myprogram/1.00
    # Accept: */*
    # Content-length: 35
    # Content-type: application/x-www-form-urlencoded
    #
    # pin2=6807659&message1=stuff+and+nonsense
    
    print STDERR "Processing text of message...\n";
    # A bit of string pre-processing
    chomp $text;
    my $strdelim       = "\r\n";    # At the end of each line.
    
    # Compress the text a bit - eliminate redundant characters - this 
    # helps a lot for pages that have multiple spaces and so on.
    $text =~s/\n/ /g;          # Linefeeds are spaces
    $text =~s/\r//g;           # No carriage returns
    $text =~s/\s+/ /g;         # Multiple whitespace -> one space.
    
    if(length($text)>=200)
    {
	$TRUNCATED = "True";
	$text = substr($text, 0, 199);      # 200 Character maximum
    }
    
    my $encodedmessage = urlencode($text);
    
    # The length of the request has to be TOTAL QUERY.  If it's just
    # the length of the string you're sending, it will truncate the 
    # hell out of the page.  So the pager number is length($pagerid)
    # of course the length of the message, and add the length of the
    # parameter flags, (PIN= and ?MSSG=) and you're done.
    
    my $pagelen=length($encodedmessage)+length("pin2=?message1=")+
	length($pagerid);
    
    # Build the text we send to the server
    $PAGE  = "POST /cgi-bin/rbox/pglpage-cgi HTTP/1.0$strdelim";
    $PAGE .= "User-Agent: Pagent/5.4$strdelim";
    $PAGE .= "Accept: */*$strdelim";
    $PAGE .= "Content-length: $pagelen$strdelim";
    $PAGE .= "Content-type: application/x-www-form-urlencoded$strdelim";
    $PAGE .= "$strdelim";
    $PAGE .= "pin2=$pagerid&message1=".$encodedmessage;

    print STDERR "Sending message...\n";

    # Now we send our data.
    # Note that this is just quick and dirty, so I'm using a perl module
    # to do the network dirty work for me.
    my $sock = IO::Socket::INET->new(PeerAddr => 'www2.pagemart.com',
				     PeerPort => 'http(80)',
				     Proto    => 'tcp');

    die "Cannot create socket : $!" unless $sock;
    
    $sock->autoflush();
    $sock->print("$PAGE");
    
    print STDERR "Getting response and saving to LASTRESPONSE.html...\n\n";
    my $document = join('', $sock->getlines());
    
    my $y=0;
    open(FOO,">LASTREPONSE.html") or $y=1;
    print FOO "$document\n" unless $y;
    close FOO unless $y;
    
    if($document =~ m/Message NOT Sent/g)
    {  
	print STDERR "Page not sent.  There was an error.  See ",
	"LASTRESPONSE.html for what the server sent back to me.\n";
	exit(0);
    } # End if
    else
    {   
	$document =~ m/(\d{1,4}) character message out of/g;
	print STDERR "Page sent successfully to $pagerid.\n";
	exit(0);
    } # End else
} # End sub page

############################################################################

sub urlencode{
    my $text    = shift;
    my $input   = $text;
    
    chomp $input;

    # Translate all non-letter non-number characters into their %HEX_VAL
    # and return that string.
    $input =~ s/([^a-zA-Z0-9-_\.\/])/uc sprintf("%%%02x",ord($1))/eg;
    $input =~ s/%20/+/g;

    return $input;
} # End sub urlencode
