Schrift
Wiki:Tipp zum Debugging: use Data::Dumper; local $Data::Dumper::Useqq = 1; print Dumper \@var;
[thread]12207[/thread]

.txt und Arrays

Leser: 2


<< |< 1 2 3 >| >> 25 Einträge, 3 Seiten
Proxy
 2008-07-20 21:30
#112346 #112346
User since
2008-07-20
5 Artikel
BenutzerIn
[default_avatar]
Hi,

Ich bin neu hier und möchte wissen, wie ich mit Perl in eine .txt URLs speichern kann. (und bearbeiten wie löschen)

Geth das so:

Code: (dl )
1
2
3
4
5
6
7
8
print "Gebe die URL an:";
$file = 'URL.txt';
open(INFO, ">>$file");

$hinzufuegen = <STDIN>;
chomp($hinzufuegen);

push(@Liste, "$hinzufuegen");


MFG Proxy
nepos
 2008-07-20 22:40
#112352 #112352
User since
2005-08-17
1420 Artikel
BenutzerIn
[Homepage] [default_avatar]
Hm, was ganz einfaches:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#!/usr/bin/perl
# strict und warnings sollten immer rein!
use warnings;
use strict;

my $outfile = "url_liste.txt"; # Name der Ausgabedatei

# Datei zum Schreiben oeffnen
# Achtung: Die Datei wird bei jedem Aufruf des Skripts ueberschrieben
# Wenn das nicht passieren soll, > durch >> ersetzen!
open(my $fh, '>', $outfile)
    or die "Fehler beim Öffnen der Datei $outfile: $!";

print "Geben sie die URL ein. Eine leere URL beendet die Eingabe!\n";
print "URL:\t";

# Wir lesen von STDIN zeilenweise ein
while ( my $in = <STDIN> ) {
    last if ( $in =~ m/^$/ ); # Abbruch bei einer leeren Zeile
    print $fh $in; # Speichern der eingegebenen URL in die Datei
    print "URL:\t";
}
close($fh);
Proxy
 2008-07-20 22:47
#112354 #112354
User since
2008-07-20
5 Artikel
BenutzerIn
[default_avatar]
Geil danke ;-)

Du hast gerade dafür gesorgt das ich bei euch bleibe.

Ich werde mal versuchen es in mein Programm einzupringen.

mfg Proxy
MatthiasW
 2008-07-21 01:23
#112356 #112356
User since
2008-01-27
367 Artikel
BenutzerIn
[default_avatar]
Komplexere Version zum dran rumspielen.
Ist allerdings an manchen Stellen verbesserungsdürftig. Naja, vielleicht kannste die ein oder andre Idee ja gebrauchen:
Code (perl): (dl )
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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
#!/usr/bin/perl

use strict;
use warnings;

sub _search ($;$);                                              # pre-declare the _search() subroutine
sub _delete ($;$);                                              # pre-declare the _delete() subroutine

$|++;                                                           # autoflush on

my $file = shift;                                               # get file from command line

unless ( $file and -f $file )                                   # check if we got a readable file
{
        print "Specify filename to load URLs from: ";           # ask the user for a filename to load the URLs from
        chomp( $file = <STDIN> );
        print "\n";
} # unless

open( my $in, '<', $file )                                      # try to open the specified filename
        or die "open R '$file' failed: $!";                     # die on error
chomp( my @url_list = <$in> );                                  # get the URLs, one URL per line
close( $in );

my @new_urls = ();                                              # used to save unsaved URLs
my @del_urls = ();                                              # used to save deleted URLs
my @search   = ();                                              # used to save last search/get command return values
my $is_saved =  1;                                              # used to mark whether the URL list is saved or not
my $done     =  0;                                              # used to store if we are done

