fitgirl-md5.pl

fitgirl-md5.pl

#!/usr/bin/env perl

use 5.028;
use strict;
use warnings ( FATAL => 'all' );
use autodie;
use utf8;
use Carp;
use Readonly;
use English '-no_match_vars';

use Cwd qw(abs_path getcwd);
use File::Basename;
use File::Spec;

Readonly our $VERSION => '0.1.0';

# TODO: Use Digest::MD5 to implement a pure perl verison that would still work
# in case md5sum is not available.

# ----------------------------------------------------------------------------
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Declarations <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
# ----------------------------------------------------------------------------

sub cant_find;
sub copy_file_contents;
sub get_locations;

# ----------------------------------------------------------------------------
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Main <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
# ----------------------------------------------------------------------------

my ( $file, $dir ) = get_locations(@ARGV);

my $md5sums = File::Spec->catfile( $dir, 'MD5SUMS' );

if ( -e $md5sums ) {
    carp(   "$md5sums already exists, using it. "
          . 'Delete it if you want us to regenerate it' );
}
else {
    open my $md5_fh, q(<:crlf), $file
      or croak("open $OS_ERROR");
    open my $md5sums_fh, q(>), $md5sums
      or croak("open $OS_ERROR");

    copy_file_contents( $md5_fh, $md5sums_fh );

    close $md5_fh     or croak("close: $OS_ERROR");
    close $md5sums_fh or croak("close: $OS_ERROR");
}

chdir $dir
  or croak("chdir($dir): $OS_ERROR");

Readonly my @CMD => qw(md5sum -c --ignore-missing --warn), $md5sums;

exec { $CMD[0] } @CMD;

# ----------------------------------------------------------------------------
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Subroutines <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
# ----------------------------------------------------------------------------

sub cant_find {
    my ($tried) = @_;

    if ( defined $tried ) {
        carp( 'We tried the following path: ' . $tried );
    }

    confess(q(We couldn't find the requiered directories. )
          . q(Please pass in the game directory as an argument, )
          . q(or launch this script from it.) );
}

sub copy_file_contents {
    my ( $src, $dst ) = @_;

  LINE:
    while ( defined( my $line = <$src> ) ) {
        $line =~ m/\A \s* [;#]/msox && next LINE;
        chomp $line;

        my ( $hash, $fname );

        if ( $line =~ m/\A ( [[:xdigit:]]{32} ) \s [*] ( .+ ) \z/msox ) {
            $hash  = $1;
            $fname = $2;
        }
        else {
            next LINE;
        }

        $fname =~ tr{\\}{/};
        $fname =~ s{\A \Q../\E}{}msox;

        print {$dst} "MD5 ($fname) = \L$hash\E\n"
          or croak("print: $OS_ERROR");
    }

    return;
}

sub get_locations {
    my @args = @_;

    my $game_dir;

    if (@args) {
        $game_dir = abs_path( shift @args );

        if ( -f $game_dir ) {
            $game_dir = dirname( dirname($game_dir) );
        }
    }
    else {
        $game_dir = getcwd();
    }

    my $md5_file;
    my $md5_dir = File::Spec->catfile( $game_dir, 'MD5' );

    if ( !-d $md5_dir ) {
        if ( basename($game_dir) eq 'MD5' ) {
            $md5_dir  = $game_dir;
            $game_dir = dirname($game_dir);
        }
        else {
            cant_find();
        }
    }

    $md5_file = File::Spec->catfile( $md5_dir, 'fitgirl-bins.md5' );

    if ( !-f $md5_file ) {
        cant_find($md5_file);
    }

    print "game_dir: $game_dir\nmd5_dir: $md5_dir\nmd5_file: $md5_file\n"
      or croak("print: $OS_ERROR");

    return ( $md5_file, $game_dir );
}

# vim: set ft=perl sw=4 sts=4 ts=8 et fenc=utf-8: