view release on metacpan or  search on metacpan

lib/Apache/Logmonster/Utility.pm  view on Meta::CPAN

    my $mm = sprintf( "%02i", $fields[4] + 1 );    # month
    my $yy = ( $fields[5] + 1900 );                # year

    $log->audit( "$mess, $yy/$mm/$dd $hh:$mn", %args );
    return $dd, $mm, $yy, undef, $hh, $mn, $ss;
}

sub get_mounted_drives {
    my $self = shift;
    my %p = validate( @_, { %std_opts } );
    my %args = $log->get_std_args( %p );

    my $mount = $self->find_bin( 'mount', %args );

    -x $mount or return $log->error( "I couldn't find mount!", %args );

    $ENV{PATH} = "";
    my %hash;
    foreach (`$mount`) {
        my ( $d, $m ) = $_ =~ /^(.*) on (.*) \(/;

        #if ( $m =~ /^\// && $d =~ /^\// )  # mount drives that begin with /
        if ( $m && $m =~ /^\// ) {   # only mounts that begin with /
            $log->audit( "adding: $m \t $d" ) if $p{debug};
            $hash{$m} = $d;
        }
    }
    return \%hash;
}

sub get_url {
    my $self = shift;
    my $url = shift;
    my %p = validate(
        @_,
        {   dir     => { type => SCALAR, optional => 1 },
            timeout => { type => SCALAR, optional => 1 },
            %std_opts,
        }
    );

    my $dir = $p{dir};
    my %args = $log->get_std_args( %p );

    my ($ua, $response);
    ## no critic ( ProhibitStringyEval )
    eval "require LWP::Simple";
    ## use critic
    return $self->get_url_system( $url, %p ) if $EVAL_ERROR;

    my $uri = URI->new($url);
    my @parts = $uri->path_segments;
    my $file = $parts[-1];  # everything after the last / in the URL
    my $file_path = $file;
    $file_path = "$dir/$file" if $dir;

    $log->audit( "fetching $url" );
    eval { $response = LWP::Simple::mirror($url, $file_path ); };

    if ( $response ) {
        if ( $response == 404 ) {
            return $log->error( "file not found ($url)", %args );
        }
        elsif ($response == 304 ) {
            $log->audit( "result 304: file is up-to-date" );
        }
        elsif ( $response == 200 ) {
            $log->audit( "result 200: file download ok" );
        }
        else {
            $log->error( "unhandled response: $response", fatal => 0 );
        };
    };

    return if ! -e $file_path;
    return $response;
}

sub get_url_system {
    my $self = shift;
    my $url = shift;
    my %p = validate(
        @_,
        {   dir     => { type => SCALAR,  optional => 1 },
            timeout => { type => SCALAR,  optional => 1, },
            %std_opts,
        }
    );

    my $dir      = $p{dir};
    my $debug    = $p{debug};
    my %args = $log->get_std_args( %p );

    my ($fetchbin, $found);
    if ( $OSNAME eq "freebsd" ) {
        $fetchbin = $self->find_bin( 'fetch', %args);
        if ( $fetchbin && -x $fetchbin ) {
            $found = $fetchbin;
            $found .= " -q" if !$debug;
        }
    }
    elsif ( $OSNAME eq "darwin" ) {
        $fetchbin = $self->find_bin( 'curl', %args );
        if ( $fetchbin && -x $fetchbin ) {
            $found = "$fetchbin -O";
            $found .= " -s " if !$debug;
        }
    }

    if ( !$found ) {
        $fetchbin = $self->find_bin( 'wget', %args);
        $found = $fetchbin if $fetchbin && -x $fetchbin;
    }

    return $log->error( "Failed to fetch $url.\n\tCouldn't find wget. Please install it.", %args )
        if !$found;

    my $fetchcmd = "$found $url";

    my $timeout = $p{timeout} || 0;
    if ( ! $timeout ) {