Page 1 of 2 12 LastLast
Results 1 to 10 of 14

Thread: Help with perl hashes

  1. #1
    Join Date
    Dec 2007
    Location
    ~
    Beans
    314
    Distro
    Ubuntu 10.04 Lucid Lynx

    Question Help with perl hashes

    I am trying the following

    Code:
    my %x;
    
    while(<INPUT>)
    {
    $x{$_} = {
    name => 'test',
    list => []
    };
    }
    
    for my $someValue(keys %x)
    {
    my %y = {val1=>"sasda",val2=>"sjxj");
    push(@{$x{$someValue}{list}},%y);
    }
    nothing is being added into the list if i do this?
    what is going wrong?

  2. #2

    Re: Help with perl hashes

    For starters, you have a mismatched { with ) on line 13.

    Also, your code doesn't open INPUT anywhere, so either you're reading a filehandle that doesn't exist (which will probably be interpreted as a bareword name-of-file, if my Perl-fu is correct) or you're holding out on us. Show complete code, please.

  3. #3
    Join Date
    Dec 2007
    Location
    ~
    Beans
    314
    Distro
    Ubuntu 10.04 Lucid Lynx

    Re: Help with perl hashes

    you asked for it!!

    i am using this code to process the output of exuberant ctags to get a basic layout of the code in xml.... the implementation of the thing to output is not coming!

    the input file can be obtained by just going into a perl project folder and typing

    Code:
    ctags -R -x * > ctags_ouput.proc
    here is the actual perl code
    Code:
    #!/usr/bin/env perl
    
    #read perl codes easily
    
    use strict;
    
    open IN_FILE, "<", "ctags_output.proc";
    
    my @lines = <IN_FILE>;
    close(IN_FILE);
    
    my %project;
    
    #Process CTAGS file
    for my $i (@lines)
    {
            #Process package names
            if($i =~ /([a-zA-Z0-9:]*)\s+package\s+([\d]*)\s+([a-zA-z\/.0-9]*)\s+package\s+([.]*)/)
            {
                    my $packageName = $1;
                    my $lineNo = $2;
                    my $fileName = $3;
                    my $parent = "";
                    my $count = 0;
                    print STDOUT "Got package $packageName @ $lineNo in $fileName\n";
                    for my $key (keys %project)
                    {
                            if($packageName =~ /^$key/)
                            {
                                    if(length($parent)<length($key))
                                    {
                                            $parent = $key;
                                    }
                            }
                    }
                    print STDOUT "Found parent of $packageName -> $parent\n";
                    if(exists $project{$packageName})
                    {}
                    else
                    {
                            $project{$packageName} = {
                                    'path'         => "$fileName",
                                    'lineNo'       => "$lineNo",
                                    'super'        => "$parent",
                                    'subrountines' => []
                            };
                    }
                    next;
            }
            #Process Function names
            if($i =~ /([a-zA-Z0-9:_]*)\s+subroutine\s+([\d]*)\s+([a-zA-z\/.0-9]*)\s+sub\s+([.]*)/)
            {
                    my $subName = $1;
                    my $lineNo = $2;
                    my $fileName = $3;
                    for my $key (keys %project)
                    {
                            if($fileName eq $project{$key}{'path'})
                            {
                                    print STDOUT "Got subroutine $subName of $key @ $lineNo in $fileName\n";
                                    my %sub = {'name'=>"$subName",'nu'=>"$lineNo"};
                                    push($project{$key}{'subroutines'},{%sub});
                            }
                    }
            }
    }
    
    #Write output to XML file
    open OUT_FILE, "+>", "project_parsed.xml";
    
    use XML::DOM;
    my $doc = XML::DOM::Document->new();
    my $decl = $doc->createXMLDecl('1.0');
    print OUT_FILE $decl->toString; 
    
    my $xml = $doc->createElement("project");
    for my $i (keys %project)
    {
            my $package = $doc->createElement("package");
            $package->setAttribute('name',$i);
            $package->setAttribute('path',$project{$i}{'path'});
            $package->setAttribute('lineNo',$project{$i}{'lineNo'});
            my $len = scalar @{$project{$i}{'subroutines'}};
            for(my $j=0;$j<$len;$j++)
            {
                    my $subroutine = $doc->createElement("subroutine");
                    print STDOUT $project{$i}{'subroutine'}[$j]{'name'};
                    $subroutine->setAttribute('name',$project{$i}{'subroutine'}[$j]{'name'});
                    $subroutine->setAttribute('lineNo',$project{$i}{'subroutine'}[$j]{'nu'});
                    $package->appendChild($subroutine);
            }
            $xml->appendChild($package);
    }
    
    print OUT_FILE $xml->toString;
    
    close OUT_FILE;
    
    if(!($ARGV[0] eq 'silent'))
    {
            print map { "$_ =>\n\tpath=$project{$_}{'path'}\n\tlineNo=$project{$_}{'lineNo'}\n\tsuper=$project{$_}{'super'}\n\tsubroutines=join('',$project{$_}{'subroutines'})\n\n\n" } keys %project;
    }

    edit:
    i forgot to mention that the error is in and around line 62

  4. #4
    Join Date
    Sep 2009
    Location
    UK
    Beans
    535
    Distro
    Ubuntu 10.10 Maverick Meerkat

    Re: Help with perl hashes

    Line 62:
    Code:
    push($project{$key}{'subroutines'},{%sub});
    looks a bit off with using '{%sub}'.

    Try rewriting line 62:
    Code:
    push($project{$key}{'subroutines'},\%sub);
    DMedia - Distributed Media Library
    LaVida - A simulation game for Linux
    AskUbuntu

  5. #5
    Join Date
    Dec 2007
    Location
    ~
    Beans
    314
    Distro
    Ubuntu 10.04 Lucid Lynx

    Re: Help with perl hashes

    i tried that... originally line 62 read something like....
    Code:
    push(@{$project{$key}{'subroutines'}},\%sub);
    but then i got the error
    Code:
    Can't use an undefined value as an ARRAY reference at ./parseCTAGS.pl line 83.
    so i assumed the thing wasnt being pushed into the array correctly!

  6. #6

    Re: Help with perl hashes

    Quote Originally Posted by nebu View Post
    i tried that... originally line 62 read something like....
    Code:
    push(@{$project{$key}{'subroutines'}},\%sub);
    but then i got the error
    Code:
    Can't use an undefined value as an ARRAY reference at ./parseCTAGS.pl line 83.
    so i assumed the thing wasnt being pushed into the array correctly!
    So why did you change the first element to a scalar? You can't push anything into a scalar.

    You're using some pretty odd conventions here -- really long lines are one problem, but I'm also wondering about
    Code:
                    if(exists $project{$packageName})
                    {}
                    else
    Why not just 'unless ($project{packageName})'? Better yet, combine it with the assignment:
    Code:
    				$project{$packageName} ||= { ...
    You're also doing a lot of print STDOUT, which seems a little odd.

    Line 45 misspells 'subroutines', which is probably a pretty big problem.

    Code:
    my %sub = {'name'=>"$subName",'nu'=>"$lineNo"};
    (line 61) seems unusual for a few reasons: notably, you're assigning a hashref to a hash; you're using double-quote interpolation when none is needed; and you're not taking advantage of auto-quoting of barewords in front of the =>.

    Your indexing is odd, but I can't quite put my finger on why.

    This little snippet rather has me wondering:
    Code:
            my $len = scalar @{$project{$i}{'subroutines'}};
            for(my $j=0;$j<$len;$j++)
            {
                    my $subroutine = $doc->createElement("subroutine");
                    print STDOUT $project{$i}{'subroutine'}[$j]{'name'};
                    $subroutine->setAttribute('name',$project{$i}{'subroutine'}[$j]{'name'});
                    $subroutine->setAttribute('lineNo',$project{$i}{'subroutine'}[$j]{'nu'});
                    $package->appendChild($subroutine);
            }
    Why not 'foreach (@{$project{$i}{'subroutines'}}) { ... }'?

    You use 'for my $key (keys %hash)' a lot; are you unaware of 'while (my ($key, $value) = each %hash)'? Hiding the hash access within the loop control prevents having to chain your indexing all over the place like in the previous code.

    I'm also wondering why you didn't use warnings as well as strict.

    I apologize for somewhat playing the Style Police, but these are some pretty heavy things for me to wade through before I can actually help you out. Honestly, I'm not sure what of the several things I mentioned here are problems and which ones are just unusual. I can't test it right now, but I'll try it later. In the meantime you could try fixing some of the issues I've already pointed out.

    Tip: Use Data:umper to inspect the contents of complex data structures and make sure they contain what you think they do.

  7. #7
    Join Date
    Mar 2006
    Beans
    393

    Re: Help with perl hashes

    Change:

    Code:
    my %sub = {'name'=>"$subName",'nu'=>"$lineNo"};
    to:
    Code:
    my %sub = ( name => $subName, nu => $lineNo );
    Just my 0.00000002 million dollars worth,
    Shawn

    Programming is as much about organization and communication as it is about coding.

  8. #8
    Join Date
    Dec 2007
    Location
    ~
    Beans
    314
    Distro
    Ubuntu 10.04 Lucid Lynx

    Re: Help with perl hashes

    @trent: ya.... im kind of used to c/c++ code.... so i try to keep my perl as close to c/c++ code as possible! i have had experience that it does not sit very well with perl developers.... so just bear with me

    @shawnhcorey: ya... i did that now i know that the hash %project is getting the required data
    i made ur change and made the following change where i was accessing the data.... the dump produces the right output but when i try to access the data... i get null values!
    eg---- $_{'name'}

    Code:
           foreach (@{$project{$i}{'subroutines'}})
            {   
                    my $subroutine = $doc->createElement("subroutine");
                    use Data::Dumper;
                    print "$_---->";
                    print Dumper($_);
                    print "$_{'name'},$_{'nu'}\n";
                    $subroutine->setAttribute('name',$_{'name'});
                    $subroutine->setAttribute('lineNo',$_{'nu'});
                    $package->appendChild($subroutine);
            }

  9. #9
    Join Date
    Feb 2010
    Location
    Silicon Valley
    Beans
    1,898
    Distro
    Xubuntu 12.04 Precise Pangolin

    Re: Help with perl hashes

    The problem is almost entirely due to mixing up the spelling of the key 'subroutines'. Here's a minimal unified diff to your code that makes it work:

    Code:
    --- proc1.pl    2010-08-18 08:30:16.000000000 -0700
    +++ proc3.pl    2010-08-18 09:24:08.000000000 -0700
    @@ -42,7 +42,7 @@
                                     'path'         => "$fileName",
                                     'lineNo'       => "$lineNo",
                                     'super'        => "$parent",
    -                                'subrountines' => []
    +                                'subroutines'  => []
                             };
                     }
                     next;
    @@ -58,8 +58,8 @@
                             if($fileName eq $project{$key}{'path'})
                             {
                                     print STDOUT "Got subroutine $subName of $key @ $lineNo in $fileName\n";
    -                                my %sub = {'name'=>"$subName",'nu'=>"$lineNo"};
    -                                push($project{$key}{'subroutines'},{%sub});
    +                                my $sub = {'name'=>"$subName",'nu'=>"$lineNo"};
    +                                push @{$project{$key}{'subroutines'}}, $sub;
                             }
                     }
             }
    @@ -84,9 +84,9 @@
             for(my $j=0;$j<$len;$j++)
             {
                     my $subroutine = $doc->createElement("subroutine");
    -                print STDOUT $project{$i}{'subroutine'}[$j]{'name'};
    -                $subroutine->setAttribute('name',$project{$i}{'subroutine'}[$j]{'name'});
    -                $subroutine->setAttribute('lineNo',$project{$i}{'subroutine'}[$j]{'nu'});
    +                print STDOUT $project{$i}->{'subroutines'}[$j]{'name'};
    +                $subroutine->setAttribute('name',$project{$i}{'subroutines'}[$j]{'name'});
    +                $subroutine->setAttribute('lineNo',$project{$i}{'subroutines'}[$j]{'nu'});
                     $package->appendChild($subroutine);
             }
             $xml->appendChild($package);

  10. #10
    Join Date
    Dec 2007
    Location
    ~
    Beans
    314
    Distro
    Ubuntu 10.04 Lucid Lynx

    Re: Help with perl hashes

    hey.... i fixed most of the changes.... here is the latest code


    the spelling thing was a humongous mistake... i fixed it up.... "cleaned up" the code a little bit.... however the thing still does not work! (check my previous post for exactly where)

    Code:
    #!/usr/bin/env perl
    
    use strict;
    
    #use warnings;
    
    open IN_FILE, "<",  "ctags_output.proc";
    open LOG_STD, "+>", "parseCTAGS.log";
    
    my @lines = <IN_FILE>;
    close(IN_FILE);
    
    my $projectFolder = $ARGV[0];
    
    my %project;
    
    #Process CTAGS file
    for my $i (@lines) {
    
        #Process package names
        if ( $i =~ /([a-zA-Z0-9:]*)\s+package\s+([\d]*)\s+([a-zA-z\/.0-9]*)\s+package\s+([.]*)/ )
        {
            my $packageName = $1;
            my $lineNo      = $2;
            my $fileName    = $3;
            my $parent      = "";
            my $count       = 0;
            print LOG_STD "Got package $packageName @ $lineNo in $fileName\n";
            for my $key ( keys %project ) {
                if ( $packageName =~ /^$key/ ) {
                    if ( length($parent) < length($key) ) {
                        $parent = $key;
                    }
                }
            }
            print LOG_STD "Found parent of $packageName -> $parent\n";
            unless ( $project{$packageName} ) {
                $project{$packageName} = {
                    'path'         => "$fileName",
                    'lineNo'       => "$lineNo",
                    'super'        => "$parent",
                    'subrountines' => ()
                };
            }
            next;
        }
    
        #Process Function names
        if ( $i =~ /([a-zA-Z0-9:_]*)\s+subroutine\s+([\d]*)\s+([a-zA-z\/.0-9]*)\s+sub\s+([.]*)/ )
        {
            my $subName  = $1;
            my $lineNo   = $2;
            my $fileName = $3;
            for my $key ( keys %project ) {
                if ( $fileName eq $project{$key}{'path'} ) {
                    print LOG_STD
                      "Got subroutine $subName of $key @ $lineNo in $fileName\n";
                    my %sub = ( 'name', "$subName", 'nu', "$lineNo" );
                    push( @{ $project{$key}{'subroutines'} }, \%sub );
    
                    #use Data::Dumper;
                    #print "func[$subName, $lineNo, $key, $fileName] -->\n";
                    #print Dumper(@{$project{$key}{'subroutines'}});
                    #print "\n\n\n";
    
                }
            }
        }
    }
    
    #Write output to XML file
    open OUT_FILE, "+>", "project_parsed.xml";
    
    use XML::DOM;
    my $doc  = XML::DOM::Document->new();
    my $decl = $doc->createXMLDecl('1.0');
    print OUT_FILE $decl->toString;
    
    my $xml = $doc->createElement("project");
    for my $i ( keys %project ) {
        #Write package details
        my $package = $doc->createElement("package");
        $package->setAttribute( 'name',   $i );
        $package->setAttribute( 'path',   $project{$i}{'path'} );
        $package->setAttribute( 'lineNo', $project{$i}{'lineNo'} );
        open PERL_FILE, "<", "$projectFolder/$project{$i}{'path'}";
        my @file = <PERL_FILE>;
    
        #Write uses
        for my $line (@file) {
            if ( $line =~ /^use\s+([A-Za-z0-9:]*)[.]*;/ ) {
                print LOG_STD "\tUsing $1 in $i\n";
                my $calls = $doc->createElement("calls");
                $calls->setAttribute( "name", $1 );
                $package->appendChild($calls);
            }
        }
        close(PERL_FILE);
    
        #Write subroutines
        foreach ( @{ $project{$i}{'subroutines'} } ) {
            my $subroutine = $doc->createElement("subroutine");
            use Data::Dumper;
            print "$_---->";
            print Dumper($_);
            print "$_{'name'},$_{'nu'}\n";
            $subroutine->setAttribute( 'name',   $_{'name'} );
            $subroutine->setAttribute( 'lineNo', $_{'nu'} );
            $package->appendChild($subroutine);
        }
        $xml->appendChild($package);
    }
    
    print OUT_FILE $xml->toString;
    
    close OUT_FILE;
    close LOG_STD;
    Last edited by nebu; August 18th, 2010 at 05:42 PM.

Page 1 of 2 12 LastLast

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •