File: Utils.pm

package info (click to toggle)
net-telnet-cisco 1.10-5.3
  • links: PTS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 160 kB
  • ctags: 32
  • sloc: perl: 792; makefile: 52
file content (156 lines) | stat: -rw-r--r-- 3,449 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
# -*- perl -*-
#
# Utils.pm - Tools for Tests!
#
# Exports some globals and provides Helpful Subs
#
# jkeroes $Id: Utils.pm,v 1.1 2002/12/31 00:11:49 jkeroes Exp $

package main;

use File::Basename;
use Test::More;
use FindBin	qw/$Bin/;
use File::Path  qw/mkpath/;

use Cwd;

# Defaults
$LOGDIR = "$Bin/../logs";	# Only valid for files in t/*.t
$SAVELOGS = 'n';

sub fatal (@;);

#------------------------------------------------------------
# Subs
#------------------------------------------------------------

# Runs the 'show ?' command
sub show_help {
    my $session = shift;

    # The prompt will look something like:
    #
    #   "gw01.phnx#show "
    #
    my $prompt = $session->prompt;
    $prompt =~ s{\$\)/$}{\)/};

    # could play wantarray games here but... whatever.
    my @out = $session->cmd(Ors => '',
		  String => 'show ?',
		  Prompt => $prompt,
		  @_,
		 );

    return @out;
}


# Ensure the argument (or current directory if called without args)
# is mode 0700.
sub fixmode {
    my $dir = shift || cwd();

    my $mode = (stat $dir)[2];
    chmod 0700, $dir or fatal <<EOB;

 ============================================================
 Directory '$dir' has an insufficient level of
 permissions to continue. We need 0700. Please
 correct this manually and try again.
 ------------------------------------------------------------

EOB

}

# Loads TSV from a file. Returns a hash
sub load {
    my $file = shift ||	(-r 'tmp.txt' ? 'tmp.txt' :
			 -r 'login.txt' ? 'login.txt' :
			 '');

    my %h = ( SAVELOGS => $SAVELOGS, LOGDIR => $LOGDIR );
    fatal "No login data. Run `perl Makefile.PL` again.\n" unless $file;

    open FH, "< $file" or return %h;
    while (<FH>) {
	next if /^\s*\#/; # skip comments
	chomp;
	my ($k, $v) = split;
	
	$h{$k} = $v;
    }
    close FH or warn $!;

    return %h;
}

# Accepts: $filename, %hash
# Saves to a TSV file.
sub save {
    my $file  = shift || "tmp.txt";

    print "Saving login info to '$file'... ";

    open FH, "> $file" or fatal "Can't open '$file' for write: $!";
    chmod 0700, $file or fatal "Can't set '$file to 0700: $!";

    my %h = @_;
    while (my ($k, $v) = each %h) {
	print FH "$k\t$v\n";
    }

    close FH or warn $!;

    print "done.\n";
}

# Returns logging args for N::T::C->new()
sub log_args {
    my $progname = basename(shift || $0);
    $progname =~ s/\.t$//;

    return ( Input_log	 => "$LOGDIR/$progname.input",
	     Dump_log	 => "$LOGDIR/$progname.dump",
	     Output_log	 => "$LOGDIR/$progname.output",
	   );
}

# Remove logs.
#
# The user was queried in MakeMaker.PL whether he wanted to deleted logs:
#  (A)lways
#  (N)ever
#  only on (F)ailure
#
# We default to Always because things are more secure that way.
#
# Usage:
# cleanup( savelogs => a | n | f,
#	  failed => integer
#	);
sub cleanup {
    my %args = (savelogs => $SAVELOGS, failed => 0, @_, );

    $args{savelogs}  = defined $args{savelogs}	? $args{savelogs}  : $SAVELOGS;
    $args{failed}    = defined $args{failed}	? $args{failed}	   : 0;

    my $progname = basename($0);
    $progname =~ s/\.t$//;

    if (   $args{savelogs} eq 'n'
	|| $args{savelogs} eq 'f' && ! $args{failed}) {
	my @goners = <$LOGDIR/$progname.*>;
	my $cnt = unlink @goners;
	warn "Problems deleting @goners: $!" unless scalar @goners == $cnt;
	diag "Logs deleted." if $ENV{TEST_VERBOSE};
    } else {
	diag "Logs saved.";
    }
}

sub fatal (@;) { Test::More->builder->BAILOUT(@_) }

1;