#!/usr/bin/perl -w

use strict;

use Getopt::Long;
use HTTP::Status;
use LWP::Simple;
use Unicode::Map;

my $numWarnings = 0;
my $numErrors = 0;
my %opt = ( );

main: {
    $|=1;
    _getOptions ( );
    _mirror ( );
    _summarizeResult ( );
    exit $numErrors;
}

sub _getOptions {
    GetOptions ( \%opt, "update" );
    if ( !$opt{"update"} ) {
        usage ( );
    }
}

sub usage {
    print <<EOF

Usage: mirrorMappings --update
An utility for hardcore Unicode::Map perl developers.

It mirrors a collection of textual Unicode mapping files in order to create 
binary mapping files. Causes quite some net traffic!

EOF
    ;exit 1;
}

sub _mirror ( ) {
    my $emptyMap = new Unicode::Map ( );
    for ( sort $emptyMap->ids() ) {
        my $srcURL  = $emptyMap -> srcURL ( $_ );
        my $srcCopy = $emptyMap -> src ( $_ );

        print "Processing \"$_\": ";
        if ( !$srcCopy ) {
            print "Error!\n";
            print "! No 'src:' entry for this charset! Error in file 'REGISTRY'!\n";
            $numErrors++;
            next;
        }

        if ( !_mkFilePath($srcCopy) ) {
            print "Error!\n";
            print "Couldn't create directory! ($!)\n";
            $numErrors++;
            next;
        }
    
        if ( !$srcURL ) {
            print "Warning!\n";
            print <<EOF
? No source URL for charset "$_"!
  This indicates an error unless you added an charset source manually to
  the control file "REGISTRY" and don't want to update it automatically!
EOF
            ;
            $numWarnings++;
            next;
        }
        
        my $existed = -e $srcCopy;

        $^W = 0; # no warnings here
            my $rc;
            for ( 1..2 ) {
                $rc = mirror ( $srcURL, $srcCopy );
                # If a BAD_REQUEST occurs for stupid reasons try another time.
                last unless $rc == RC_BAD_REQUEST;
            }
        $^W = 1;
    
        if ( is_error($rc) ) {
            my $msg = status_message ( $rc );
            print "Error!\n";
            print "! Couldn't mirror \"$srcURL\"! ($rc: $msg)\n";
            $numErrors++;
            next;
        }

        if ( !$existed ) {
            print "created \"$srcCopy\"\n";
        } else {
            if ( $rc==RC_NOT_MODIFIED ) {
                print "is uptodate.\n";
            } else {
                print "updated.\n";
            }
        }
    }
}

sub _summarizeResult {
    if ( $numWarnings==0 && $numErrors==0 ) {
        print "Ok. Everything went fine!\n";
    } elsif ( $numErrors>0 ) {
        my $msg;
        $msg = "$numErrors error";
        $msg .= "s" if $numErrors>1;
        $msg .= ", $numWarnings warning" if $numWarnings>0;
        $msg .= "s" if $numWarnings>1;
        $msg .= ".";
        print "Error! Encountered $msg\n";
    } else {
        my $msg;
        $msg = "$numWarnings warning";
        $msg .= "s" if $numWarnings>1;
        $msg .= ".";
        print "Warning! Possible trouble! $msg\n";
    }
}

##
## Utilities
##

sub _mkFilePath {
    my ( $filePath ) = @_;
    my $file = substr ( $filePath, rindex($filePath,"/")+1 );
    my $path = $filePath; $path =~ s/$file$//;
    _mkPath ( $path );
}

sub _mkPath {
    my ( $path ) = @_;
    my $current = "";
    for (grep {$_} split /\//, $path) {
        $current .= "/$_";
        if ( !-d $current ) {
            if ( !_mkdir($current) ) {
                return 0;
            }
        }
    }
1}

sub _mkdir {
    my ( $path ) = @_;
    if ( !-d $path ) {
        if ( !mkdir ($path, 0777 ) ) {
            return 0;
        }
    }
1}