do {
        print "> ";                                             # ask the user for a command
        chomp( my $cmd = <STDIN> );
        $cmd  = lc $cmd;                                        # make the command lowercase
        $cmd =~ s/\s//;                                         # delete whitespace from the command

        do{$done=1;goto LOOP} if $cmd eq 'q' or $cmd eq 'quit' or $cmd eq 'exit' or $cmd eq 'bye';      # leave the loop if the user typed q or quit

        if ( $cmd eq 'a' or $cmd eq 'add' )                     # add a new URL?
        {
                print "New URL: ";                              # ask the user for a new URL to add
                chomp( my $new_url = <STDIN> );                 # get the URL

                if ( grep { $_ eq $new_url } @url_list )        # check if we already have this URL in the list
                {
                        print "\nURL already in list.\nYou may want to '> s[earch]' or '> see' the URL list.\n\n";
                        goto LOOP;
                } # if

                push( @url_list, $new_url );                    # add it to the URL list
                push( @new_urls, $new_url );                    # add it to the 'unsaved' URL list
                $is_saved = 0;                                  # mark the list as unsaved

                print "\nURL added.\nYou may want to '> save' the URL list.\n\n";
        } # if
        elsif ( $cmd eq 'd' or $cmd eq 'del' or $cmd eq 'delete' )      # delete some URLs?
        {
                print "URL or # ";                              # ask the user for a URL or a number
                chomp( my $del_url = <STDIN> );

                goto LOOP unless $del_url;

                my $url_pl = 0;                                 # used to store whether multiple URLs got deleted or not
                my $del    = 0;                                 # used to store if we deleted any URL

                if ( @search && $del_url =~ /^\d+/ )            # if a search list exists and the user specified a number
                { $del = _delete( $search[ $del_url-1 ], 0 ) }  # delete the URL, do not ask the user before doing it
                else
                {
                        _search( $del_url, sub{<STDIN>} );      # search the URL list

                        if ( @search > 1 )                      # we have multiple search items?
                        {
                                print "\nWhich URLs do you want to delete? (range) ";   # ask the user for the URLs to delete
                                chomp( $del_url = <STDIN> );

                                $del_url =~ s/\s//g;            # delete all spaces from the specified range

                                for my $p ( split( ',', $del_url ) )    # iterate over each part of the range
                                {
                                        my @p = split( '..', $p );      # try to split this part
                                        $p[1] = $p[0] if @p == 1;       # set p.1 so that we can build a range if we have just one value

                                        $del  = _delete( $search[ $_-1 ], 1 ) for $p[0] .. $p[1];       # delete the URLs, ask the user before doing it
                                } # for

                                $url_pl = 1;                    # set the URL plural flag to 1
                        } # if
                        else
                        { $del = _delete( $search[0], 1 ) }     # delete the URL, ask the user before doing it
                } # else

                if ( $del )
                { print "\nURL". ($url_pl ? 's' : '') ." deleted.\nYou may want to '> save' the URL list.\n\n" }
                else
                { print "\nProblem while deleting ". ($url_pl ? 'one or more URLs' : 'the URL') .".\nYou may want to '> s(earch)' or '> see' the URL list to get more information.\nYou may also want to '> save' the URL list.\n\n" }
        } # elsif
        elsif ( $cmd eq 'c' or $cmd eq 'changes' )              # show changes?
        {
                if ( $is_saved )
                {
                        print "There are no unsaved changes.\n\n";
                        goto LOOP;
                } # if

                if ( @new_urls )
                {
                        print "New URLs till last save:\n";
                        for my $i ( 1 .. @new_urls )
                        {
                                <STDIN> if $i % 24 == 0;        # stop the output every 24 lines

                                printf
                                        "%3s : %s\n",
                                        $i, $new_urls[$i-1];
                        } # for

                        print "\n";
                } # if
                if ( @del_urls )
                {
                        print "Deleted URLs till last save:\n";
                        for my $i ( 1 .. @del_urls )
                        {
                                <STDIN> if $i % 24 == 0;        # stop the output every 24 lines

                                printf
                                        "%3s : %s\n",
                                        $i, $del_urls[$i-1];
                        } # for

                        print "\n";
                } # if
        } # elsif
        elsif ( $cmd eq 's' or $cmd eq 'search' )               # search the URL list?
        {
                print "Enter search string: ";                  # ask the user for the search string
                chomp( my $search = <STDIN> );

                _search( $search, sub{<STDIN>} );               # search the URL list

                print "\nYou may want to '> d[elete]' or '> a[dd]' some URLs.\n\n";
        } # elsif
        elsif ( $cmd eq 'see' )                                 # show the full URL list?
        {
                _search( '' );                                  # search for nothing, so get all

                if ( $is_saved )
                { print "\nThese were all URLs in the list.\n\n" }
                else
                { print "\nThese were all URLs in the list.\nYou may want to '> save' the URL list, because it has got unsaved changes.\nTo see these changes, please use the '> c[hanges]' command.\n\n" }
        } # elsif
        elsif ( $cmd eq 'w' or $cmd eq 'write' or $cmd eq 'save' )      # save the URL list?
        {
                print "Type filename to save the list to [$file] ";     # ask the user for a filename to save the list to
                chomp( my $new_file = <STDIN> );

                ($file = $new_file) if $new_file;

                open( my $out, '>', $file )                     # try to open the specified filename
                        or die "open W '$file' failed: $!";     # die on error
                print $out join( "\n", @url_list );             # write the url list to this file
                clsoe( $out );

                @new_urls = ();                                 # reset the 'unsaved' URL list
                @del_urls = ();                                 # reset the 'deleted' URL list
                $is_saved =  1;                                 # reset the is_saved flag

                print "\nURL list saved.\n\n";
        } # elsif
        else
        {
                print "Unknown command '$cmd'.\nPossible commands are: a[dd], c[hanges], d[el[ete]], s[earch], see, save/w[rite], q[uit]/exit/bye\n\n";
        } # else

        LOOP:
} until $done;

