Correos.es postal service automatic tracker.

correos

#!/usr/bin/perl

#use utf8;
use strict;
use warnings;
use Getopt::Long;
use WWW::Curl::Easy;
use HTML::Restrict;
use HTML::TableExtract;
use Browser::Open qw( open_browser );

our $statusfile = "$ENV{'HOME'}/Documents/envios.html";
our $changefile = "$ENV{'HOME'}/Documents/envios.changes";

my @register_codes;
GetOptions(
             "help"             => \&usage,
             "update"           => \&update_statusfile,
             "open"             => \&open_file,                     # Open browser to show the status file.
             "changes"          => \&open_changes_file,             # Open browser to show the changes file.
             "register=s{1,}"   => \&register_newcodes,             # Register new codes.
             "delete=s{1,}"     => \&delete_codes,                  # Delete old codes.
           ) or usage();


sub usage {

    print "\nAutomatic checker for correos.es shipping service.

        Options:\n
            --help, -h                                  show this help.
            --update, -u                                update status file.
            --open, -o                                  open status file in browser.
            --changes, -c                               open changes file in browser.
            --register, -r CODE1 [CODE2] [...]          register entered code.
            --delete, -d CODE1 [CODE2] [...]            delete codes from status file.\n\n";
}

sub get_status {

    my $curl = WWW::Curl::Easy->new;
    $curl->setopt(CURLOPT_URL, "http://aplicacionesweb.correos.es/localizadorenvios/track.asp\?numero=$_[0]");

    my $response_body;
    $curl->setopt(CURLOPT_WRITEDATA,\$response_body);

    my $retcode = $curl->perform;
    if ($retcode == 0) {
        #Transfer went ok

        my $hr = HTML::Restrict->new();
        $hr->set_rules({
            table   => [],
            tr => [],
            td => [],
        });
        my $processed = $hr->process($response_body);

        # utf8::encode($processed);
        $processed =~ s/\r/\n/g;
        $processed =~ s/\R{2,}/\n/g;
        $processed =~ s/ /\t/g;
        $processed =~ s/\t{2,}/\t/g;
        if ($processed =~ /(<table>.*<\/table>)/s){
            $processed = $1;
        } else {
            print("An error happened: Imposible to match the <table>") and return 1
        }

        return($processed);


    } else {
        # Error code, type of error, error message
        print("An error happened: $retcode ".$curl->strerror($retcode)." ".$curl->errbuf."\n") and return 1
    }
}

sub compare_status{
    my @args= @_;
    my $args=@args;
    if ($args!= 2){
         print "Send 2 parameters, thanks\n" and return -1;
    }
    my $oldstatus=$_[0];
    my $newstatus=$_[1];

    $oldstatus =~ s/\s*$//g;
    $newstatus =~ s/\s*$//g;

    if($oldstatus ne $newstatus && length $oldstatus < length $newstatus){
        # New shit!
        return 1;
    } else {
        # Nothing new :(
        return 0;
    }
}

sub update_statusfile{
    # Load the status from the file.
    my $filecontent = do {
        open FILE, "+<", $statusfile or die $!;
        local $/ = undef;
        <FILE>;
    };

   # Split all the tables to parse them one by one.
    my @oldstatuses = $filecontent =~ /(<table*.*?table>)/smg;
    my $oldstatus;

    my @newstatus_array;
    my @changedstatus_array;
    my $changed_codes="Changed codes:\n";
    my $notify=0;

   # Parse tables one by one.
    foreach $oldstatus (@oldstatuses) {
        my $te = HTML::TableExtract->new();
        $te->parse($oldstatus);
        my @rows = $te->rows;

       # Extract shipping code:
        my @codeline = split(/:\s*/, $rows[0]->[0]);
        my $code = $codeline[1];

       # Get current status from the web:
        my $newstatus = get_status( $code );

       # Compare status:
       if( compare_status($oldstatus, $newstatus)){
           $notify=1;
           $changed_codes=$changed_codes."\n$code";
           push @changedstatus_array, "$newstatus";
       }
       push @newstatus_array, "$newstatus";
    }
    if($notify==1){
        open FILE, ">", $statusfile or die $!;
        foreach (@newstatus_array){
            print FILE "$_\n\n";
        }
        close FILE;

        # Notify user!
        `notify-send "Shipping status changed!" "$changed_codes\n Check your changefile." -t 0`;
    }

    open FILE, ">", $changefile or die $!;
    foreach (@changedstatus_array){
        print FILE "$_\n\n";
    }
    close FILE;

}
sub delete_codes{
    my ($opt_name, @args) = @_;
    print "$opt_name: Deleting\n";

    # Load the file.
    my $filecontent = do {
        open FILE, "+<", $statusfile or die $!;
        local $/ = undef;
        <FILE>;
    };

    # Split all the tables to parse them one by one.

    my @oldstatuses = $filecontent =~ /(<table*.*?table>)/smg;
    my $oldstatus;

    my @newstatus;

    # Parse tables one by one.
    foreach $oldstatus (@oldstatuses) {
        my $te = HTML::TableExtract->new();
        $te->parse($oldstatus);
        my @rows = $te->rows;

       # Extract shipping code:
        my @codeline = split(/:\s*/, $rows[0]->[0]);
        my $code = $codeline[1];

       # If the shipping code is in the argument list, ignore it.
        if( grep $_ eq $code, @args){
            print "MATCHED: $code -> Deleting\n";
        } else {
            push @newstatus, $oldstatus;
        }
    }

   # Ovewrite the file with non-ignored blocks.
    open FILE, ">", $statusfile or die $!;
    foreach (@newstatus){
        print FILE "$_\n\n";
    }
    close FILE;
}

sub register_newcodes {
    my ($opt_name, @args) = @_;
    print "$opt_name: Registering... ";
    my $newstatus;
    my $code;
    foreach $code (@args){
        $newstatus = get_status($code);
        if($newstatus ne "1"){
            print "$code [OK]\n";
            open FILE, ">>", $statusfile or die $!;
            print FILE "$newstatus\n\n";
            close FILE;
        }else{
            print "$code [FAILED]\n";
        }
    }
}


sub open_file {
    open_browser($statusfile);
}

sub open_changes_file {
    open_browser($changefile);
}