unless ( $is_saved )
{
        if ( @new_urls )
        {
                print "New URLs till last save:\n";
                for my $i ( 1 .. @new_urls )
                {
                        <STDIN> if $i % 24 == 0;                # stop the output every 24 lines

                        printf
                                "%3s : %s\n",
                                $i, $new_urls[$i-1];
                } # for

                print "\n";
        } # if
        if ( @del_urls )
        {
                print "Deleted URLs till last save:\n";
                for my $i ( 1 .. @del_urls )
                {
                        <STDIN> if $i % 24 == 0;                # stop the output every 24 lines

                        printf
                                "%3s : %s\n",
                                $i, $del_urls[$i-1];
                } # for
                print "\n";
        }

        print "Do you really want to lose these changes? (yes/no) [no] ";
        chomp( my $answer = <STDIN> );
        $answer  = lc $answer;                                  # make the answer lowercase
        $answer =~ s/\s//;                                      # delete whitespace from the answer

        exit 0 if $answer eq 'y' or $answer eq 'yes';           # exit the application, the user does not want to save the changes

        print "Type filename to save the list to [$file] ";     # ask the user for a filename to save the list to
        chomp( my $new_file = <STDIN> );

        ($file = $new_file) if $new_file;

        open( my $out, '>', $file )                             # try to open the specified filename
                or die "open W '$file' failed: $!";             # die on error
        print $out join( "\n", @url_list );                     # write the url list to this file
        clsoe( $out );

        print "\nURL list saved.\n\n";
} # if

#
# _search( SEARCH [, WAIT_TIME] )
# This subroutine searches the @url_list array for SEARCH and saves the matches
# in @search.
# It will wait WAIT_TIME seconds after showing the number of results to the user.
# If WAIT_TIME is a code reference, it will run that code reference instead.
# The @search array will get printed to the screen with a <STDIN> stop every 24 lines.
#
sub _search ($;$)
{
        my( $search, $wait ) = @_;

        @search = grep { /\Q$search\E/ } @url_list;             # search the URL list

        print "\n@{[ 0+@search ]} entries matching '$search'.\n";

        if ( $wait && ref( $wait ) eq 'CODE' )
        { $wait->() }                                           # run the wait code
        else
        { select( undef, undef, undef, $wait || 0 ) }           # wait $wait or zero seconds

        for my $i ( 1 .. @search )
        {
                <STDIN> if $i % 24 == 0;                        # stop the output every 24 lines

                printf
                        "%3s : %s\n",
                        $i, $search[$i-1];
        } # for
} # _search

#
# _delete( URL [, ASK_BEFORE] )
# This subroutine deletes one URL from the URL list.
# It will ask the user before deleting the item if ASK_BEFORE is set to true.
# This subroutine will also delete the URL from the 'unsaved' URL list and it will
# add all deleted URLs to the 'deleted' URL list and change the is saved flag
# respectively.
#
sub _delete ($;$)
{
        my( $url, $q ) = @_;

        if ( $q )                                               # shall we asked the user?
        {
                print "$url\nDo you really want to delete this URL? (yes/no) [yes] ";   # ask the user if he/she wants to delete the URL
                chomp( my $answer = <STDIN> );
                $answer  = lc $answer;                          # make the answer lowercase
                $answer =~ s/\s//;                              # delete whitespace from the answer

                return 0 if $answer eq 'n' or $answer eq 'no';  # return false if the answer was 'no'
        } # if

        my $idx;
        ($idx) = grep { $url_list[$_] eq $url } 0.. $#url_list; # try to find the URL in the URL list
        splice( @url_list, $idx, 1 ) if defined $idx;           # delete the URL from the URL list

        return 0 if ! defined $idx;                             # return false if the URL could not be found

        push( @del_urls, $url );                                # add the deleted URL to the 'deleted' URL list
        $is_saved = 0;                                          # reset the is_saved flag

        ($idx) = grep { $new_urls[$_] eq $url } 0.. $#new_urls; # try to find the URL in the 'unsaved' URL list
        splice( @new_urls, $idx, 1 ) if defined $idx;           # delete the URL from the 'unsaved' URL list

        return 1;
} # _delete

MfG

edit: 2 kleine Rechtschreibfehler beseitigt.
perl -E'*==*",s;;%ENV=~m,..$,,$&+42;e,$==f;$"++for+ab..an;@"=qw,u t,,print+chr;sub f{split}say"@{=} me"'
betterworld
 2008-07-21 02:35
#112359 #112359
User since
2003-08-21
2614 Artikel
ModeratorIn

user image
Proxy+2008-07-20 19:30:41--
Code: (dl )
print "Gebe die URL an:";


Es heißt "Gib" :)

MatthiasW: Verwendung von goto mit Labels ist nicht sehr schoen. Schau Dir mal die Befehle "next" und "last" an.
nepos
 2008-07-21 03:17
#112360 #112360
User since
2005-08-17
1420 Artikel
BenutzerIn
[Homepage] [default_avatar]
Och, nach ein paar Bierchen darf man doch den kleinen Vertipper verzeihen oder? ;)
betterworld
 2008-07-21 04:02
#112361 #112361
User since
2003-08-21
2614 Artikel
ModeratorIn

user image
nepos+2008-07-21 01:17:53--
Och, nach ein paar Bierchen darf man doch den kleinen Vertipper verzeihen oder? ;)

Ja, ich wollte nur darauf hinweisen :)
Mir stellt sich jetzt allerdings die Frage: Bist Du Proxy? Und wenn nein, woher weißt Du, wie viele Bier Proxy hatte? ;)
Hagen
 2008-07-21 09:53
#112362 #112362
User since
2007-09-06
233 Artikel
BenutzerIn
[default_avatar]
MatthiasW+2008-07-20 23:23:13--
sub _search ($;$); # pre-declare the _search() subroutine


Kann mir jemand einen Tipp geben, wofür der '_' im Skript-Namen steht bzw. wann man ihn braucht und warum ich in Perl ein pre-declaire für Subroutinen brauche?
Gruß
Hagen
renee
 2008-07-21 10:36
#112363 #112363
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Das '_' soll andeuten, dass es eine "private" Methode ist. In Perl gibt es keine Berechtigungen wie "private" oder "public" wie in anderen Sprachen. Deshalb haben sich mal ein paar Programmierer überlegt, dass man Namen von "private" Methoden mit '_' anfängt. Es ist aber nicht wirklich eine private Methode und man kann "von außen" immer noch zugreifen.

Das Deklarieren von Subroutinen brauchst Du, wenn Du Prototypen verwendest und nicht die ganze Subroutine vor dem Aufruf schreiben willst. Wenn Du in dem Code von MatthiasW das vorherige Deklarieren weglässt, wird Perl Dir eine Warnung ausgeben, dass die Überprüfung der Prototypen "zu spät" ist.

Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
rbaecker@www-devel-rbaecker ~ $ cat prototypes.pl
#!/usr/bin/perl

use strict;
use warnings;

test('hallo');

sub test($) {
print @_,"\n";
}

rbaecker@www-devel-rbaecker ~ $ perl prototypes.pl
main::test() called too early to check prototype at prototypes.pl line 6.
hallo


Ich bin sowieso nicht der große Freund von Prototypen. Es gibt zwar ein paar Fälle, in denen sie nützlich sind, aber in den allermeisten Fällen würde ich sie weglassen.
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
MatthiasW
 2008-07-21 10:58
#112364 #112364
User since
2008-01-27
367 Artikel
BenutzerIn
[default_avatar]
betterworld+2008-07-21 00:35:53--
MatthiasW: Verwendung von goto mit Labels ist nicht sehr schoen. Schau Dir mal die Befehle "next" und "last" an.

Ich hatte erst next und last im Code und auch keine until, sondern eine while Schleife, die Variable $done, hab ich auch erst später dazugenommen.
Nur leider hat das wegen des do {} Blocks nicht funktioniert... perl hat mir gesagt, ich wäre nicht innerhalb eines Schleifenrumpfes, also hab ichs abgeändert.
Ob das Problem mit until auch besteht weiß ich nicht, ich habs nur mit while getestet.
Natürlich hätte ich die Schleife auch umstellen können, aber das war mir dann doch zu viel Aufwand, es ist halt quick&dirty.

Die Prototypen finde ich persöhnlich sehr praktisch, jedenfalls wenn man mal etwas nicht objektorientiert macht, denn leider funktionieren sie da ja nicht mehr...
Ich finde sie deshalb so praktisch, weil man dann sicher gehen kann, dass man die Parameter so vorfindet, wie man sie gerne hätte. Und derjenige, der die Subroutinen verwendet, wird darauf hingewiesen, falls er einen Fehler gemacht hat.
D.h. natürlich nicht, dass man sich das Prüfen der Parameter sparen kann, wenn man Prototypen verwendet, aber Arbeit bekommt man in jedem Fall abgenommen.

MfG
perl -E'*==*",s;;%ENV=~m,..$,,$&+42;e,$==f;$"++for+ab..an;@"=qw,u t,,print+chr;sub f{split}say"@{=} me"'
<< |< 1 2 3 >| >> 25 Einträge, 3 Seiten



View all threads created 2008-07-20 21:30.